Index: openacs-4/packages/spreadsheet/tcl/form-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/spreadsheet/tcl/form-procs.tcl,v diff -u -r1.17 -r1.18 --- openacs-4/packages/spreadsheet/tcl/form-procs.tcl 26 Mar 2011 00:50:20 -0000 1.17 +++ openacs-4/packages/spreadsheet/tcl/form-procs.tcl 26 Mar 2011 21:14:45 -0000 1.18 @@ -12,11 +12,11 @@ # __form_ids_list = list that contains existing form ids # __form_ids_open_list = list that contains ids of forms that are not closed # __form_ids_fieldset_open_list = list that contains form ids where a fieldset tag is open -# __form_arr contains an array of forms. Each form built as a string by appending tags, indexed by form id, for example __form_arr($id) +# __form_arr contains an array of forms. Each form built as a string by appending tags, indexed by form_id, for example __form_arr($id) # __qf_arr contains last attribute values of a tag (for all forms), indexed by {tag}_attribute, __form_last_id is in __qf_arr(form_id) # a blank id passed in anything other than qf_form assumes the current (most recent used form_id) -# to fix: id for nonform tag should not be same as form id. use an attribute "form_id" for assigning tags to specific forms. +# to fix: id for nonform tag should not be same as form_id. use an attribute "form_id" for assigning tags to specific forms. #use following to limit access to page requests via post.. to reduce vulnerability to url hack and insertion attacks from web: #if { [ad_conn method] != POST } { @@ -97,6 +97,8 @@ {arg14 ""} {arg15 ""} {arg16 ""} + {arg17 ""} + {arg18 ""} } { initiates a form with form tag and supplied attributes. Returns an id. A clumsy url based id is provided if not passed (not recommended). } { @@ -119,14 +121,18 @@ unset arg1_list } - set attributes_full_list [list action class id method name style target title] - set arg_list [list $arg1 $arg2 $arg3 $arg4 $arg5 $arg6 $arg7 $arg8 $arg9 $arg10 $arg11 $arg12 $arg13 $arg14 $arg15 $arg16] + set attributes_tag_list [list action class id method name style target title] + set attributes_full_list $attributes_tag_list + lappend attributes_tag_list form_id + set arg_list [list $arg1 $arg2 $arg3 $arg4 $arg5 $arg6 $arg7 $arg8 $arg9 $arg10 $arg11 $arg12 $arg13 $arg14 $arg15 $arg16 $arg17 $arg18] 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 + if { [lsearch -exact $attributes_tag_list $attribute] > -1 } { + lappend attributes_list $attribute + } } elseif { $value eq "" } { # ignore } else { @@ -138,11 +144,9 @@ } if { ![info exists __qf_remember_attributes] } { -ns_log Notice "qf_form L134: set __qf_remember_attributes 0" set __qf_remember_attributes 0 } if { ![info exists __form_ids_list] } { -ns_log Notice "qf_form L138: set __form_ids_list.." set __form_ids_list [list] } if { ![info exists __form_ids_open_list] } { @@ -153,13 +157,22 @@ foreach attribute $attributes_list { if { $attribute ne "id" && ![info exists attributes_arr($attribute)] && [info exists __qf_arr(form_$attribute)] } { set attributes_arr($attribute) $__qf_arr(form_$attribute) - } + } } } - # every form gets an id, if only to help identify it in debugging - if { ![info exists attributes_arr(id) ] || $attributes_arr(id) eq "" } { - set attributes_arr(id) "[ad_conn url]-[llength $__form_ids_list]" -ns_log Notice "qf_form: generating form_id $attributes_arr(id)" + # every form gets a form_id + set form_id_exists [info exists attributes_arr(form_id) ] + if { $form_id_exists == 0 || ( $form_id_exists == 1 && $attributes_arr(form_id) eq "" ) } { + set id_exists [info exists attributes_arr(id) ] + if { $id_exists == 0 || ( $id_exists == 1 && $attributes_arr(id) eq "" ) } { + regsub {/} [ad_conn url] {-} form_key + append form_key "-[llength $__form_ids_list]" + } else { + # since a FORM id has to be unique, lets use it + set form_key $attributes_arr(id) + } + set attributes_arr(form_id) $form_key + ns_log Notice "qf_form: generating form_id $attributes_arr(form_id)" } # prepare attributes to process @@ -174,16 +187,16 @@ set tag_html "
\n" - # remove id from __form_ids_open_list + append __form_arr($form_id) "\n" + # remove form_id from __form_ids_open_list set __form_ids_open_list [lreplace $__form_ids_open_list $form_id_position $form_id_position] - } - } - } ad_proc -public qf_read { {arg1 ""} {arg2 ""} } { - returns the content of forms. If a form is not closed, returns the form in its partial state of completeness. If an id or form_id is supplied, returns the content of a specific form. Defaults to return all forms in a list. + returns the content of forms. If a form is not closed, returns the form in its partial state of completeness. If a form_id is supplied, returns the content of a specific form. Defaults to return all forms in a list. } { # use upvar to set form content, set/change defaults upvar 1 __form_ids_list __form_ids_list upvar 1 __form_arr __form_arr - set attributes_full_list [list id] + set attributes_full_list [list form_id] set arg_list [list $arg1 $arg2] set attributes_list [list] foreach {attribute value} $arg_list { @@ -715,36 +766,37 @@ set attributes_arr(id) $attributes_arr(form_id) unset attributes_arr(form_id) } - # defaults to all ids - if { ![info exists attributes_arr(id)] || $attributes_arr(id) eq "" } { + # defaults to all form ids + set form_id_exists [info exists attributes_arr(id)] + if { $form_id_exists == 0 || ( $form_id_exists == 1 && $attributes_arr(form_id) eq "" ) } { # note, attributes_arr(id) might become a list or a scalar.. if { [llength $__form_ids_list ] == 1 } { set specified_1 1 - set attributes_arr(id) [lindex $__forms_id_list 0] + set attributes_arr(form_id) [lindex $__form_ids_list 0] } else { set specified_1 0 - set attributes_arr(id) $__form_ids_list + set attributes_arr(form_id) $__form_ids_list } } else { set specified_1 1 } if { $specified_1 } { # a form specified in argument - if { ![info exists __form_arr($attriubtes_arr(id)) ] } { - ns_log Warning "qf_read: unknown form id $attributes_arr(id)" + if { ![info exists __form_arr($attributes_arr(form_id)) ] } { + ns_log Warning "qf_read: unknown form_id $attributes_arr(form_id)" } else { - set form_s $__form_arr($attributes_arr(id)) + set form_s $__form_arr($attributes_arr(form_id)) } } else { set forms_list [list] - foreach id $attributes_arr(id) { - # check if id is valid - set form_id_position [lsearch $__form_ids_list $attributes_arr(id)] + foreach form_id $attributes_arr(form_id) { + # check if form_id is valid + set form_id_position [lsearch $__form_ids_list $form_id] if { $form_id_position == -1 } { - ns_log Warning "qf_read: unknown form id $attributes_arr(id)" + ns_log Warning "qf_read: unknown form_id $form_id" } else { - lappend forms_list $__form_arr($id) + lappend forms_list $__form_arr($form_id) } } set form_s $forms_list @@ -800,14 +852,18 @@ upvar 1 __qf_arr __qf_arr upvar 1 __form_ids_fieldset_open_list __form_ids_fieldset_open_list - set attributes_full_list [list type accesskey align alt border checked class id maxlength name readonly size src tabindex value form_id label] + 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 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 { set attribute_index [lsearch -exact $attributes_full_list $attribute] if { $attribute_index > -1 } { set attributes_arr($attribute) $value - lappend attributes_list $attribute + if { [lsearch -exact $attributes_tag_list $attribute] } { + lappend attributes_list $attribute + } } elseif { $value eq "" } { # do nothing } else { @@ -823,12 +879,12 @@ ns_log Error "qf_input:(L805) invoked before qf_form or used in a different namespace than qf_form.." ad_script_abort } - # default to last modified form id + # default to last modified form_id if { ![info exists attributes_arr(form_id)] || $attributes_arr(form_id) eq "" } { - set form_id $__qf_arr(form_id) + set attributes_arr(form_id) $__qf_arr(form_id) } if { [lsearch $__form_ids_list $attributes_arr(form_id)] == -1 } { - ns_log Error "qf_input: unknown form id $attributes_arr(id)" + ns_log Error "qf_input: unknown form_id $attributes_arr(form_id)" ad_script_abort } @@ -841,40 +897,45 @@ } } + # provide a blank value by default + if { ![info exists attributes_arr(value)] } { + set attributes_arr(value) "" + } + # prepare attributes to process set tag_attributes_list [list] foreach attribute $attributes_list { - if { $attribute ne "value" } { - set __qf_arr(input_$attribute) $attributes_arr($attribute) - lappend tag_attributes_list $attribute $attributes_arr($attribute) - } + set __qf_arr(input_$attribute) $attributes_arr($attribute) + lappend tag_attributes_list $attribute $attributes_arr($attribute) } # by default, wrap the input with a label tag for better UI if { [info exists attributes_arr(id) ] && [info exists attributes_arr(label)] && [info exists attributes_arr(type) ] && $attributes_arr(type) ne "hidden" } { if { $attributes_arr(type) eq "checkbox" || $attributes_arr(type) eq "radio" } { - set tag_html "" + set tag_html "" } else { - set tag_html "" + set tag_html "" } } else { - set tag_html "$value" + set tag_html "" } - # set results __form_arr, we checked form id above. + # set results __form_arr, we checked form_id above. append __form_arr($attributes_arr(form_id)) "${tag_html}\n" return } -ad_proc -public qf_insert_html { +ad_proc -public qf_append { {arg1 ""} {arg2 ""} {arg3 ""} {arg4 ""} {arg5 ""} {arg6 ""} } { + @param@ html + @param@ form_id inserts html in a form by appending supplied html. if form_id supplied, appends form with supplied form_id. } { # use upvar to set form content, set/change defaults @@ -904,16 +965,17 @@ ns_log Error "qf_insert_html: invoked before qf_form or used in a different namespace than qf_form.." ad_script_abort } - # default to last modified form id - if { ![info exists attributes_arr(form_id)] || $attributes_arr(form_id) eq "" } { - set form_id $__qf_arr(form_id) + # default to last modified form_id + set form_id_exists [info exists attributes_arr(form_id)] + if { $form_id_exists == 0 || ( $form_id_exists == 1 && $attributes_arr(form_id) eq "" ) } { + set attributes_arr(form_id) $__qf_arr(form_id) } if { [lsearch $__form_ids_list $attributes_arr(form_id)] == -1 } { - ns_log Error "qf_insert_html: unknown form id $attributes_arr(id)" + ns_log Error "qf_insert_html: unknown form_id $attributes_arr(form_id)" ad_script_abort } - # set results __form_arr, we checked form id above. + # set results __form_arr, we checked form_id above. append __form_arr($attributes_arr(form_id)) $attributes_arr(html) return } @@ -976,8 +1038,9 @@ 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 - - set attributes_full_list [list value accesskey align class cols id name readonly rows style tabindex title wrap type form_id] + 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] @@ -986,7 +1049,7 @@ if { $attribute_index > -1 } { set attributes_arr($attribute) $value lappend attributes_list $attribute - if { $attribute ne "type" && $attribute ne "form_id" && $attribute ne "id" } { + if { [lsearch -exact $attributes_select_list $attribute] > -1 } { # create a list to pass to qf_select without it balking at unknown parameters lappend select_list $attribute $value } @@ -1054,8 +1117,7 @@ } else { set args_html [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] } - - + return $args_html } ad_proc -public qf_choices { @@ -1102,7 +1164,9 @@ upvar 1 __qf_arr __qf_arr upvar 1 __form_ids_select_open_list __form_ids_select_open_list - set attributes_full_list [list value accesskey align class cols id name readonly rows style tabindex title wrap type form_id] + 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] @@ -1111,7 +1175,7 @@ if { $attribute_index > -1 } { set attributes_arr($attribute) $value lappend attributes_list $attribute - if { $attribute ne "type" && $attribute ne "form_id" && $attribute ne "id" } { + if { [lsearch -exact $attributes_select_list $attribute ] > -1 } { # create a list to pass to qf_select without it balking at unknown parameters lappend select_list $attribute $value } @@ -1178,5 +1242,5 @@ } else { set args_html [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] } - + return $args_html }