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:

+

-extend

+

Extend an existing form. This allows one to build forms incrementally. Forms are built at the + template level. As a consequence one can write utility procs that use -extend to build form + snippets common to several data entry forms. +

This must be the first switch passed into ad_form +

+

-name

Declares the name of the form. Defaults to the name of the script being served.
@@ -123,10 +155,11 @@ define multipart file handling forms. -

-extend

-

Extend an existing form. This allows one to build forms incrementally. Forms are built at the - template level. As a consequence one can write utility procs that use -extend to build form - snippets common to several data entry forms. +

-export

+

Similar to the utility export_vars. Takes a list of values to insert in the form as + "hidden" elements. Each value is either a name, in which case the Tcl variable at the caller's + level is passed to the form if it exists, or a name-value pair. "multiple", "array", "sign" and + similar flags are not allowed though it would be good to do so in the future.

-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 "
     
-         
+         
\"top\"\"rules\"\"help\"
\"rules\"\"help\"
" return $return_string }