This is a little script to generate html forms from tcl lists - CMcC 20060117
namespace eval form {
variable field_inherited {
type maxlength size inline
disabled readonly
onfocus onblur onselect onchange
}
variable field_fields {-type -maxlength -name -size
-legend -label -text -inline -acronym -alt
-checked -disabled -readonly -tabindex
-src -onfocus -onblur -onselect -onchange
}
proc parse_field {name f fieldset} {
set field [dict create -label $name -name $name]
# grab defaults from fieldset
variable field_inherited
foreach x $field_inherited {
if {[dict exists $fieldset -$x]} {
dict set field -$x [dict get $fieldset -$x]
}
}
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} {
set fieldset [dict create -label $name -inline 0]
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} {
set form [dict create -method "post"]
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]
}
}
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 {template ""}} {
set form [parse $form]
set html ""
if {[dict exists $form -action]} {
append html "<form action='[dict get $form -action]' method='[dict get $form -method]'>\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
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>
}
append html <input
foreach x {type maxlength name size alt} {
if {[dict exists $f -$x]} {
append html " $x='[dict get $f -$x]'"
}
}
if {[dict get $f -type] ne "textarea"} {
if {$template ne ""} {
append html " value='[string map [list % [dict get $f -name]] $template]'"
}
append html /> \n
} else {
append html > \n
if {[dict exists $f -content]} {
append html [dict get $f -content]
} elseif {$template ne ""} {
append html [string map [list % [dict get $f -name]] $template]
}
append html </input> \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 -text]} {
append html <p> [dict get $fs -text] </p> \n
}
append html </fieldset> \n
}
if {[dict exists $form -submit]} {
append html "<input type='submit' value='[dict get $form -submit]'/>" \n
}
append html </form>
return $html
}
}
if {[info exists argv0] && ($argv0 eq [info script])} {
puts "<html><head></head><body>"
puts [::form::html {
-submit "Create New Account"
-action .
details {
-label "Account Details"
-type text
-maxlength 64
-size 30
-inline 1
user {
-acronym "Your preferred username (only letters, numbers and spaces)"
}
email {
-acronym "Your email address"
}
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"
-type text
-maxlength 64
-size 30
name {
-name fullname
-acronym "Full name to be used in email."
}
phone {
-acronym "Phone number for official contact"
}
}
}]
puts "</body>\n</html>"
}