# 03.04.2006
lappend auto_path ./
package require sparx 1.0; # strippend down version of http://wiki.tcl.tk/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\"} {
# add more commands later!
set orgargs [list $args]
# new switches at end win; drawback: the chain of switches will grow...
eval lappend orgargs \[lrange \$args 1 end\]
eval hEntry \$orgargs
} 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]
}
}
# Tests
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>