Index: openacs-4/packages/q-forms/q-forms.info
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/q-forms/q-forms.info,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/q-forms/q-forms.info 14 Nov 2014 18:27:52 -0000 1.1
+++ openacs-4/packages/q-forms/q-forms.info 8 Apr 2015 08:34:36 -0000 1.2
@@ -9,14 +9,14 @@
<implements-subsite-p>f</implements-subsite-p>
<inherit-templates-p>f</inherit-templates-p>
- <version name="0.035" url="http://openacs.org/repository/download/apm/q-forms-0.035.apm">
+ <version name="0.040" url="http://openacs.org/repository/download/apm/q-forms-0.040.apm">
<owner url="mailto:tekbasse@yahoo.com">Benjamin Brink</owner>
<owner url="http://openacs.org">OpenACS Community</owner>
<summary>Provides code for building forms dynamically in tcl</summary>
<description format="text/plain">Provides qf_* form bulding and interpreting procedures, especially designed for building forms dynamically.</description>
<maturity>1</maturity>
- <provides url="q-forms" version="0.035"/>
+ <provides url="q-forms" version="0.040"/>
<callbacks>
</callbacks>
Index: openacs-4/packages/q-forms/tcl/form-helper-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/q-forms/tcl/form-helper-procs.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/q-forms/tcl/form-helper-procs.tcl 14 Nov 2014 18:27:52 -0000 1.1
+++ openacs-4/packages/q-forms/tcl/form-helper-procs.tcl 8 Apr 2015 08:34:36 -0000 1.2
@@ -217,34 +217,43 @@
}
}
# sort by smallest variance
- set sorted_bg_lists [lsort -increasing -real -index 2 $bguess_lists]
- ns_log Notice "qss_txt_table_stats.220: sorted_bg_lists ${sorted_bg_lists}"
- set i [lindex [lindex $sorted_bg_lists 0] 0]
- set bguess $table_arr(${i}-bguess)
- set bguessD $table_arr(${i}-bguessD)
- set rows_count $table_arr(${i}-rows)
- set delimiter $table_arr(${i}-delim)
-
- # If there are no bguesses over 2, then use this process:
- if { [llength $bguess_lists] == 0 } {
- # This following techinque is not dynamic enough to handle all conditions.
- set bguessD $table_arr(0-bguessD)
- set bguess $table_arr(0-bguess)
- set rows_count $table_arr(0-rows)
- set delimiter $table_arr(0-delim)
- # bguessD is absolute value of bguess from variance
- for { set i 0 } { $i < $delimC } { incr i } {
- if { ( $table_arr(${i}-bguessD) <= $bguessD ) && $table_arr(${i}-bguess) > 1 } {
- if { ( $bguess > 1 && $table_arr(${i}-bguess) < $bguess ) || $bguess < 2 } {
- set bguess $table_arr(${i}-bguess)
- set bguessD $table_arr(${i}-bguessD)
- set rows_count $table_arr(${i}-rows)
- set delimiter $table_arr(${i}-delim)
+ if { [llength $bguess_lists] > 0 } {
+ set sorted_bg_lists [lsort -increasing -real -index 2 $bguess_lists]
+ ns_log Notice "qss_txt_table_stats.220: sorted_bg_lists '${sorted_bg_lists}'"
+ set i [lindex [lindex $sorted_bg_lists 0] 0]
+ set bguess $table_arr(${i}-bguess)
+ set bguessD $table_arr(${i}-bguessD)
+ set rows_count $table_arr(${i}-rows)
+ set delimiter $table_arr(${i}-delim)
+
+ # If there are no bguesses over 2, then use this process:
+ if { [llength $bguess_lists] == 0 } {
+ # This following techinque is not dynamic enough to handle all conditions.
+ set bguessD $table_arr(0-bguessD)
+ set bguess $table_arr(0-bguess)
+ set rows_count $table_arr(0-rows)
+ set delimiter $table_arr(0-delim)
+ # bguessD is absolute value of bguess from variance
+ for { set i 0 } { $i < $delimC } { incr i } {
+ if { ( $table_arr(${i}-bguessD) <= $bguessD ) && $table_arr(${i}-bguess) > 1 } {
+ if { ( $bguess > 1 && $table_arr(${i}-bguess) < $bguess ) || $bguess < 2 } {
+ set bguess $table_arr(${i}-bguess)
+ set bguessD $table_arr(${i}-bguessD)
+ set rows_count $table_arr(${i}-rows)
+ set delimiter $table_arr(${i}-delim)
+ }
}
}
}
+ ns_log Notice "qss_txt_table_stats linebreak '${linebreak_char}' delim '${delimiter}' rows '${rows_count}' columns '${bguess}'"
+ } else {
+ # There appears to be no rows or columns
+ # create defaults
+ set linebreak_char "\n"
+ set delimiter "\t"
+ set rows_count 1
+ set bguess 1
}
- ns_log Notice "qss_txt_table_stats linebreak '${linebreak_char}' delim '${delimiter}' rows '${rows_count}' columns '${bguess}'"
set return_list [list $linebreak_char $delimiter $rows_count $bguess]
# ns_log Notice "qss_txt_table_stats: return_list $return_list"
return $return_list
@@ -256,10 +265,13 @@
table_list_of_lists
{table_attribute_list ""}
{td_attribute_lists ""}
+ {th_rows "1"}
} {
Converts a tcl list_of_lists to an html table, returns table as text/html
table_attribute_list can be a list of attribute pairs to pass to the TABLE tag: attribute1 value1 attribute2 value2..
- The td_attribute_lists adds attributes to TD tags at the same position as table_list_of_lists
+ td_attribute_lists adds attributes to TD tags at the same position as table_list_of_lists
+ First row(s) use html accessibility guidelines TH tag inplace of TD.
+ Number of th_rows sets the number of rows that use TH tag. Default is 1.
the list is represented {row1 {cell1} {cell2} {cell3} .. {cell x} } {row2 {cell1}...}
Note that attribute - value pairs in td_attribute_lists can be added uniquely to each TD tag.
} {
@@ -278,10 +290,19 @@
set repeat_last_row_p 1
set repeat_row [expr { [llength $td_attribute_lists] - 1 } ]
}
+ set td_tag "th"
+ set td_tag_html "<"
+ append td_tag_html $td_tag
foreach row_list $table_list_of_lists {
append table_html "<tr>"
+ if { $row_i == $th_rows } {
+ set td_tag "td"
+ set td_tag_html "<"
+ append td_tag_html $td_tag
+ }
+
foreach column $row_list {
- append table_html "<td"
+ append table_html $td_tag_html
if { $repeat_last_row_p && $row_i > $repeat_row } {
set attribute_value_list [lindex [lindex $td_attribute_lists $repeat_row] $column_i]
@@ -292,7 +313,7 @@
regsub -all -- {\"} $value {\"} value
append table_html " $attribute=\"$value\""
}
- append table_html ">${column}</td>"
+ append table_html ">${column}</${td_tag}>"
incr column_i
}
append table_html "</tr>\n"
Index: openacs-4/packages/q-forms/tcl/form-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/q-forms/tcl/form-procs.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/q-forms/tcl/form-procs.tcl 14 Nov 2014 18:27:52 -0000 1.1
+++ openacs-4/packages/q-forms/tcl/form-procs.tcl 8 Apr 2015 08:34:36 -0000 1.2
@@ -38,8 +38,8 @@
# set instance_id package_id
set instance_id [ad_conn package_id]
}
-# set time_sec \[ns_time\]
-# need more time separation
+ # set time_sec \[ns_time\]
+ # need more time separation
if { $key_id eq "" } {
set key_id [expr { int( [clock clicks] * [ns_rand] ) } ]
}
@@ -51,7 +51,7 @@
set secure_p [security::secure_conn_p]
set session_id [ad_conn session_id]
set action_url [ns_conn url]
- # set render_timestamp $time_sec
+ # set render_timestamp $time_sec
} else {
set server_ip [ns_config ns/server/[ns_info server]/module/nssock Address]
if { $server_ip eq "" } {
@@ -63,13 +63,13 @@
set secure_p [expr { floor( [ns_rand] + 0.5 ) } ]
set session_id [expr { floor( $time_sec / 4 ) } ]
-# set action_url "/"
-# set render_timestamp $time_sec
+ # set action_url "/"
+ # set render_timestamp $time_sec
}
append sec_hash_string $start_clicks $session_id $secure_p $client_ip $action_url $time_sec $key_id
set sec_hash [ns_sha1 $sec_hash_string]
db_dml qf_form_key_create {insert into qf_key_map
- (instance_id,rendered_timestamp,sec_hash,key_id,session_id,action_url,secure_conn_p,client_ip)
+ (instance_id,rendered_timestamp,sec_hash,key_id,session_id,action_url,secure_conn_p,client_ip)
values (:instance_id,:time_sec,:sec_hash,:key_id,:session_id,:action_url,:secure_p,:client_ip) }
return $sec_hash
}
@@ -126,16 +126,15 @@
ad_proc -public qf_get_inputs_as_array {
{form_array_name "__form_input_arr"}
{arg1 ""}
- {arg2 ""}
- {arg3 ""}
- {arg4 ""}
- {arg5 ""}
- {arg6 ""}
+ {value1 ""}
+ args
} {
Get inputs from form submission, quotes all input values. Use ad_unquotehtml to unquote a value.
Returns 1 if form inputs exist, otherwise returns 0.
If duplicate_key_check is 1, checks if an existing key/value pair already exists, otherwise just overwrites existing value.
- Overwriting is programmatically useful to overwrite preset defaults, for example.
+ If multiple_key_as_list is 1, returns a list of values for duplicate (and multiple) referenced keys.
+ If hash_check is 1, confirms that input is from one instance of a form generated by q_form
+ by confirming that unique hash passed by form is the same as the hash generated at time form was generated.
} {
# get args
upvar 1 $form_array_name __form_input_arr
@@ -144,16 +143,28 @@
set arg_arr(multiple_key_as_list) 0
set arg_arr(hash_check) 0
set arg_full_list [list duplicate_key_check multiple_key_as_list hash_check]
- set arg_list [list $arg1 $arg2 $arg3 $arg4 $arg5 $arg6 ]
- set args_list [list]
+ #set arg_list [list $arg1 $arg2 $arg3 $arg4 $arg5 $arg6 ]
+ # collect args
+ if { [llength $arg1] > 1 && $value1 eq "" } {
+ set arg_list $arg1
+ foreach arg $args {
+ lappend args_list $arg
+ }
+ } elseif { $arg1 ne "" } {
+ lappend args $arg1 $value1
+ set arg_list $args
+ } else {
+ set arg_list [list ]
+ }
+ # normalize args
foreach {name value} $arg_list {
- set arg_index [lsearch -exact $arg_full_list $name]
- if { $arg_index > -1 } {
+ set attribute_index [lsearch -exact $arg_full_list $name]
+ if { $attribute_index > -1 } {
set arg_arr($name) $value
- } elseif { $value eq "" } {
- # ignore
} else {
- ns_log Error "qf_get_inputs_as_array: $name is not a valid name invoked with name value pairs. Separate each with a space."
+ if { $name ne "" } {
+ ns_log Error "qf_get_inputs_as_array: '${name}' is not a valid name for use with args."
+ }
}
}
@@ -176,16 +187,16 @@
# no inserting tcl commands etc!
if { $__form_key_exists == 0 || ( $__form_key_exists == 1 && [string length $__form_key] == 0 ) } {
# let's make this an error for now, so we log any attempts
-# ns_log Notice "qf_get_inputs_as_array: __form_key_exists ${__form_key_exists} length __form_key [string length ${__form_key}]"
- # ns_log Notice "qf_get_inputs_as_array(ref156: attempt to insert unallowed characters to user input '{__form_key}' as '[ns_set key $__form $__form_counter_i]' for counter ${__form_counter_i}."
+ # ns_log Notice "qf_get_inputs_as_array: __form_key_exists ${__form_key_exists} length __form_key [string length ${__form_key}]"
+ # ns_log Notice "qf_get_inputs_as_array(ref156: attempt to insert unallowed characters to user input '{__form_key}' as '[ns_set key $__form $__form_counter_i]' for counter ${__form_counter_i}."
if { $__form_counter_i > 0 } {
ns_log Notice "qf_get_inputs_as_array: attempt to insert unallowed characters to user input '{__form_key}'."
}
} else {
set __form_key [ad_quotehtml $__form_key]
# The name of the argument passed in the form
# no legitimate argument should be affected by quoting:
-
+
# This is the value
set __form_input [ad_quotehtml [ns_set value $__form $__form_counter_i]]
@@ -213,7 +224,7 @@
}
} else {
set __form_buffer_arr($__form_key) $__form_input
-# ns_log Debug "qf_get_inputs_as_array: set ${form_array_name}($__form_key) '${__form_input}'."
+ # ns_log Debug "qf_get_inputs_as_array: set ${form_array_name}($__form_key) '${__form_input}'."
}
# next key-value pair
@@ -256,27 +267,8 @@
ad_proc -public qf_form {
{arg1 ""}
- {arg2 ""}
- {arg3 ""}
- {arg4 ""}
- {arg5 ""}
- {arg6 ""}
- {arg7 ""}
- {arg8 ""}
- {arg9 ""}
- {arg10 ""}
- {arg11 ""}
- {arg12 ""}
- {arg13 ""}
- {arg14 ""}
- {arg15 ""}
- {arg16 ""}
- {arg17 ""}
- {arg18 ""}
- {arg19 ""}
- {arg20 ""}
- {arg21 ""}
- {arg22 ""}
+ {value1 ""}
+ args
} {
Initiates a form with form tag and supplied attributes. Returns an id. A clumsy url based id is provided if not passed (not recommended).
If hash_check passed, creates a hash to be checked on submit for server-client transaction continuity.
@@ -289,21 +281,23 @@
upvar 1 __qf_remember_attributes __qf_remember_attributes
upvar 1 __qf_arr __qf_arr
- # if proc was passed a list of parameters, parse
- if { [llength $arg1] > 1 && [llength $arg2] == 0 } {
- set arg1_list $arg1
- set lposition 1
- foreach arg $arg1_list {
- set arg${lposition} $arg
- incr lposition
+ # collect args
+ if { [llength $arg1] > 1 && $value1 eq "" } {
+ set arg_list $arg1
+ foreach arg $args {
+ lappend args_list $arg
}
- unset arg1_list
+ } elseif { $arg1 ne "" } {
+ lappend args $arg1 $value1
+ set arg_list $args
+ } else {
+ set arg_list [list ]
}
set attributes_tag_list [list action class id method name style target title]
set attributes_full_list $attributes_tag_list
lappend attributes_full_list form_id hash_check key_id
- set arg_list [list $arg1 $arg2 $arg3 $arg4 $arg5 $arg6 $arg7 $arg8 $arg9 $arg10 $arg11 $arg12 $arg13 $arg14 $arg15 $arg16 $arg17 $arg18 $arg19 $arg20 $arg21 $arg22]
+
set attributes_list [list]
foreach {attribute value} $arg_list {
set attribute_index [lsearch -exact $attributes_full_list $attribute]
@@ -312,17 +306,15 @@
if { [lsearch -exact $attributes_tag_list $attribute] > -1 } {
lappend attributes_list $attribute
}
- } elseif { $value eq "" } {
- # ignore
} else {
- ns_log Error "qf_form: $attribute is not a valid attribute. invoke with attribute value pairs. Separate each with a space."
+ ns_log Error "qf_form: '${attribute}' is not a valid attribute."
}
}
if { ![info exists attributes_arr(method)] } {
set attributes_arr(method) "post"
lappend attributes_list "method"
}
-# if html5 should we default novalidate to novalidate? No for now.
+ # if html5 should we default novalidate to novalidate? No for now.
if { ![info exists __qf_remember_attributes] } {
set __qf_remember_attributes 0
@@ -394,19 +386,8 @@
ad_proc -public qf_fieldset {
{arg1 ""}
- {arg2 ""}
- {arg3 ""}
- {arg4 ""}
- {arg5 ""}
- {arg6 ""}
- {arg7 ""}
- {arg8 ""}
- {arg9 ""}
- {arg10 ""}
- {arg11 ""}
- {arg12 ""}
- {arg13 ""}
- {arg14 ""}
+ {value1 ""}
+ args
} {
Starts a form fieldset by appending a fieldset tag. Fieldset closes when form is closed or another fieldset defined in same form.
} {
@@ -418,21 +399,23 @@
upvar 1 __qf_arr __qf_arr
upvar 1 __form_ids_fieldset_open_list __form_ids_fieldset_open_list
- # if proc was passed a list of parameters, parse
- if { [llength $arg1] > 1 && [llength $arg2] == 0 } {
- set arg1_list $arg1
- set lposition 1
- foreach arg $arg1_list {
- set arg${lposition} $arg
- incr lposition
+ # collect args
+ if { [llength $arg1] > 1 && $value1 eq "" } {
+ set arg_list $arg1
+ foreach arg $args {
+ lappend args_list $arg
}
- unset arg1_list
+ } elseif { $arg1 ne "" } {
+ lappend args $arg1 $value1
+ set arg_list $args
+ } else {
+ set arg_list [list ]
}
set attributes_tag_list [list align class id style title valign]
set attributes_full_list $attributes_tag_list
lappend attributes_full_list form_id
- set arg_list [list $arg1 $arg2 $arg3 $arg4 $arg5 $arg6 $arg7 $arg8 $arg9 $arg10 $arg11 $arg12 $arg13 $arg14]
+
set attributes_list [list]
foreach {attribute value} $arg_list {
set attribute_index [lsearch -exact $attributes_full_list $attribute]
@@ -441,10 +424,8 @@
if { [lsearch -exact $attributes_tag_list $attribute] > -1 } {
lappend attributes_list $attribute
}
- } elseif { $value eq "" } {
- # do nothing
} else {
- ns_log Error "qf_fieldset: $attribute is not a valid attribute. invoke with attribute value pairs. Separate each with a space."
+ ns_log Error "qf_fieldset: '${attribute}' is not a valid attribute."
ad_script_abort
}
}
@@ -510,35 +491,8 @@
ad_proc -public qf_textarea {
{arg1 ""}
- {arg2 ""}
- {arg3 ""}
- {arg4 ""}
- {arg5 ""}
- {arg6 ""}
- {arg7 ""}
- {arg8 ""}
- {arg9 ""}
- {arg10 ""}
- {arg11 ""}
- {arg12 ""}
- {arg13 ""}
- {arg14 ""}
- {arg15 ""}
- {arg16 ""}
- {arg17 ""}
- {arg18 ""}
- {arg19 ""}
- {arg20 ""}
- {arg21 ""}
- {arg22 ""}
- {arg23 ""}
- {arg24 ""}
- {arg25 ""}
- {arg26 ""}
- {arg27 ""}
- {arg28 ""}
- {arg29 ""}
- {arg30 ""}
+ {value1 ""}
+ args
} {
Creates a form textarea tag, supplying attributes where nonempty values are supplied.
Attribute "label" places a label tag just before textarea tag, instead of wrapping around textarea
@@ -553,21 +507,23 @@
upvar 1 __qf_arr __qf_arr
upvar 1 __form_ids_fieldset_open_list __form_ids_fieldset_open_list
- # if proc was passed a list of parameters, parse
- if { [llength $arg1] > 1 && [llength $arg2] == 0 } {
- set arg1_list $arg1
- set lposition 1
- foreach arg $arg1_list {
- set arg${lposition} $arg
- incr lposition
+ # collect args
+ if { [llength $arg1] > 1 && $value1 eq "" } {
+ set arg_list $arg1
+ foreach arg $args {
+ lappend args_list $arg
}
- unset arg1_list
+ } elseif { $arg1 ne "" } {
+ lappend args $arg1 $value1
+ set arg_list $args
+ } else {
+ set arg_list [list ]
}
set attributes_tag_list [list accesskey align class cols id name readonly rows style tabindex title wrap]
set attributes_full_list $attributes_tag_list
lappend attributes_full_list value label form_id
- set arg_list [list $arg1 $arg2 $arg3 $arg4 $arg5 $arg6 $arg7 $arg8 $arg9 $arg10 $arg11 $arg12 $arg13 $arg14 $arg15 $arg16 $arg17 $arg18 $arg19 $arg20 $arg21 $arg22 $arg23 $arg24 $arg25 $arg26 $arg27 $arg28 $arg29 $arg30]
+
set attributes_list [list]
foreach {attribute value} $arg_list {
set attribute_index [lsearch -exact $attributes_full_list $attribute]
@@ -576,10 +532,8 @@
if { [lsearch -exact $attributes_tag_list $attribute ] > -1 } {
lappend attributes_list $attribute
}
- } elseif { $value eq "" } {
- # do nothing
} else {
- ns_log Error "qf_textarea: $attribute is not a valid attribute. invoke with attribute value pairs. Separate each with a space."
+ ns_log Error "qf_textarea: '${attribute}' is not a valid attribute."
ad_script_abort
}
}
@@ -638,38 +592,13 @@
}
# set results __form_arr, we checked form_id above.
append __form_arr($attributes_arr(form_id)) "${tag_html}\n"
-
+
}
ad_proc -public qf_select {
{arg1 ""}
- {arg2 ""}
- {arg3 ""}
- {arg4 ""}
- {arg5 ""}
- {arg6 ""}
- {arg7 ""}
- {arg8 ""}
- {arg9 ""}
- {arg10 ""}
- {arg11 ""}
- {arg12 ""}
- {arg13 ""}
- {arg14 ""}
- {arg15 ""}
- {arg16 ""}
- {arg17 ""}
- {arg18 ""}
- {arg19 ""}
- {arg20 ""}
- {arg21 ""}
- {arg22 ""}
- {arg23 ""}
- {arg24 ""}
- {arg25 ""}
- {arg26 ""}
- {arg27 ""}
- {arg28 ""}
+ {value1 ""}
+ args
} {
Creates a SELECT tag with nested OPTIONS, supplying necessary attributes where nonempty values are supplied. Set "multiple" to 1 to activate multiple attribute.
The argument for the "value" attribute is a list_of_lists passed to qf_options, where the list_of_lists represents a list of OPTION tag attribute/value pairs.
@@ -683,21 +612,23 @@
upvar 1 __qf_arr __qf_arr
upvar 1 __form_ids_select_open_list __form_ids_select_open_list
- # if proc was passed a list of parameters, parse
- if { [llength $arg1] > 1 && [llength $arg2] == 0 } {
- set arg1_list $arg1
- set lposition 1
- foreach arg $arg1_list {
- set arg${lposition} $arg
- incr lposition
+ # collect args
+ if { [llength $arg1] > 1 && $value1 eq "" } {
+ set arg_list $arg1
+ foreach arg $args {
+ lappend args_list $arg
}
- unset arg1_list
+ } elseif { $arg1 ne "" } {
+ lappend args $arg1 $value1
+ set arg_list $args
+ } else {
+ set arg_list [list ]
}
set attributes_tag_list [list accesskey align class cols id name readonly rows style tabindex title wrap]
set attributes_full_list $attributes_tag_list
lappend attributes_full_list value form_id value_html multiple
- set arg_list [list $arg1 $arg2 $arg3 $arg4 $arg5 $arg6 $arg7 $arg8 $arg9 $arg10 $arg11 $arg12 $arg13 $arg14 $arg15 $arg16 $arg17 $arg18 $arg19 $arg20 $arg21 $arg22 $arg23 $arg24 $arg25 $arg26 $arg27 $arg28]
+
set attributes_list [list]
foreach {attribute value} $arg_list {
set attribute_index [lsearch -exact $attributes_full_list $attribute]
@@ -706,10 +637,8 @@
if { [lsearch -exact $attributes_tag_list $attribute] > -1 } {
lappend attributes_list $attribute
}
- } elseif { $value eq "" } {
- # do nothing
} else {
- ns_log Error "qf_select: [ad_quotehtml [string range $attribute 0 15]] is not a valid attribute. invoke with attribute value pairs. Separate each with a space."
+ ns_log Error "qf_select: '[ad_quotehtml [string range $attribute 0 15]]' is not a valid attribute."
ad_script_abort
}
}
@@ -743,8 +672,8 @@
# prepare attributes to process
set tag_attributes_list [list]
foreach attribute $attributes_list {
- set __qf_arr(select_$attribute) $attributes_arr($attribute)
- lappend tag_attributes_list $attribute $attributes_arr($attribute)
+ set __qf_arr(select_$attribute) $attributes_arr($attribute)
+ lappend tag_attributes_list $attribute $attributes_arr($attribute)
}
set tag_html ""
@@ -756,7 +685,7 @@
set __select_open_list_exists [info exists __form_ids_select_open_list]
if { $__select_open_list_exists } {
if { [lsearch $__form_ids_select_open_list $attributes_arr(form_id)] > -1 } {
-# append tag_html "</select>\n"
+ # append tag_html "</select>\n"
set previous_select 1
}
}
@@ -897,11 +826,11 @@
if { $attribute_index > -1 } {
set attributes_arr($attribute) $value
lappend attributes_list $attribute
- } elseif { $value eq "" } {
- # do nothing
} else {
- ns_log Error "qf_close: $attribute is not a valid attribute. invoke with attribute value pairs. Separate each with a space."
- ad_script_abort
+ if { $attribute ne "" } {
+ ns_log Error "qf_close: '${attribute}' is not a valid attribute."
+ ad_script_abort
+ }
}
}
@@ -998,7 +927,7 @@
if { ![info exists __form_arr($attributes_arr(id)) ] } {
ns_log Warning "qf_read: unknown form_id $attributes_arr(id)"
} else {
- set form_s $__form_arr($attributes_arr(id))
+ set form_s $__form_arr($attributes_arr(id))
}
} else {
set forms_list [list]
@@ -1019,37 +948,8 @@
ad_proc -public qf_input {
{arg1 ""}
- {arg2 ""}
- {arg3 ""}
- {arg4 ""}
- {arg5 ""}
- {arg6 ""}
- {arg7 ""}
- {arg8 ""}
- {arg9 ""}
- {arg10 ""}
- {arg11 ""}
- {arg12 ""}
- {arg13 ""}
- {arg14 ""}
- {arg15 ""}
- {arg16 ""}
- {arg17 ""}
- {arg18 ""}
- {arg19 ""}
- {arg20 ""}
- {arg21 ""}
- {arg22 ""}
- {arg23 ""}
- {arg24 ""}
- {arg25 ""}
- {arg26 ""}
- {arg27 ""}
- {arg28 ""}
- {arg29 ""}
- {arg30 ""}
- {arg31 ""}
- {arg32 ""}
+ {value1 ""}
+ args
} {
creates a form input tag, supplying attributes where nonempty values are supplied. when using CHECKED, set the attribute to 1.
allowed attributes: type accesskey align alt border checked class id maxlength name readonly size src tabindex value title.
@@ -1064,21 +964,22 @@
upvar 1 __qf_arr __qf_arr
upvar 1 __form_ids_fieldset_open_list __form_ids_fieldset_open_list
- # if proc was passed a list of parameters, parse
- if { [llength $arg1] > 1 && [llength $arg2] == 0 } {
- set arg1_list $arg1
- set lposition 1
- foreach arg $arg1_list {
- set arg${lposition} $arg
- incr lposition
+ # collect args
+ if { [llength $arg1] > 1 && $value1 eq "" } {
+ set arg_list $arg1
+ foreach arg $args {
+ lappend args_list $arg
}
- unset arg1_list
+ } elseif { $arg1 ne "" } {
+ lappend args $arg1 $value1
+ set arg_list $args
+ } else {
+ set arg_list [list ]
}
set attributes_tag_list [list type accesskey align alt border checked class id maxlength name readonly size src tabindex value]
set attributes_full_list $attributes_tag_list
lappend attributes_full_list form_id label selected title
- set arg_list [list $arg1 $arg2 $arg3 $arg4 $arg5 $arg6 $arg7 $arg8 $arg9 $arg10 $arg11 $arg12 $arg13 $arg14 $arg15 $arg16 $arg17 $arg18 $arg19 $arg20 $arg21 $arg22 $arg23 $arg24 $arg25 $arg26 $arg27 $arg28 $arg29 $arg30 $arg31 $arg32]
set attributes_list [list]
foreach {attribute value} $arg_list {
@@ -1091,7 +992,7 @@
} elseif { $value eq "" } {
# do nothing
} else {
- ns_log Error "qf_input: $attribute is not a valid attribute. invoke with attribute value pairs. Separate each with a space."
+ ns_log Error "qf_input: '${attribute}' is not a valid attribute."
}
}
@@ -1153,7 +1054,7 @@
lappend tag_attributes_list $attribute $attributes_arr($attribute)
} else {
set tag_suffix " ${attribute}"
- # set to checked or disabled
+ # set to checked or disabled
}
}
@@ -1178,17 +1079,14 @@
# set results __form_arr, we checked form_id above.
append __form_arr($attributes_arr(form_id)) "${tag_html}\n"
-
+
return "${tag_html}\n"
}
ad_proc -public qf_append {
{arg1 ""}
- {arg2 ""}
- {arg3 ""}
- {arg4 ""}
- {arg5 ""}
- {arg6 ""}
+ {value1 ""}
+ args
} {
param html required
param form_id
@@ -1201,18 +1099,28 @@
upvar 1 __qf_arr __qf_arr
upvar 1 __form_ids_fieldset_open_list __form_ids_fieldset_open_list
+ # collect args
+ if { [llength $arg1] > 1 && $value1 eq "" } {
+ set arg_list $arg1
+ foreach arg $args {
+ lappend args_list $arg
+ }
+ } elseif { $arg1 ne "" } {
+ lappend args $arg1 $value1
+ set arg_list $args
+ } else {
+ set arg_list [list ]
+ }
+
set attributes_full_list [list html form_id]
- set arg_list [list $arg1 $arg2 $arg3 $arg4 $arg5 $arg6]
set attributes_list [list]
foreach {attribute value} $arg_list {
set attribute_index [lsearch -exact $attributes_full_list $attribute]
if { $attribute_index > -1 } {
set attributes_arr($attribute) $value
lappend attributes_list $attribute
- } elseif { $value eq "" } {
- # do nothing
} else {
- ns_log Error "qf_append: $attribute is not a valid attribute. invoke with attribute value pairs. Separate each with a space."
+ ns_log Error "qf_append: '${attribute}' is not a valid attribute."
ad_script_abort
}
}
@@ -1251,72 +1159,51 @@
} {
returns args_list of tag attribute pairs (attribute,value) as html to be inserted into a tag
} {
- set args_html ""
- foreach {attribute value} $args_list {
- if { [string range $attribute 1 1] eq "-" } {
- set $attribute [string range $attribute 1 end]
- }
- regsub -all -- {\"} $value {\"} value
- append args_html " $attribute=\"$value\""
- }
- return $args_html
+ set args_html ""
+ foreach {attribute value} $args_list {
+ if { [string range $attribute 1 1] eq "-" } {
+ set $attribute [string range $attribute 1 end]
+ }
+ regsub -all -- {\"} $value {\"} value
+ append args_html " $attribute=\"$value\""
+ }
+ return $args_html
}
ad_proc -public qf_choice {
{arg1 ""}
- {arg2 ""}
- {arg3 ""}
- {arg4 ""}
- {arg5 ""}
- {arg6 ""}
- {arg7 ""}
- {arg8 ""}
- {arg9 ""}
- {arg10 ""}
- {arg11 ""}
- {arg12 ""}
- {arg13 ""}
- {arg14 ""}
- {arg15 ""}
- {arg16 ""}
- {arg17 ""}
- {arg18 ""}
- {arg19 ""}
- {arg20 ""}
- {arg21 ""}
- {arg22 ""}
- {arg23 ""}
- {arg24 ""}
+ {value1 ""}
+ args
} {
Returns html of a select/option bar or radio button list (where only 1 value is returned to a posted form).
Set "type" to "select" for select bar, or "radio" for radio buttons
Required attributes: name, value
"value" argument is a list_of_lists, each list item contains a list of attribute/value pairs for generating a radio or option/bar item.
"selected" is not required. Each choice is "unselected" by default. Set "selected" attribute to 1 to indicate item selected.
For this proc, "label" refers to the text that labels a radio buttion or select option item. If a "label" attribute/value pair is not included, The tag's value attribute is used for label as well.
-<pre>
-Example usage. This code:
+ <pre>
+ Example usage. This code:
set tag_attribute_list [list [list label " label1 " value visa1] [list label " label2 " value visa2] [list label " label3 " value visa3] ]
qf_choice type radio name creditcard value $tag_attribute_list
-Generates:
+ Generates:
-"<label><input type="radio" name="creditcard" value="visa1"> label1 </label>
+ "<label><input type="radio" name="creditcard" value="visa1"> label1 </label>
<label><input type="radio" name="creditcard" value="visa2"> label2 </label>
<label><input type="radio" name="creditcard" value="visa3"> label3 </label>"
-By switching type to select like this:
+ By switching type to select like this:
qf_choice type select name creditcard value $tag_attribute_list
-the code generates:
+ the code generates:
-"<select name="creditcard">
+ "<select name="creditcard">
<option value="visa1"> label1 </option>
<option value="visa2"> label2 </option>
<option value="visa3"> label3 </option>
</select>"
-</pre>
+ </pre>
<!-- < is used to prevent browser views from rendering the code presented here -->
} {
# use upvar to set form content, set/change defaults
@@ -1326,10 +1213,24 @@
upvar 1 __qf_remember_attributes __qf_remember_attributes
upvar 1 __qf_arr __qf_arr
upvar 1 __form_ids_select_open_list __form_ids_select_open_list
+
+ # collect args
+ if { [llength $arg1] > 1 && $value1 eq "" } {
+ set arg_list $arg1
+ foreach arg $args {
+ lappend args_list $arg
+ }
+ } elseif { $arg1 ne "" } {
+ lappend args $arg1 $value1
+ set arg_list $args
+ } else {
+ set arg_list [list ]
+ }
+
set attributes_select_list [list value accesskey align class cols name readonly rows style tabindex title wrap]
set attributes_full_list $attributes_select_list
lappend attributes_full_list type form_id id
- set arg_list [list $arg1 $arg2 $arg3 $arg4 $arg5 $arg6 $arg7 $arg8 $arg9 $arg10 $arg11 $arg12 $arg13 $arg14 $arg15 $arg16 $arg17 $arg18 $arg19 $arg20 $arg21 $arg22 $arg23 $arg24]
+
set attributes_list [list]
set select_list [list]
foreach {attribute value} $arg_list {
@@ -1344,7 +1245,7 @@
} elseif { $value eq "" } {
# do nothing
} else {
- ns_log Error "qf_choice: [string range $attribute 0 15] is not a valid attribute. invoke with attribute value pairs. Separate each with a space."
+ ns_log Error "qf_choice: [string range $attribute 0 15] is not a valid attribute."
ad_script_abort
}
}
@@ -1360,7 +1261,7 @@
}
lappend select_list form_id $attributes_arr(form_id)
-
+
# if attributes_arr(type) = select, then items are option tags wrapped by a select tag
# if attributes_arr(type) = radio, then items are input tags, wrapped in a list for now
@@ -1430,37 +1331,16 @@
ad_proc -public qf_choices {
{arg1 ""}
- {arg2 ""}
- {arg3 ""}
- {arg4 ""}
- {arg5 ""}
- {arg6 ""}
- {arg7 ""}
- {arg8 ""}
- {arg9 ""}
- {arg10 ""}
- {arg11 ""}
- {arg12 ""}
- {arg13 ""}
- {arg14 ""}
- {arg15 ""}
- {arg16 ""}
- {arg17 ""}
- {arg18 ""}
- {arg19 ""}
- {arg20 ""}
- {arg21 ""}
- {arg22 ""}
- {arg23 ""}
- {arg24 ""}
- } {
+ {value1 ""}
+ args
+} {
returns html of a select multiple box or list of checkboxes (where multiple values may be sent with form post).
- Required attributes: name, value.
- Set "type" to "select" for multi select box, or "checkbox" for checkboxes.
- The value of the "value" attribute is a list_of_lists, each list item contains attribute/value pairs for a radio or option/bar item.
- If "label" not provided for tags in the list_of_lists, the value of the "value" attribute is also used for label.
- Set "selected" attribute to 1 in the value list_of_lists to indicate item selected. Default is unselected (if selected attributed is not included, or its value not 1)..
- } {
+ Required attributes: name, value.
+ Set "type" to "select" for multi select box, or "checkbox" for checkboxes.
+ The value of the "value" attribute is a list_of_lists, each list item contains attribute/value pairs for a radio or option/bar item.
+ If "label" not provided for tags in the list_of_lists, the value of the "value" attribute is also used for label.
+ Set "selected" attribute to 1 in the value list_of_lists to indicate item selected. Default is unselected (if selected attributed is not included, or its value not 1)..
+} {
# use upvar to set form content, set/change defaults
# __qf_arr contains last attribute values of tag, indexed by {tag}_attribute, __form_last_id is in __qf_arr(form_id)
upvar 1 __form_ids_list __form_ids_list
@@ -1469,10 +1349,23 @@
upvar 1 __qf_arr __qf_arr
upvar 1 __form_ids_select_open_list __form_ids_select_open_list
+ # collect args
+ if { [llength $arg1] > 1 && $value1 eq "" } {
+ set arg_list $arg1
+ foreach arg $args {
+ lappend args_list $arg
+ }
+ } elseif { $arg1 ne "" } {
+ lappend args $arg1 $value1
+ set arg_list $args
+ } else {
+ set arg_list [list ]
+ }
+
set attributes_select_list [list value accesskey align class cols name readonly rows style tabindex title wrap]
set attributes_full_list $attributes_select_list
lappend attributes_full_list type form_id id
- set arg_list [list $arg1 $arg2 $arg3 $arg4 $arg5 $arg6 $arg7 $arg8 $arg9 $arg10 $arg11 $arg12 $arg13 $arg14 $arg15 $arg16 $arg17 $arg18 $arg19 $arg20 $arg21 $arg22 $arg23 $arg24]
+
set attributes_list [list]
set select_list [list]
foreach {attribute value} $arg_list {
@@ -1484,8 +1377,6 @@
# create a list to pass to qf_select without it balking at unknown parameters
lappend select_list $attribute $value
}
- } elseif { $value eq "" } {
- # do nothing
} else {
ns_log Error "qf_choices: [string range $attribute 0 15] is not a valid attribute. invoke with attribute value pairs. Separate each with a space."
ad_script_abort