global V me N form input
set N(FORM) 0
set N(INPUT) 0
set form 0
set input 0
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# The FORM tag has several attributes:
#   ACTION="href"      CGI script to process form.
#   METHOD=GET|POST    args are in URL or STDIN.
#   ENCTYPE=encoding   says how to encode the data.
#
proc tagFORM {w tag att} {
	global V me in N form Form Input
	if {$V>2} {puts "$me/tagFORM: w={$w} att={$att}"}
	incr N(FORM)
	set f [incr form]
	set Input(I$f) {}
	set Form(A$f) {}
	set Form(M$f) {}
	set Form(E$f) {application/x-www-form-urlencoded}
	if {$V>2} {puts "$me/tagFORM: form $form N(FORM) $N(FORM)"}
	if [regexp -nocase {ACTION="*([^ 	"]+)"*} $att {} x] {
		if {$V>2} {puts "$me/tagFORM: ACTION=\"$x\""}
		set Form(A$f) $x
	} else {
		if {$V>2} {puts "$me/tagFORM: ACTION not found for form $f."}
	}
	if [regexp -nocase {METHOD="*([^ 	"]+)"*} $att {} x] {
		if {$V>2} {puts "$me/tagFORM: METHOD=\"$x\""}
		set Form(M$f) $x
	} else {
		if {$V>2} {puts "$me/tagFORM: METHOD not found for form $f, default to GET."}
		set Form(M$f) GET
	}
	if [regexp -nocase {ENCTYPE="*([^ 	"]+)"*} $att {} x] {
		if {$V>2} {puts "$me/tagFORM: ENCTYPE=\"$x\""}
		set Form(E$f) $x
	}
	if {$V>2} {puts "$me/tagFORM: ACTION  \"$Form(A$f)\""}
	if {$V>2} {puts "$me/tagFORM: METHOD  \"$Form(M$f)\""}
	if {$V>2} {puts "$me/tagFORM: ENCTYPE \"$Form(E$f)\""}
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Submitting a form gets intricate.  For GET forms, it's not  too  bad:   The #
# params are encoded and appended to the URL, with "?" as the first separator #
# and "&" as the rest of the separators.  For POST forms, much of  the  cruft #
# has been encapsulated in the w3post program.  We just need to send the data #
# to w3post; it handles the HTTP header, converts newlines into  "&",  counts #
# the chars, and all that.                                                    #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc SubmitForm {f i} {
	global V me in docFil form Form Input input Check Button 
	set id "$me/SubmitForm"
	if {$V>2} {puts "$id: FORM $f because input $i was pushed."}
	if {$V>2} {puts "$id: ACTION  \"$Form(A$f)\""}
	if {$V>2} {puts "$id: METHOD  \"$Form(M$f)\""}
	if {$V>2} {puts "$id: ENCTYPE \"$Form(E$f)\""}
	switch [string toupper $Form(M$f)] {
	GET {
		if {$V>2} {puts "$id: Build URL for GET ..."}
		set U "$Form(A$f)"
		if {$V>2} {puts "$id: Input(I$f)={$Input(I$f)}"}
		set sep ?
		foreach n $Input(I$f) {
			if {$V>2} {puts "$id: URL=\"$U\""}
			if {$V>2} {puts "$id: INPUT $i type $Input(T$n) ..."}
			switch $Input(T$n) {
			SUBMIT {
				if {$n == $i} {	# Ignore if not the one pushed.
					set v [eval $Input(E$n)]
				} else {
					set v {}
				}
				if {$V>2} {puts "$id: SUBMIT i=$i n=$n v=\"$v\""}
			  }
			RADIO {
				if {$V>2} {puts "$id: RADIO Input(N$n)={$Input(N$n)} "}
				if {$V>2} {puts "$id: RADIO Input(V$n)={$Input(V$n)} "}
				if {$V>2} {puts "$id: RADIO Button($Input(N$n))={$Button($Input(N$n))}"}
				if {[info exists Button($Input(N$n))]
				&&	$Button($Input(N$n)) == $Input(V$n)} {	# Ignore if not the one pushed.
					if {$V>2} {puts "$id: RADIO button $Input(N$n)=$Input(V$n) pushed. "}
					set v $Input(V$n)
				} else {
					set v {}
				}
				if {$V>2} {puts "$id: SUBMIT i=$i n=$n v=\"$v\""}
			  }
			RESET {
				if {$V>1} {puts "$id RESET button pressed."}
				foreach x [array names Input] {
					if {$V>1} {puts "$id RESET Input($x) = \"$Input($x)\""}
					set Input($x) {}
				}
				if {$V>1} {puts "$id RESET button returns to current form."}
				return
			  }
			default {
				if {[set v $Input(V$n)] != {}} {
					if {$V>2} {puts "$id: Input(V$n) is \"$v\""}
				} elseif [info exists Input(E$n)] {
					set v [eval $Input(E$n)]
					if {$V>2} {puts "$id: Input(E$n) gave \"$v\""}
				} else {
					set v {}
					if {$V>2} {puts "$id: Input(E$n) has no value."}
				}
			  }
			}
			if {$v != {}} {
				set VV [URL $v]
				if {$V>2} {puts "$id: Input($n) \"$v\" => \"$VV\""}
				append U "$sep$Input(N$n)=$VV"
				set sep &
			}
		}
		if {$V>2} {puts "$id: URL \"$U\""}
		LoadFile "" "" "$U" GET
	  }
	POST {
		if {$V>2} {puts "$id: Build URL for POST ..."}
		set U "$Form(A$f)"
		if {$V>2} {puts "$id: Input(I$f)={$Input(I$f)}"}
		set data {}
		LoadFile "" "" "$U" POST
		if {$docFil == {}} {
			if {$V>0} {Msg "$id: LoadFile didn't produce docFil"}
			return
		}
		if {$V>2} {puts "$id: Send form data to $docFil ..."}
		foreach n $Input(I$f) {
			set nm $Input(N$n)
			if {$V>2} {puts "$id: Input(N$n) is \"$nm\""}
			if {[set v $Input(V$n)] != {}} {
				if {$V>2} {puts "$id: Input(V$n) is \"$v\""}
			} elseif {[info exists Input(E$n)] && $Input(E$n) != {}} {
				set v [eval $Input(E$n)]
				if {$V>2} {puts "$id: Input(E$n) gave \"$v\""}
			} else {
				set v {}
				if {$V>2} {puts "$id: Input(E$n) has no value."}
			}
			if {$v != {}} {
				set V [URL $v]
				if {$V>2} {puts "$id: Send {$nm=$V}"}
				puts $docFil "$nm=$V"
			}
		}
		if {$V>2} {puts "$id: Send blank line."}
		puts $docFil ""
		flush $docFil
	  }
	default {
		if {$V>2} {puts "$id: Unknown METHOD \"$Form(M$f)\" for form $f"}
	  }
	}
	if {$V>2} {puts "$id: Done."}
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Process an <INPUT> tag.  For each such tag within a form, we leave behind a
# number of globals for use by SubmitForm:
#   input       the index of this <INPUT> tag item.
#   Input(I$f)  list of input items for form f.
#   Input(T$i)  item's type.
#   Input(V$i)  item's value, if known.
#   Input(E$i)  expression to get the item's value.
#   Input(S$i)  display size (width in chars) of item.
#   Input(M$i)  max size (width in chars) of item's value.
#   Input(N$i)  name of input item.
# In addition to <INPUT> tags, input items are  generated  by  several  other
# tags, such as <SELECT>. They must also increment the input counter and fill
# in the above variables. 
#
# One important constraint here:  The attributes to an <INPUT> tag can be  in
# any  order.  So we can't just create a widget and reconfigure it as we find
# attributes.  That won't work, because the TYPE may not come first.  What we
# must  do is accumulate the information in the Input() variables, and at the
# end, create the widget.
#
proc tagINPUT {w tag att} {
	global B V EB R SP LC me opt in N form Form Input input Button
	set id "$me/tagINPUT"
	if {$V>2} {puts "$id w={$w} att={$att} N(FORM)=$N(FORM) form=$form"}
	if {$N(FORM) < 1} {
		if {$V>2} {puts "$id <$tag $att> outside form ignored."}
		return
	}
	set i [incr input]
	lappend Input(I$form) $i
	if {$V>2} {puts "$id Input(I$form)={$Input(I$form)}"}
	set Input(C$i) 0
	set Input(V$i) 1
	set Input(E$i) {}
	set Input(S$i) 0
	set Input(M$i) 0
	set Input(N$i) {}
	set Input(T$i) {}
	set Input(V$i) {}
	if {$V>2} {puts "$id Create frame for input item $i."}
	if [winfo exists $w.fr$i] {destroy $w.fr$i}
	frame $w.fr$i -bd $opt(F) -relief $R
	if {$V>2} {puts "$id Frame $w.fr$i created for input item $i."}
	while {$att != {}} {
		if {[regexp {^([A-Za-z]+)="([^"]*)"[ 	]*(.*)$} $att {} a v att]
		||	[regexp {^([A-Za-z]+)=([^ 	]*)[ 	]*(.*)$} $att {} a v att]
		||	[regexp {^([A-Za-z]+)[ 	]*(.*)$} $att {} a v att]} {
			if {$V>2} {puts "$id ATTRIBUTE a={$a} v={$v} att={$att}"}
			set ATR [string toupper $a] 
			if {$Input(T$i) != {}} {if {$V>1} {puts "$id Input(T$i) is already \"$Input(T$i)\""}}
			switch [set A [string toupper $a]] {
			TYPE {
				if {$V>2} {puts "$id ATTRIBUTE TYPE v={$v}"}
				set Input(T$i) [string toupper $v]
				if {$V>2} {puts "$id ATTRIBUTE TYPE Input(T$i)={$Input(T$i)}"}
				switch  $Input(T$i) {
				TEXT {
					if {$V>2} {puts "$id ATTRIBUTE TYPE TEXT"}
				  }
				PASSWORD {
					if {$V>2} {puts "$id ATTRIBUTE TYPE PASSWORD"}
				  }
				SUBMIT {
					if {$V>2} {puts "$id ATTRIBUTE TYPE SUBMIT"}
					if {$Input(N$i) == {}} {set Input(N$i) SUBMIT}
					if {$Input(V$i) == {}} {set Input(V$i) SUBMIT}
				  }
				IMAGE {
					if {$V>0} {puts "$id ATTRIBUTE TYPE IMAGE not implemented yet."}
				  }
				HIDDEN {
					if {$V>1} {puts "$id ATTRIBUTE TYPE HIDDEN ..."}
					set Input(V$i) 0
				  }
				CHECKBOX {
					if {$V>1} {puts "$id ATTRIBUTE TYPE CHECKBOX"}
				  }
				RADIO {
					if {$V>1} {puts "$id ATTRIBUTE TYPE RADIO"}
				  }
				RESET {
					if {$V>1} {puts "$id ATTRIBUTE TYPE RESET"}
				  }
				default {
					if {$V>1} {puts "$id ATTRIBUTE TYPE v={$v} unknown, ignored."}
				  }
				}
			  }
			NAME {
				if {$V>2} {puts "$id ATTRIBUTE NAME v={$v}"}
				set Input(N$i) $v
				if {$V>2} {puts "$id ATTRIBUTE NAME Input(N$i)=\"$Input(N$i)\""}
			  }
			VALUE {
				if {$V>2} {puts "$id ATTRIBUTE VALUE v={$v}"}
				set Input(V$i) $v
				if {$V>2} {puts "$id ATTRIBUTE VALUE Input(V$i)={$Input(V$i)}\""}
			  }
			SIZE {
				if {$V>2} {puts "$id ATTRIBUTE SIZE v={$v}"}
				set Input(S$i) $v
				if {$V>2} {puts "$id ATTRIBUTE SIZE Input(S$i)={$Input(S$i)}"}
			  }
			MAXLENGTH {
				if {$V>2} {puts "$id ATTRIBUTE MAXLENGTH v={$v}"}
				set Input(M$i) $v
				if {$V>2} {puts "$id ATTRIBUTE MAXLENGTH Input(M$i)={$Input(M$i)}"}
			  }
			CHECKED {
				if {$V>2} {puts "$id ATTRIBUTE CHECKED v={$v}"}
				set Input(C$i) 1
				if {$V>2} {puts "$id ATTRIBUTE CHECKED Input(C$i)=\"$Input(C$i)\""}
			  }
			default {
				if {$V>0} {puts "$id ATTRIBUTE a={$a} unknown."}
			  }
			}
		} else {
			if {$V>2} {puts "$id UNKNOWN {$att}"}
			regsub {^[^ 	]*[ 	]*} $att {} att
			if {$V>2} {puts "$id att={$att}"}
		}
	}
	if {$V>2} {puts "$id Create the input widget Input(T$i)=\"$Input(T$i)\""}
	set texts 0
	switch $Input(T$i) {
	""	-
	TEXT {
		if {$V>2} {puts "$id INPUT TEXT $w.fr$i.x \"$Input(V$i)\""}
		entry $w.fr$i.x -textvariable Input(V$i) -bd 2 -relief sunken -highlightthickness 0
		pack  $w.fr$i.x -in $w.fr$i
		if {$Input(S$i) < 1} {set Input(S$i) 10}
		if {$V>2} {puts "$id INPUT TEXT Size $Input(S$i) max $Input(M$i)"}
		$w.fr$i.x config -width $Input(S$i)
		if {[incr texts] == 1} {
			bind $w.fr$i.x <Return> "SubmitForm $form $i"
		}
	  }
	PASSWORD {
		if {$V>2} {puts "$id INPUT PASSWORD $w.fr$i.x \"$Input(V$i)\""}
		entry $w.fr$i.x -textvariable Input(V$i) -bd 2 -show * -relief sunken -highlightthickness 0
		pack  $w.fr$i.x -in $w.fr$i
		if {$Input(S$i) < 1} {set Input(S$i) 10}
		if {$V>2} {puts "$id INPUT PASSWORD Size $Input(S$i) max $Input(M$i)"}
		$w.fr$i.x config -width $Input(S$i)
		if {[incr texts] == 1} {
			bind $w.fr$i.x <Return> "SubmitForm $form $i"
		}
	  }
	SUBMIT {
		button $w.fr$i.x -text $Input(V$i) -command "SubmitForm $form $i"
		pack   $w.fr$i.x -in $w.fr$i
		bind $w.fr$i.x <Return> "SubmitForm $form $i"
		bind $w.fr$i.x <Button-3>     "SubmitForm $form $i";	# Can we open a new window here?
	  }
	IMAGE {
		if {$V>0} {puts "$id INPUT TYPE $Input(T$i) not implemented yet."}
	  }
	HIDDEN {
		if {$V>1} {puts "$id INPUT TYPE HIDDEN."}
	  }
	CHECKBOX {
		if {$V>1} {puts "$id CHECKBOX N=\"$Input(N$i)\" V=\"$Input(V$i)\" C=\"$Input(C$i)\""}
		if {$Input(C$i)} {
			if {$V>1} {puts "$id CHECKBOX button $i checked."}
			set Button($Input(N$i)) $Input(V$i)
			if {$V>1} {puts "$id CHECKBOX button Button($Input(N$i))={$Button($Input(N$i))}"}
		}
		checkbutton $w.fr$i.x -text $Input(V$i) -variable Button($Input(N$i))
		pack   $w.fr$i.x -in $w.fr$i
	  }
	RADIO {
		if {$V>1} {puts "$id RADIO N=\"$Input(N$i)\" V=\"$Input(V$i)\" C=\"$Input(C$i)\""}
		if {$Input(C$i)} {
			if {$V>1} {puts "$id RADIO button $i checked."}
			set Button($Input(N$i)) $Input(V$i)
			if {$V>1} {puts "$id RADIO button Button($Input(N$i))={$Button($Input(N$i))}"}
		}
		radiobutton $w.fr$i.x -text $Input(V$i) -variable Button($Input(N$i)) -value $Input(V$i)
		pack   $w.fr$i.x -in $w.fr$i
	  }
	RESET {
		foreach x [array names Input] {
			if {$V>1} {puts "$id RESET Input($x) = \"$Input($x)\""}
#			set Input($x) {}
		}
	  }
	default {
		if {$V>0} {puts "$id UNKNOWN TYPE \"$Input(T$i)\""}
	  }
	}
	if {$V>2} {puts "$id Insert frame for input item $i."}
	$w window create insert -window $w.fr$i
	if {$V>2} {puts "$id Frame $w.fr$i inserted."}
#	if {$Input(V$i) != {}} {
#	} else {
#		if {$V>2} {puts "$id Frame $w.fr$i invisible, not inserted."}
#	}
	HSP $w {}
	set LC {}
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# The PLAINTEXT tag is like PRE, but also needs to be named so that it can be #
# fed  to  the  server in form actions.  At present, we just treat these like #
# PRE, but this should change soon.                                           #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
proc tagPLAINTEXT {w T a} 	{
	global in Sep
	incr in(PLAINTEXT)
	set Sep "\n"
	BR $w
}
proc endPLAINTEXT {w T}	{
	global in Sep SP
	if {[incr in(PLAINTEXT) -1] < 1} {
		set Sep "\n"
	}
	HSP $w "\n"
}