global D me frmN form input
set frmN 0
set form 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 D me in frmN form Form Input
	if {$D>2} {puts "$me/tagFORM: w={$w} att={$att}"}
	incr frmN
	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 {$D>2} {puts "$me/tagFORM: form $form frmN $frmN"}
	if [regexp -nocase {ACTION="*([^ 	"]+)"*} $att {} x] {
		if {$D>2} {puts "$me/tagFORM: ACTION=\"$x\""}
		set Form(A$f) $x
	} else {
		if {$D>2} {puts "$me/tagFORM: ACTION not found for form $f."}
	}
	if [regexp -nocase {METHOD="*([^ 	"]+)"*} $att {} x] {
		if {$D>2} {puts "$me/tagFORM: METHOD=\"$x\""}
		set Form(M$f) $x
	} else {
		if {$D>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 {$D>2} {puts "$me/tagFORM: ENCTYPE=\"$x\""}
		set Form(E$f) $x
	}
	if {$D>2} {puts "$me/tagFORM: ACTION  \"$Form(A$f)\""}
	if {$D>2} {puts "$me/tagFORM: METHOD  \"$Form(M$f)\""}
	if {$D>2} {puts "$me/tagFORM: ENCTYPE \"$Form(E$f)\""}
}

set input 0
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# 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 D EB R NL SP LC me in frmN form Form Input input
	set id "$me/tagINPUT"
	if {$D>2} {puts "$id w={$w} att={$att} frmN=$frmN form=$form"}
	if {$frmN < 1} {
		if {$D>2} {puts "$id <$tag $att> outside form ignored."}
		return
	}
	set i [incr input]
	lappend Input(I$form) $i
	if {$D>2} {puts "$id Input(I$form)={$Input(I$form)}"}
	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 {$D>2} {puts "$id Create frame for input item $i."}
	if [winfo exists $w.fr$i] {destroy $w.fr$i}
	frame $w.fr$i -bd 0 
	if {$D>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]} {
			if {$D>2} {puts "$id ATTRIBUTE a={$a} v={$v} att={$att}"}
			set T [string toupper $a] 
			if {$Input(T$i) != {}} {if {$D>1} {puts "$id Input(T$i) is already \"$Input(T$i)\""}}
			switch [set A [string toupper $a]] {
			TYPE {
				if {$D>2} {puts "$id ATTRIBUTE TYPE v={$v}"}
				set Input(T$i) [string toupper $v]
				if {$D>2} {puts "$id ATTRIBUTE TYPE Input(T$i)={$Input(T$i)}"}
				switch  $Input(T$i) {
				TEXT {
					if {$D>2} {puts "$id ATTRIBUTE TYPE TEXT"}
					if {$D>2} {puts "$id entry $w.fr$i.x -textvariable Input(V$i)"}
				  }
				SUBMIT {
					if {$D>2} {puts "$id ATTRIBUTE TYPE SUBMIT"}
					if {$Input(N$i) == {}} {set Input(N$i) SUBMIT}
					if {$Input(V$i) == {}} {set Input(V$i) SUBMIT}
					if {$D>2} {puts "$id button $w.fr$i.x packed in $w.fr$i"}
				  }
				IMAGE {
					if {$D>0} {puts "$id ATTRIBUTE TYPE IMAGE not implemented yet."}
				  }
				HIDDEN {
					if {$D>0} {puts "$id ATTRIBUTE TYPE HIDDEN not implemented yet."}
				  }
				CHECKBOX {
					if {$D>0} {puts "$id ATTRIBUTE TYPE CHECKBOX not implemented yet."}
				  }
				RADIO {
					if {$D>0} {puts "$id ATTRIBUTE TYPE RADIO not implemented yet."}
				  }
				default {
					if {$D>0} {puts "$id ATTRIBUTE TYPE v={$v} unknown."}
				  }
				}
			  }
			NAME {
				if {$D>2} {puts "$id ATTRIBUTE NAME v={$v}"}
				set Input(N$i) $v
				if {$D>2} {puts "$id ATTRIBUTE NAME Input(N$i)=\"$Input(N$i) Input(T$i)={$Input(T$i)}\""}
			  }
			VALUE {
				if {$D>2} {puts "$id ATTRIBUTE VALUE v={$v}"}
				set Input(V$i) $v
				if {$D>2} {puts "$id ATTRIBUTE VALUE Input(V$i)={$Input(V$i)} Input(T$i)={$Input(T$i)}"}
			  }
			SIZE {
				if {$D>2} {puts "$id ATTRIBUTE SIZE v={$v}"}
				set Input(S$i) $v
				if {$D>2} {puts "$id ATTRIBUTE SIZE Input(S$i)={$Input(S$i)}"}
			  }
			MAXLENGTH {
				if {$D>2} {puts "$id ATTRIBUTE MAXLENGTH v={$v}"}
				set Input(S$i) $v
				if {$D>2} {puts "$id ATTRIBUTE MAXLENGTH Input(M$i)={$Input(M$i)}"}
			  }
			default {
				if {$D>0} {puts "$id ATTRIBUTE a={$a} unknown."}
			  }
			}
		} else {
			if {$D>2} {puts "$id UNKNOWN {$att}"}
			regsub {^[^ 	]*[ 	]*} $att {} att
			if {$D>2} {puts "$id att={$att}"}
		}
	}
	if {$D>2} {puts "$id Input(T$i)=\"$Input(T$i)\""}
	switch $Input(T$i) {
	TEXT {
		if {$D>2} {puts "$id INPUT TEXT \"$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) > 0} {
			if {$D>2} {puts "$id INPUT TEXT Size $Input(S$i) max $Input(M$i)"}
			$w.fr$i.x config -width $Input(S$i)
		}
	  }
	SUBMIT {
		button $w.fr$i.x -text $Input(V$i) -command "SubmitForm $form $i"
		pack   $w.fr$i.x -in $w.fr$i
	  }
	IMAGE {
		if {$D>0} {puts "$id INPUT TYPE $Input(T$i) not implemented yet."}
	  }
	HIDDEN {
		if {$D>0} {puts "$id INPUT TYPE $Input(T$i) not implemented yet."}
	  }
	CHECKBOX {
		checkbutton $w.fr$i.x -text $Input(V$i)
		pack   $w.fr$i.x -in $w.fr$i
	  }
	RADIO {
		radiobutton $w.fr$i.x -text $Input(V$i) 
		pack   $w.fr$i.x -in $w.fr$i
	  }
	default {
		if {$D>0} {puts "$id UNKNOWN TYPE \"$Input(T$i)\""}
	  }
	}
	if {$D>2} {puts "$id Insert frame for input item $i."}
	$w window create insert -window $w.fr$i
	if {$D>2} {puts "$id Frame $w.fr$i inserted."}
	set SP 0; set NL 0; set LC <>
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# 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 D me in docFil frmN form Form Input input
	if {$D>2} {puts "$me/SubmitForm: FORM $f input $i"}
	if {$D>2} {puts "$me/SubmitForm: ACTION  \"$Form(A$f)\""}
	if {$D>2} {puts "$me/SubmitForm: METHOD  \"$Form(M$f)\""}
	if {$D>2} {puts "$me/SubmitForm: ENCTYPE \"$Form(E$f)\""}
	switch [string toupper $Form(M$f)] {
	GET {
		if {$D>2} {puts "$me/SubmitForm: Build URL for GET ..."}
		set URL "$Form(A$f)"
		if {$D>2} {puts "$me/SubmitForm: Input(I$f)={$Input(I$f)}"}
		set sep ?
		foreach i $Input(I$f) {
			set n $Input(N$i)
			if {[set v $Input(V$i)] != {}} {
				if {$D>2} {puts "$me/SubmitForm: Input(V$i) is \"$v\""}
			} elseif [info exists Input(E$i)] {
				set v [eval $Input(E$i)]
				if {$D>2} {puts "$me/SubmitForm: Input(E$i) gave \"$v\""}
			} else {
				set v {}
				if {$D>2} {puts "$me/SubmitForm: Input(E$i) has no value."}
			}
			if {$v != {}} {
				set V [URL $v]
				if {$D>2} {puts "$me/SubmitForm: Input($i) \"$v\" => \"$V\""}
				set URL "$URL$sep$n=$V"
				set sep &
			}
		}
		if {$D>2} {puts "$me/SubmitForm: URL \"$URL\""}
		LoadFile .t.txt $URL GET
	  }
	POST {
		if {$D>2} {puts "$me/SubmitForm: Build URL for POST ..."}
		set URL "$Form(A$f)"
		if {$D>2} {puts "$me/SubmitForm: Input(I$f)={$Input(I$f)}"}
		set data {}
		LoadFile .t.txt $URL POST
		if {$docFil == {}} {
			if {$D>0} {puts "$me/SubmitForm: LoadFile didn't produce docFil"}
			return
		}
		if {$D>2} {puts "$me/SubmitForm: Send form data to $docFil ..."}
		foreach i $Input(I$f) {
			set n $Input(N$i)
			if {$D>2} {puts "$me/SubmitForm: Input(N$i) is \"$n\""}
			if {[set v $Input(V$i)] != {}} {
				if {$D>2} {puts "$me/SubmitForm: Input(V$i) is \"$v\""}
			} elseif {[info exists Input(E$i)] && $Input(E$i) != {}} {
				set v [eval $Input(E$i)]
				if {$D>2} {puts "$me/SubmitForm: Input(E$i) gave \"$v\""}
			} else {
				set v {}
				if {$D>2} {puts "$me/SubmitForm: Input(E$i) has no value."}
			}
			if {$v != {}} {
				set V [URL $v]
				if {$D>2} {puts "$me/SubmitForm: Send {$n=$V}"}
				puts $docFil "$n=$V"
			}
		}
		if {$D>2} {puts "$me/SubmitForm: Send blank line."}
		puts $docFil ""
		flush $docFil
	  }
	default {
		if {$D>2} {puts "$me/SubmitForm: Unknown METHOD \"$Form(M$f)\" for form $f"}
	  }
	}
	if {$D>2} {puts "$me/SubmitForm: Done."}
}