This is a little script to generate html forms from tcl lists - [CMcC] 20060117

----
   package provide Form 1.0
   
   namespace eval Form {
       variable inherit {
   	-type -maxlength -size -inline
   	-disabled -readonly -template -class
   	-onfocus -onblur -onselect -onchange
       }
   
       variable field_fields {
   	-type -maxlength -name -size -value
   	-legend -label -prolog -epilog -inline -acronym -alt
   	-checked -disabled -readonly -tabindex
   	-src -onfocus -onblur -onselect -onchange
   	-class -rows -cols
       }
   
       variable defaults {
   	-method post
   	-type text
   	-maxlength 64
   	-size 30
   	-inline 1
       }
   
       proc parse_field {name f fieldset} {
   	set field [dict create -label $name -name $name]
   
   	# grab defaults from fieldset
   	variable inherit
   	dict for {k v} $fieldset {
   	    if {$k in $inherit} {
   		dict set field $k $v
   	    }
   	}
   
   	variable field_fields
   	foreach {key val} $f {
   	    if {$key in $field_fields} {
   		dict set field $key $val
   	    } else {
   		error "Unknown argument $key in field $name"
   	    }
   	}
   	return $field
       }
   
       proc parse_fieldset {name fs form} {
   	set fieldset [dict create -label $name -inline 0]
   
   	# grab defaults from form
   	variable inherit
   	dict for {k v} $form {
   	    if {$k in $inherit} {
   		dict set fieldset $k $v
   	    }
   	}
   	set fields {}
   	foreach {key val} $fs {
   	    if {[string match -* $key]} {
   		dict set fieldset $key $val
   	    } else {
   		lappend fields $key
   		dict set fieldset $key [parse_field $key $val $fieldset]
   	    }
   	}
   	dict set fieldset -fields $fields
   	return $fieldset
       }
   
       proc parse {text args} {
   	variable defaults
   	set form [dict merge $defaults $args]
   	set fieldsets {}
   	foreach {key val} $text {
   	    if {[string match -* $key]} {
   		dict set form $key $val
   	    } else {
   		lappend fieldsets $key
   		dict set form $key [parse_fieldset $key $val $form]
   	    }
   	}
   	dict set form -fieldsets $fieldsets
   	return $form
       }
   
       proc label {text} {
   	set result {}
   	foreach word [split $text] {
   	    if {$word eq ""} continue
   	    if {[string length $word] > 3} {
   		lappend result [string totitle $word]
   	    } else {
   		lappend result $word
   	    }
   	}
   	return [join $result]
       }
   
       proc html {form args} {
   	set form [parse $form {expand}$args]
   
   	if {[dict exists $form -record]} {
   	    set record [dict get $form -record]
   	    #puts stderr "form html record: $record"
   	    Debug {form html record: $record}
   	} else {
   	    set record [dict create]
   	}
   
   	set html ""
   	if {[dict exists $form -class]} {
   	    set class [dict get $form -class]
   	} else {
   	    set class Form
   	}
   
   	if {[dict exists $form -action]} {
   	    append html "<form class='$class' action='[dict get $form -action]' method='[dict get $form -method]'>\n"
   	}
   
   	if {[dict exists $form -prolog]} {
   	    append html [dict get $form -prolog] \n
   	}
   
   	foreach fsn [dict get $form -fieldsets] {
   	    set fs [dict get $form $fsn]
   	    append html <fieldset> \n
   	    append html <legend> [label [dict get $fs -label]] </legend> \n
   
   	    if {[dict exists $fs -prolog]} {
   		append html [dict get $form -prolog] \n
   	    }
   
   	    foreach fn [dict get $fs -fields] {
   		set f [dict get $form $fsn $fn]
   
   		if {[dict get $f -type] ne "hidden"} {
   		    if {![dict get $f -inline]} {
   			append html <p>
   		    }
   
   		    append html <label>
   		    if {[dict exists $f -acronym]} {
   			append html "<acronym title='[dict get $f -acronym]'>"
   			append html [label [dict get $f -label]]
   			append html </acronym>
   			append html ": "
   		    } else {
   			append html [label [dict get $f -label]] ": "
   		    }
   		    append html </label>
   		}
   
   		if {[dict exists $f -type] && ([dict get $f -type] eq "textarea")} {
   		    append html <textarea
   		    set attrs {type name readonly rows cols}
   		} else {
   		    append html <input
   		    set attrs {type maxlength name size alt readonly}
   		}
   		foreach x $attrs {
   		    if {[dict exists $f -$x]} {
   			append html " $x='[dict get $f -$x]'"
   		    }
   		}
   
   		if {[dict exists $f -name]} {
   		    set name [dict get $f -name]
   		} else {
   		    set name $fn
   		}
   
   		if {[dict exists $f -type] && ([dict get $f -type] ne "textarea")} {
   		    if {[dict exists $f -value]} {
   			append html " value='[dict get $f -value]'"
   		    } elseif {[dict exists $record $name]} {
   			#puts stderr "REC: $name / [dict get $record $name] / [armour [dict get $record $name]] / $record"
   			append html " value='[armour [dict get $record $name]]'"
   		    } elseif {[dict exists $form -template]
   			      && ([dict get $form -template] ne "")} {
   			set t [dict get $form -template]
   			append html " value='[string map [list % $name] $t]'"
   		    }
   		    append html /> \n
   		} else {
   		    append html > \n
   		    if {[dict exists $f -value]} {
   			append html [dict get $f -value]
   		    } elseif {[dict exists $form -template]
   			      && ([dict get $form -template] ne "")} {
   			set t [dict get $form -template]
   			append html [string map [list % [dict get $f -name]] $t]
   		    }
   
   		    append html </textarea> \n
   		}
   
   		if {[dict exists $f -legend]} {
   		    append html [dict get $f -legend]
   		}
   
   		if {![dict get $f -inline]} {
   		    append html </p>
   		}
   
   		if {[dict exists $f -text]} {
   		    append html <p> [dict get $f -text] </p> \n
   		}
   
   	    }
   
   	    if {[dict exists $fs -epilog]} {
   		append html <p> [dict get $fs -epilog] </p> \n
   	    }
   	    append html </fieldset> \n
   	}
   
   	if {[dict exists $form -epilog]} {
   	    append html [dict get $form -epilog] \n
   	}
   
   	if {[dict exists $form -submit]} {
   	    append html "<input type='submit' value='[dict get $form -submit]'/>" \n
   	}
   
   	if {[dict exists $form -action]} {
   	    append html </form>
   	}
   
   	return $html
       }
   
       proc load {path args} {
   	set fd [open $path]
   	set content [read $fd]
   	close $fd
   	if {$args ne {}} {
   	    set content [string map $args $content]
   	}
   	#puts stderr "Load: $content"
   	return [html $content]
       }
   
       namespace export -clear *
       namespace ensemble create -subcommands {}
   }
   
   if {[info exists argv0] && ($argv0 eq [info script])} {
       puts "<html><head></head><body>"
       puts [Form html {
   	-submit "Create New Account"
   	-prolog "<p>This is a form to enter your account details</p>"
   	-epilog "<p>When you create the account instructions will be emailed to you.  Make sure your email address is correct.</p>"
   	details {
   	    -label "Account Details"
   	    -inline 1
   
   	    user {
   		-acronym "Your preferred username (only letters, numbers and spaces)"
   	    }
   	    email {
   		-acronym "Your email address"
   		-value moop
   	    }
   	    hidden {
   		-type hidden
   	    }
   	}
   	
   	passwords {
   	    -text "Type in your preferred password, twice.  Leaving it blank will generate a random password for you."
   	    -type password
   	    -inline 1
   	    
   	    password {}
   	    repeat {}
   	}
   	
   	personal {
   	    -label "Personal Information"
   	    
   	    name {
   		-name fullname
   		-acronym "Full name to be used in email."
   	    }
   	    phone {
   		-acronym "Phone number for official contact"
   	    }
   	}
       } -action http:moop.html]
       
       puts "</body>\n</html>"
   }
----
[HJG] On my Tcl 8.4 installation, I get an error 'invalid command name "[dict]" ... line 165'.

[RLH] [dict] is in 8.5...but I think that there was a backport to 8.4, if you want to try it.

----
[Category Application]