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 {*}$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>"
   }