#!/bin/sh
# \
    exec tclsh "$0" ${1+"$@"}


proc make.bracket { } {
  
  # Return some bracketed text.

  global bad

  set tag_name [ make.tag.name ]
  set ot [ make.open.tag $tag_name ]
  set ct [ make.close.tag $tag_name ]

  if { $bad && ![ oracle ] } {
    set i [ rint 4 ]
    switch $i {
      0 { }
      1 { set ot ""}
      2 { set ct ""}
      3 { set t $ot ; set ot $ct ; set ct $t }
      }
    }

  return "$ot[ make.text ]$ct"
  }


proc make.close.tag { tag_name } {
  
  # Return a close tag with the given name.

  return [ make.tag / $tag_name ]
  }


proc make.open.tag { tag_name } {
  
  # Return an open tag with the given name.

  return [ make.tag $tag_name ]
  }


proc make.random.string { chars { size 0 } } {

  # Return a randomly generated string using the given characters.

  if { [ expr $size == 0 ] } {
    set size  [ string length $chars ]
    }

  set str ""

  for { set i [ rint $size ] } { $i > 0 } { incr i -1 } {
    set j [ rint $size ]
    set str "$str[ string range $chars $j $j ]"
    }
  
  return $str
  }


proc make.spaces { } {

  # Return a randomly generated string of space characters.

  set spaces " \t\n"

  return [ make.random.string $spaces ]
  }


proc make.tag { args } {

  # Make a tag from the given components.

  set tag "<[ make.spaces ]"

  foreach i $args {
    set tag "$tag$i[ make.spaces ]"
    }
  
  return "$tag[ make.spaces ]>"
  }


proc make.tag.name { } {

  # Return a randomly generated tag name.

  while 1 {
    set tag_name [ string range [ make.text ] 0 [ rint 70 ] ]
    regsub -all {[^a-zA-Z0-9]+} $tag_name "" tag_name
    if { [ string length $tag_name ] } break
    }

  return $tag_name
  }


proc make.text { } {

  # Return some randomly generated text.

  set letters "abcde"

  set text [ make.random.string $letters ]
  while { [ oracle ] } {
    set text "$text[ make.bracket ][ make.random.string $letters]"
    }

  return $text
  }


proc oracle { } {

  # Return true or false, with true being less likely as the stack
  # grows larger.

  set l [ info level ]

  return [ expr [ rint 64 ] > $l*$l ]
  }


proc rint { i } {

  # Generate a random interger in the range [0..i).

  set mx 1000000

  if { [ expr $mx < $i ] } {
    set i $mx
    }
  if { [ expr 0 >= $i ] } {
    set i 1
    }
  set bs [ expr $mx/$i ]
  
  while { 1 } {
    set r [ expr int(rand()*$mx)/$bs ]
    if { [ expr $r < $i ] } {
      return $r
      }
    }
  }


set bad 0

foreach a $argv {
  switch -- $a {

    -b { set bad 1 }

    default {
      puts stderr "Command format is \"$argv0 \[-b]\"."
      exit 1
      }
    }
  }

if { [ catch { puts stdout [ make.text ] } ] } {
  exit 1
  }
if { $bad } {
  puts stdout "<bad>"
  }


# $Log: gen-xmldoc,v $
# Revision 1.1  2004/03/25 16:48:32  rclayton
# Initial revision
#
# Revision 1.2  2004/01/26 00:33:29  rclayton
# Do bad things.
#
# Revision 1.1  2004/01/25 15:00:02  rclayton
# Initial revision
#

# Local Variables:
# mode: tcl
# tcl-application: "tclsh"
# End: