Index: openacs.org-dev/packages/acs-tcl/tcl/form-processing-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs.org-dev/packages/acs-tcl/tcl/form-processing-procs.tcl,v diff -u -r1.1 -r1.2 --- openacs.org-dev/packages/acs-tcl/tcl/form-processing-procs.tcl 9 Jul 2002 17:34:59 -0000 1.1 +++ openacs.org-dev/packages/acs-tcl/tcl/form-processing-procs.tcl 12 Dec 2002 12:31:41 -0000 1.2 @@ -27,9 +27,29 @@ In general the full functionality of the form builder is exposed by ad_form, but with a much more user-friendly and readable syntax and with state management handled automatically. + +
+ In order to make it possible to use ad_form to build common form snippets within procs, code + blocks are executed at the current template parse level. This is necessary if validate and + similar blocks are to have access to the form's contents but may cause surprises for the + unwary. So be wary. +
+ On the other hand when subst is called, for instance when setting values in the form, the + caller's level is used. Why do this? A proc building a common form snippet may need to + build a list of valid select elements or similarly compute values that need to be set in + the form, and these should be computed locally. + +
+ + Yes, this is a bit bizarre and not necessarily well thought out. The semantics were decided + upon when I was writing a fairly complex package for Greenpeace, International and worked well + there so for now, I'm leaving them the way they are. + +
+ Here's an example of a simple page implementing an add/edit form:
@@ -42,12 +62,12 @@ my_table_key:optional } - ad_form -name form_name -form { + ad_form -name form_name -export {foo {bar none}} -form { my_table_key:key(my_table_sequence) - {value:text(textarea) {{label "Enter text"} - {html {rows 4 cols 50}}}} + {value:text(textarea) {label "Enter text"} + {html {rows 4 cols 50}}} } -select_query { select value from my_table where my_table_key = :my_table_key } -validate { @@ -62,18 +82,16 @@ values (:key, :value)" ad_returnredirect "somewhere" - return + ad_script_abort } -edit_data { db_dml do_update " update my_table set value = :value where my_table_key = :key" ad_returnredirect "somewhere" - return + ad_script_abort } - gp_return_template -
@@ -85,7 +103,7 @@
- The call to gp_return_template then renders the page - it is your responsibility to render the form + The call to ad_return_template then renders the page - it is your responsibility to render the form in your template by use of the ATS formtemplate tag.
@@ -105,11 +123,25 @@
+ General information about parameters + +
Parameters which take a name (for instance "-name" or "-select_query_name") expect a simple name + not surrounded by curly braces (in other words not a single-element list). All other parameters expect + a single list to be passed in. +
+ Here's a complete list of switches that are supported by ad_form:
+
This must be the first switch passed into ad_form +
-
+
@@ -261,9 +294,9 @@
- {my_key:text(multiselect),multiple {{label "select some values"} + {my_key:text(multiselect),multiple {label "select some values"} {options {first second third fourth fifth}} - {html {size 4}}}} + {html {size 4}}}@@ -273,7 +306,7 @@
- {hide_me:text(hidden) {{value 3}}} + {hide_me:text(hidden) {value 3}}Define the hidden form element "hide_me" with the value 3 @@ -312,7 +345,7 @@ } set valid_args { form method action html name select_query select_query_name new_data on_refresh - edit_data validate on_submit confirm_template new_request edit_request }; + edit_data validate on_submit confirm_template new_request edit_request export}; ad_arg_parser $valid_args $args @@ -340,7 +373,7 @@ foreach valid_arg $valid_args { if { [info exists $valid_arg] } { if { [info exists af_parts(${form_name}__$valid_arg)] && - ![lsearch { form name validate } $valid_arg] == -1 } { + ![lsearch { form name validate export } $valid_arg] == -1 } { return -code error "Form \"$form_name\" already has a \"$valid_arg\" section" } @@ -350,7 +383,7 @@ # and validation block to be extended, for now at least until I get more experience # with this ... - if { [lsearch { name form method action html validate } $valid_arg ] == -1 } { + if { [lsearch { name form method action html validate export } $valid_arg ] == -1 } { set af_parts(${form_name}__extend) "" } } @@ -360,10 +393,9 @@ return -code error "No \"form\" block has been specified for form \"$form_name\"" } - # If we're not extending + # If we're not extending - this needs integration with the ATS form builder ... if { !$extend_p } { - global gp_conn - incr gp_conn(form_count) + # incr ad_conn(form_count) } #################### @@ -480,6 +512,17 @@ } + if { [info exists export] } { + foreach value $export { + set name [lindex $value 0] + if { [llength $value] == 1 } { + template::element create $form_name $name -datatype text -widget hidden -value [uplevel [list set $name]] + } else { + template::element create $form_name $name -datatype text -widget hidden -value [uplevel [list subst [lindex $value 1]]] + } + } + } + # We need to track these for submission time and for error checking global af_type @@ -572,7 +615,9 @@ help_text - label - format - - value { + value - + before_html - + after_html { if { [llength $extra_arg] > 2 || [llength $extra_arg] == 1 } { return -code error "element $element_name: \"$extra_arg\" requires exactly one argument" } @@ -739,7 +784,7 @@ foreach {element_name validate_expr error_message} $validate_element { if { ![template::element error_p $form_name $element_name] && \ ![uplevel #$level [list expr $validate_expr]] } { - template::element set_error $form_name $element_name $error_message + template::element set_error $form_name $element_name [uplevel [list subst $error_message]] } } } @@ -829,7 +874,7 @@ ad_form. @param element The name of the element - @parma value The value to set + @param value The value to set } { upvar #[template::adp_level] __ad_form_values__ values @@ -854,9 +899,9 @@ foreach arg $args { if { [llength $arg] == 1 } { upvar $arg value - gp_set_element_value -element $arg $value + ad_set_element_value -element $arg $value } else { - gp_set_element_value -element [lindex $arg 0] [lindex $arg 1] + ad_set_element_value -element [lindex $arg 0] [lindex $arg 1] } } } Index: openacs.org-dev/packages/acs-tcl/tcl/navigation-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs.org-dev/packages/acs-tcl/tcl/navigation-procs.tcl,v diff -u -r1.1 -r1.2 --- openacs.org-dev/packages/acs-tcl/tcl/navigation-procs.tcl 9 Jul 2002 17:34:59 -0000 1.1 +++ openacs.org-dev/packages/acs-tcl/tcl/navigation-procs.tcl 12 Dec 2002 12:31:41 -0000 1.2 @@ -1,161 +1,176 @@ ad_library { - Provides procedures to spit out the navigational parts of the site. @cvs-id $Id$ @author philg@mit.edu @creation-date 11/5/98 (adapted originally from the Cognet server) - edited February 28, 1999 by philg to include support for a - Yahoo-style navigation system (showing users where they are in a - hierarchy) - } +# edited February 28, 1999 by philg to include support for a +# Yahoo-style navigation system (showing users where they are in a +# hierarchy) -ad_proc ad_context_bar { args } { +ad_proc -public ad_context_bar_html { + {-separator " "} + context +} { + Generate the an html fragement for a context bar. + This is the function that takes a list in the format +
+ [list [list url1 text1] [list url2 text2] ... "terminal text"] ++ and generates the html fragment. In general the higher level + calls like ad_context_bar and ad_admin_context_bar should be + used, and then only in the sitewide master rather than on + individual pages. + @param separator the text placed between each link + @param context list as with ad_context_bar + + @return html fragment + + @see ad_context_bar + @see ad_admin_context_bar +} { + set out {} + foreach element [lrange $context 0 [expr [llength $context] - 2]] { + append out "[lindex $element 1]$separator" + } + append out [lindex $context end] + + return $out +} + +ad_proc -public ad_context_bar { + -node_id + args +} { Returns a Yahoo-style hierarchical navbar. Includes "Your Workspace" or "Administration" if applicable, and the subsite if not global. + @param node_id If provided work up from this node, otherwise the current node + + @return an html fragment generated by ad_context_bar_html + + @see ad_context_bar_html + @see ad_admin_context_bar } { + if { ![info exists node_id] } { + set node_id [ad_conn node_id] + } + if {![parameter::get -package_id [site_node_closest_ancestor_package "acs-subsite"] -parameter ShowContextBarP -default 1]} { + return "" + } - set context [list] + set context [list] - if {[ad_conn user_id] != 0 && ![string match /pvt/home* [ad_conn url]]} { - lappend context [list "[ad_pvt_home]" "[ad_pvt_home_name]"] - } + if {[ad_conn user_id] != 0 && ![string match /pvt/home* [ad_conn url]]} { + lappend context [list "[ad_pvt_home]" "[ad_pvt_home_name]"] + } - set node_id [ad_conn node_id] - db_foreach context { - select site_node.url(node_id) as url, object_id, - acs_object.name(object_id) as object_name, - level - from site_nodes - start with node_id = :node_id - connect by prior parent_id = node_id - order by level asc - } { - lappend context [list $url $object_name] - } - if { [string match admin/* [ad_conn extra_url]] } { - lappend context [list "[ad_conn package_url]admin/" \ - "Administration"] - } + db_foreach context {} { + lappend context [list $url $object_name] + } + if { [string match admin/* [ad_conn extra_url]] } { + lappend context [list "[ad_conn package_url]admin/" \ + "Administration"] + } - set context [concat $context $args] - - set out [list] - - for { set i 0 } { $i < [llength $context] } { incr i } { - set element [lindex $context $i] - if { $i == [llength $context] - 1 } { - if {[llength $args] == 0} { - lappend out [lindex $element 1] - } else { - lappend out $element - } - } else { - lappend out "[lindex $element 1]" + if {[llength $args] == 0} { + # fix last element to just be literal string + set context [lreplace $context end end [lindex [lindex $context end] 1]] } - } - return [join $out " : "] + return [ad_context_bar_html [concat $context $args]] } + + # a context bar, rooted at the workspace -proc_doc ad_context_bar_ws args { +ad_proc -deprecated -public ad_context_bar_ws args { Returns a Yahoo-style hierarchical navbar, starting with a link to workspace. -} { - set choices [list "[ad_pvt_home_link]"] + @param list of url desc ([list [list url desc] [list url desc] ... "terminal"]) + @return an html fragment generated by ad_context_bar_html - set index 0 - foreach arg $args { - incr index - if { $index == [llength $args] } { - lappend choices $arg - } else { - lappend choices "[lindex $arg 1]" - } - } - return [join $choices " : "] + @see ad_context_bar +} { + return [ad_context_bar_html [concat [list [list "[ad_pvt_home]" "[ad_pvt_home_name]"]] $args]] } # a context bar, rooted at the workspace or index, depending on whether # user is logged in -proc_doc ad_context_bar_ws_or_index args { +ad_proc -deprecated -public ad_context_bar_ws_or_index args { Returns a Yahoo-style hierarchical navbar, starting with a link to either the workspace or /, depending on whether or not the user is - logged in. + logged in. You should probably be using ad_context_bar and + then only in the sitewide master. + + @param args list of url desc ([list [list url desc] [list url desc] ... "terminal"]) + @return an html fragment generated by ad_context_bar_html + + @see ad_context_bar } { - if { [ad_get_user_id] == 0 } { - set choices [list "[ad_system_name]"] + if { [ad_conn user_id] == 0 && ![string match /pvt/home* [ad_conn url]] } { + set choices [list [list "/" [ad_system_name]]] } else { - set choices [list "[ad_pvt_home_link]"] + set choices [list [list [ad_pvt_home] [ad_pvt_home_name]]] } -# lars, Apr25-00: Took out this old scoping thing -# -# if { [ad_conn scope on_which_table] != "." } { -# if { [llength $args] == 0 } { -# lappend choices [ad_conn scope name] -# } else { -# lappend choices "[ad_conn scope name]" -# } -# } - - set index 0 - foreach arg $args { - incr index - if { $index == [llength $args] } { - lappend choices $arg - } else { - lappend choices "[lindex $arg 1]" - } - } - return [join $choices " : "] + return [ad_context_bar_html [concat $choices $args]] } -proc_doc ad_admin_context_bar args { +ad_proc -public ad_admin_context_bar args { Returns a Yahoo-style hierarchical navbar, starting with links workspace and admin home. Suitable for use in pages underneath /admin. + + @param args list of url desc ([list [list url desc] [list url desc] ... "terminal"]) + @return an html fragment generated by ad_context_bar_html + + @see ad_context_bar } { - set choices [list "[ad_pvt_home_link]" "ACS System Wide Administration"] - set index 0 - foreach arg $args { - incr index - if { $index == [llength $args] } { - lappend choices $arg - } else { - lappend choices "[lindex $arg 1]" - } + if {[llength $args]} { + set choices [list [list [ad_pvt_home] [ad_pvt_home_name]] \ + [list /acs-admin/ "ACS System Wide Administration"]] + } else { + set choices [list [list [ad_pvt_home] [ad_pvt_home_name]] \ + "ACS System Wide Administration"] } - return [join $choices " : "] + + return [ad_context_bar_html [concat $choices $args]] } -proc_doc ad_navbar args { +ad_proc -public ad_navbar args { produces navigation bar. notice that navigation bar is different than context bar, which exploits a tree structure. navbar will just display a list of nicely formatted links. + + @param args list of url desc ([list [list url desc] [list url desc]]) + + @return html fragment + + @see ad_choice_bar } { set counter 0 foreach arg $args { lappend link_list "[lindex $arg 1]" incr counter } - if { $counter > 0 } { + if { $counter } { return "\[[join $link_list " | "]\]" } else { return "" } } -proc_doc ad_choice_bar { items links values {default ""} } { +ad_proc -public ad_choice_bar { items links values {default ""} } { Displays a list of choices (Yahoo style), with the currently selected one highlighted. + + @see ad_navbar } { set count 0 @@ -523,7 +538,7 @@ append return_string "" return $return_string }
+ -