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.
+
+ <p>
+ 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.
+
<p>
+ 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.
+
+ <p>
+
+ 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.
+
+ <p>
+
Here's an example of a simple page implementing an add/edit form:
<blockquote><pre>
@@ -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
-
</pre></blockquote>
<p>
@@ -85,7 +103,7 @@
<p>
- 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.
<p>
@@ -105,11 +123,25 @@
<p>
+ <b>General information about parameters</b>
+
+ <p>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.
+ <p>
+
Here's a complete list of switches that are supported by ad_form:
<p>
<dl>
+ <p><dt><b>-extend</b></dt><p>
+ <dd>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.
+ <p>This must be the first switch passed into ad_form
+ </dd>
+
<p><dt><b>-name</b></dt><p>
<dd>Declares the name of the form. Defaults to the name of the script being served.</dd>
@@ -123,10 +155,11 @@
define multipart file handling forms.
</dd>
- <p><dt><b>-extend</b></dt><p>
- <dd>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.
+ <p><dt><b>-export</b></dt><p>
+ <dd>Similar to the utility <b>export_vars</b>. 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.
</dd>
<p><dt><b>-form</b></dt><p>
@@ -261,9 +294,9 @@
</blockquote>
<blockquote><pre>
- {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}}}
</pre><p>
@@ -273,7 +306,7 @@
</blockquote>
<blockquote><pre>
- {hide_me:text(hidden) {{value 3}}}
+ {hide_me:text(hidden) {value 3}}
</pre><p>
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 " <img src=\"/graphics/small-triangle.gif\" alt=\">\"> "}
+ context
+} {
+ Generate the an html fragement for a context bar.
+ This is the function that takes a list in the format
+ <pre>
+ [list [list url1 text1] [list url2 text2] ... "terminal text"]
+ <pre>
+ 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 "<a href=\"[lindex $element 0]\">[lindex $element 1]</a>$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 "<a href=\"[lindex $element 0]\">[lindex $element 1]</a>"
+ 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 "<a href=\"[lindex $arg 0]\">[lindex $arg 1]</a>"
- }
- }
- 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 "<a href=\"/\">[ad_system_name]</a>"]
+ 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 "<a href=\"[ad_conn scope url]/\">[ad_conn scope name]</a>"
-# }
-# }
-
- set index 0
- foreach arg $args {
- incr index
- if { $index == [llength $args] } {
- lappend choices $arg
- } else {
- lappend choices "<a href=\"[lindex $arg 0]\">[lindex $arg 1]</a>"
- }
- }
- 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]" "<a href=\"/acs-admin/\">ACS System Wide Administration</a>"]
- set index 0
- foreach arg $args {
- incr index
- if { $index == [llength $args] } {
- lappend choices $arg
- } else {
- lappend choices "<a href=\"[lindex $arg 0]\">[lindex $arg 1]</a>"
- }
+ 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 "<a href=\"[lindex $arg 0]\">[lindex $arg 1]</a>"
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 "
<TABLE border=0 cellpadding=0 cellspacing=0 height=24 width=\"100%\">
<TR bgcolor=\"#000066\"><TD align=left valign=bottom><A href=#top onMouseOver=\"hiLite('back_to_top')\" onMouseOut=\"unhiLite('back_to_top')\"><img name=\"back_to_top\" src=\"/graphics/24_back_to_top.gif\" border=0 width=200 height=24 alt=\"top\"></A></TD>
- <TD align=right valign=bottom><A href=\"[ad_parameter GlobalURLStub "" "/global"]/rules.tcl\" onMouseOver=\"hiLite('rules')\" onMouseOut=\"unhiLite('rules')\"><img name=\"rules\" src=\"/graphics/rules.gif\" border=0 width=96 height=24 valign=bottom alt=\"rules\"></A><A href=\"[ad_help_link $section]\" onMouseOver=\"hiLite('help')\" onMouseOut=\"unhiLite('help')\"><img name=\"help\" src=\"/graphics/help.gif\" border=0 width=30 height=24 align=bottom alt=\"help\"></A></TD></TR>
+ <TD align=right valign=bottom><A href=\"[ad_parameter GlobalURLStub "" "/global"]/rules\" onMouseOver=\"hiLite('rules')\" onMouseOut=\"unhiLite('rules')\"><img name=\"rules\" src=\"/graphics/rules.gif\" border=0 width=96 height=24 valign=bottom alt=\"rules\"></A><A href=\"[ad_help_link $section]\" onMouseOver=\"hiLite('help')\" onMouseOut=\"unhiLite('help')\"><img name=\"help\" src=\"/graphics/help.gif\" border=0 width=30 height=24 align=bottom alt=\"help\"></A></TD></TR>
</TABLE>"
return $return_string
}