Generating HTML with commands styled after Tk


 # 03.04.2006
 lappend auto_path ./
 package require sparx 1.0; # stripped down version of https://wiki.tcl-lang.org/13754
 package require html; # tcllib

 # define an <input>-field
 proc hEntry args {
    # options based on Tk's entry widget, but expanded and/or reduced as needed/required
    #  (additional positional args are passed unchanged into the <input>-tag)
    # set up command format (= pos.args, switches and defaults)
    set tpl {
       1            ""
       -background: ""
       -bg:         ""
       -font:       ""
       -foreground: ""
       -fg:         ""
       -justify:    "left"
       -show        0
       -state:      "normal"
       -text:       ""
       -width:      0
       -maxlength:  ""
    }
    array set a [sparx $tpl $args]
    # --- do neccessary translations from pseudo-Tk to HTML/JS
    if {$a(-show)} {
       set tag "password"
    } else {
       set tag "text"
    }
    if {$a(-state:) == "normal"} {
       set a(-state:) ""
    }
    # missing translation: -bg, -fg...; what's with the ID-parm?
    # construct the object:
    proc $a(1) args "
       if {\[lindex \$args 0\] == \"configure\"} {
          if {\[llength \$args\] == 1} {
             return [list $args]
          } else {
             # add more commands later!
             set orgargs [list $args]
             # new switches at end win; drawback: the chain of switches will grow... (implement replace later)
             eval lappend orgargs \[lrange \$args 1 end\]
             eval hEntry \$orgargs; # this overwrites ourself - does it matter?
          }
       } else {
          return \"<input type=\\\"$tag\\\" name=\\\"$a(1)\\\" value=\\\"[html::quoteFormValue $a(-text:)]\\\"
             align=\\\"$a(-justify:)\\\" size=\\\"$a(-width:)\\\" $a(-state:)
             maxlength=\\\"$a(-maxlength:)\\\" [join $a(_argsuper)]>\"
       }"
    return $a(1); # return the handle (=pos.arg(1)=<input>-tag-name
 }

 # minimalistic simulation of pack/grid etc.
 proc hPack args {
    # Pack will complete later...
    foreach arg $args {
       puts [$arg]
    }
 }

 set obj1 [hEntry .h1 -justify right -text "DefaultValue" -width 30 -maxlength 40 style='background:green']
 hPack $obj1
 puts <p>
 $obj1 configure -justify left
 hPack $obj1
 puts <p>
 puts [$obj1 configure]
 exit

ideas:

  • implement a mini bind to insert on<event>-code (Javascript) into the tag
  • implement a mini grid to create and show a table with all defined elements

MHo 2010-03-09: Hm..., I thought I've written some more here as I created this page years ago... Maybe I find a copy somewhere