Am 02.11.2012 21:49, schrieb Jeff Lawson:
> I think we're seeing a regression in the form package not honoring the
> default values for textareas and checkbox. It doesn't seem to affect
> text or select. Try the following example:
>
>
>
>
> package require form
>
> set response(department) "Sales"
>
> #parray response
>
> form myform -defaults response -method post
> myform start
>
> puts "<table>"
> puts "<tr><th>Department:</th><td>"
> #myform select department -values {Sales Development Operations}
> #myform text department -size 200
> myform textarea department -rows 8 -cols 80
> puts "</td></tr>"
>
> myform submit save_tps -value "Save Report"
>
> myform end
> myform destroy
Jeff,
thank you reporting this.
Indeed, textarea was forgotten. It is now corrected in the trunk.
But I don't see the issue with "select".
Below is your example and my result.
The corrected "form2.tcl" is attached.
Could you please double-check ?
Thank you,
Harald
---------------------------------------
Thus, the file:
--formtest.rvt--
<html>
<head /><body>
<?
package require form
set response(department) "Development"
#parray response
form myform -defaults response -method post
myform start
puts "<table>"
puts "<tr><th>Department:</th><td>"
myform select department -values {Sales Development Operations}
#myform text department -size 200
#myform textarea department -rows 8 -cols 80
puts "</td></tr>"
myform submit save_tps -value "Save Report"
myform end
myform destroy
?>
</body>
</html>
--eof--
returns:
--html--
<html>
<head /><body>
<form action="/formtest.rvt" method="post">
<table>
<tr><th>Department:</th><td>
<select name="department" >
<option value="Sales">Sales</option>
<option value="Development" selected="selected">Development</option>
<option value="Operations">Operations</option>
</select>
</td></tr>
<input type="submit" name="save_tps" value="Save Report" />
</form>
</body>
</html>
--eof--
a
# form.tcl -- generate forms automatically.
# Copyright 2002-2004 The Apache Software Foundation
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
# http://www.apache.org/licenses/LICENSE-2.0
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
package require Itcl
package provide form 2.0
#
# Rivet form class
#
::itcl::class form {
constructor {args} {
# set the form method to be a post and the action to be
# a refetching of the current page
set arguments(method) post
set arguments(action) [env DOCUMENT_URI]
# use $this for the type for form-global stuff like form arguments
import_data form $this arguments $args
if {[info exists arguments(defaults)]} {
# make the public variable contain the name of the array
# we are sucking default values out of
set defaults $arguments(defaults)
upvar 1 $arguments(defaults) callerDefaults
array set DefaultValues [array get callerDefaults]
unset arguments(defaults)
} else {
array set DefaultValues {}
}
}
destructor {
}
method destroy {} {
::itcl::delete object $this
}
#
# import_data -- given a field type, field name, name of an array, and a
# list of key-value pairs, prepend any default key-value pairs,
# then store the resulting key-value pairs in the named array
#
protected method import_data {type name arrayName list} {
upvar 1 $arrayName data
#
# If there are elements in the defaultArgs array for the
# specified type, combine them with the list of key-value
# pairs, putting the DefaultArgs values first so the
# key-value pairs from list can possibly override them.
#
if {[info exists DefaultArgs($type)]} {
set list [concat $DefaultArgs($type) $list]
}
#
# if we don't have an even number of key-value pairs,
# that just ain't right
#
if {[llength $list] % 2} {
return -code error "Unmatched key-value pairs"
}
#
# for each key-value pair in the list, strip the first
# dash character from the key part and map it to lower
# case, then use that as the key for the passed-in
# array and store the corresonding value in there
#
# we also prep and return the list of key-value pairs, normalized
# with the lowercase thing
#
set return ""
foreach {var val} $list {
set var [string range [string tolower $var] 1 end]
if {$var == "prefix"} {
set prefix $val
continue
}
set data($var) $val
if {($var == "values") || ($var == "labels")} { continue }
lappend return -$var $val
}
return $return
}
#
# argstring - given an array name, construct a string of the
# style key1="data1" key2="data2" etc for each key value pair in the
# array
#
protected method argstring {arrayName} {
upvar 1 $arrayName data
set string ""
foreach arg [lsort [array names data]] {
append string " $arg=\"$data($arg)\""
}
return $string
}
#
# default_value ?-list? ?--? name ?value?
#
# If value is not given, returns a default value
# for that name if one exists, else an empty list.
#
# if a name and a value are given, the default value is set to that
# name (and the new default value is returned).
#
# The default value is a list if "-list" is given.
method default_value {args} {
# Command line
if {[lindex $args 0] eq "-list"} {
set isList 1
set args [lrange $args 1 end]
}
if {[lindex $args 0] eq "--"} {
set args [lrange $args 1 end]
}
switch -exact -- [llength $args] {
1 { # Return default value
lassign $args name
if {default_exists $name]} {
if {[info exists isList]} {
return [default_list_get $name]
} else {
return [default_value_get $name]
}
} else {
return ""
}
}
2 { # Set default value
lassign $args name value
set DefaultValues($name) $value
if {[info exists isList]} {
set DefaultValues(__$name) 1
} else {
unset -nocomplain DefaultValues(__$name) 0
}
}
default { error "wrong argument count" }
}
}
#
# default_exists - return true, if a default value exists
protected method default_exists {name} {
return [info exists DefaultValues($name)]
}
#
# default_list_get - get the default value as a list
# return with error if there is no default value
protected method default_list_get {name} {
if {[info exists DefaultValues(__$name)]} {
return $DefaultValues($name)
} else {
return [list $DefaultValues($name)]
}
}
#
# default_value_get - get the default value as a value
# return with error if there is no default value
protected method default_value_get {name} {
if {[info exists DefaultValues(__$name)]} {
return [lindex $DefaultValues($name) 0]
} else {
return $DefaultValues($name)
}
}
#
# default_value_exists - return true, if the given value exists in the
# default list
protected method default_value_exists {name value} {
if { ! [info exists DefaultValues($name)] } {
return 0
}
if {[info exists DefaultValues(__$name)]} {
return [expr {$value in $DefaultValues($name)}]
}
return [expr {$value eq $DefaultValues($name)}]
}
#
# default_args - given a type and a variable number of arguments,
# if there are no arguments other than the type, return the
# element of that name from the DefaultArgs array, if that element
# exists, else return an empty list.
#
# if a name and a value are given, sets the DefaultArgs to the variable
# list of arguments.
#
method default_args {type args} {
# if only one argument was specified
if {[lempty $args]} {
if {![info exists DefaultArgs($type)]} { return ""}
return $DefaultArgs($type)
}
# make sure we have an even number of key-value pairs
if {[llength $args] % 2} {
return -code error "Unmatched key-value pairs"
}
# set the DefaultArgs for the specified type
return [set DefaultArgs($type) $args]
}
#
# start - generate the <form> with all of its arguments
#
method start {{args ""}} {
if {![lempty $args]} {
# replicated in constructor
import_data form $this arguments $args
}
html "<form [argstring arguments]>"
}
#
# end - generate the </form>
#
method end {} {
html "</form>"
}
#
# field - emit a field of the given field type and name, including
# any default key-value pairs defined for this field type and
# optional key-value pairs included with the statement
#
method field {type name args} {
# import any default key-value pairs, then any specified in this
# field declaration
import_data $type $name data $args
switch -- $type {
"radio" -
"checkbox" {
# if there's a label then prepare to output it.
if {[info exists data(label)]} {
set label "<label"
# if there's no id defined, generate something unique so we
can reference it.
if { ![info exists data(id)] } {
set data(id) "${prefix}_[incr auto_cnt]"
append label { for="} $data(id) {"}
} else {
append label { for="} $data(id) {"}
}
append label ">" $data(label) "</label>"
}
# ...and if there is a default value for this field
# and it matches the value we have for it, make
# the field show up as selected (checked)
if {[info exists data(value)]
&& [default_value_exists $name $data(value)]
} {
set data(checked) "checked"
}
}
}
# For non multi-choice widgets: set default value if there is no value
# given
if { ! [info exists data(value)]
&& [default_exists $name]
&& $type ni {"select" "radio" "checkbox"}
} {
set data(value) [default_value_get $name]
}
# generate the field definition
set string "<input type=\"$type\" name=\"$name\" [argstring data] />"
if {[info exists label]} {
append string $label
}
# ...and emit it
html $string
}
#
# text -- emit an HTML "text" field
#
method text {name args} {
field text $name {*}$args
}
#
# password -- emit an HTML "password" field
#
method password {name args} {
field password $name {*}$args
}
#
# hidden -- emit an HTML "hidden" field
#
method hidden {name args} {
field hidden $name {*}$args
}
#
# submit -- emit an HTML "submit" field
#
method submit {name args} {
field submit $name {*}$args
}
#
# button -- emit an HTML "button" field
#
method button {name args} {
field button $name {*}$args
}
#
# reset -- emit an HTML "reset" button
#
method reset {name args} {
field reset $name {*}$args
}
#
# image -- emit an HTML image field
#
method image {name args} {
field image $name {*}$args
}
#
# checkbox -- emit an HTML "checkbox" form field
#
method checkbox {name args} {
field checkbox $name {*}$args
}
#
# radio -- emit an HTML "radiobutton" form field
#
method radio {name args} {
field radio $name {*}$args
}
#
# color -- emit an HTML 5 "color" form field
#
method color {name args} {
field color $name {*}$args
}
#
# date -- emit an HTML 5 "date" form field
#
method date {name args} {
field date $name {*}$args
}
#
# datetime -- emit an HTML 5 "datetime" form field
#
method datetime {name args} {
field datetime $name {*}$args
}
#
# datetime_local -- emit an HTML 5 "datetime-local" form field
#
method datetime_local {name args} {
field datetime-local $name {*}$args
}
#
# email -- emit an HTML 5 "email" form field
#
method email {name args} {
field email $name {*}$args
}
#
# file -- emit an HTML 5 "file" form field
#
method file {name args} {
field email $name {*}$args
}
#
# month -- emit an HTML 5 "month" form field
#
method month {name args} {
field month $name {*}$args
}
#
# number -- emit an HTML 5 "number" form field
#
method number {name args} {
field number $name {*}$args
}
#
# range -- emit an HTML 5 "range" form field
#
method range {name args} {
field range $name {*}$args
}
#
# search -- emit an HTML 5 "search" form field
#
method search {name args} {
field search $name {*}$args
}
#
# tel -- emit an HTML 5 "tel" form field
#
method tel {name args} {
field tel $name {*}$args
}
#
# time -- emit an HTML 5 "time" form field
#
method time {name args} {
field time $name {*}$args
}
#
# url -- emit an HTML 5 "url" form field
#
method url {name args} {
field url $name {*}$args
}
#
# week -- emit an HTML 5 "week" form field
#
method week {name args} {
field week $name {*}$args
}
#
# radiobuttons --
#
method radiobuttons {name args} {
set data(values) [list]
set data(labels) [list]
set list [import_data radiobuttons $name data $args]
if {[lempty $data(labels)]} {
set data(labels) $data(values)
}
foreach label $data(labels) value $data(values) {
radio $name {*}$list -label $label -value $value
}
}
#
# checkboxes --
#
method checkboxes {name args} {
set data(values) [list]
set data(labels) [list]
set list [import_data checkboxes $name data $args]
if {[lempty $data(labels)]} {
set data(labels) $data(values)
}
foreach label $data(labels) value $data(values) {
checkbox $name {*}$list -label $label -value $value
}
}
#
# select -- generate a selector
#
# part of the key value pairs can include -values with a list,
# and -labels with a list and it'll populate the <option>
# elements with them. if one matches the default value,
# it'll select it too.
#
method select {name args} {
# start with empty values and labels so they'll exist even if not set
set data(values) [list]
set data(labels) [list]
# import any default data and key-value pairs from the method args
import_data select $name data $args
# pull the values and labels into scalar variables and remove them
# from the data array
set values $data(values)
set labels $data(labels)
unset data(values) data(labels)
# get the list of default values
if {[default_exists $name]} {
set default_list [default_list_get $name]
}
# if there is a value set in the value field of the data array,
# use that instead (that way if we're putting up a form with
# data already, the data'll show up)
# This data is a list for multiple forms
if {[info exists data(value)]} {
if {[info exists data(multiple)]} {
set default_list $data(value)
} else {
set default_list [list $data(value)]
}
unset data(value)
}
#
# if there are no separate labels defined, use the list of
# values for the labels
#
if {[lempty $labels]} {
set labels $values
}
# emit the selector
html "<select name=\"$name\" [argstring data]>"
# emit each label-value pair
foreach label $labels value $values {
if {[info exists default_list] && $value in $default_list } {
set string "<option value=\"$value\" selected=\"selected\">"
} else {
set string "<option value=\"$value\">"
}
html "$string$label</option>"
}
html "</select>"
}
#
# textarea -- emit an HTML "textarea" form field
#
method textarea {name args} {
import_data textarea $name data $args
set value ""
if {[info exists data(value)]} {
set value $data(value)
unset data(value)
} elseif {[default_exists $name]} {
set value [default_value_get $name]
}
html "<textarea name=\"$name\" [argstring data]>$value</textarea>"
}
#
# defaults -- when set, the value is the name of an array to suck
# the key-value pairs out of and copy them into DefaultValues
#
public variable defaults "" {
upvar 1 $defaults array
array set DefaultValues [array get array]
}
private variable DefaultValues
private variable DefaultArgs
private variable arguments
private variable auto_cnt 0
public variable prefix autogen
} ; ## ::itcl::class form
---------------------------------------------------------------------
To unsubscribe, e-mail: rivet-dev-unsubscr...@tcl.apache.org
For additional commands, e-mail: rivet-dev-h...@tcl.apache.org
