Index: openacs-4/packages/acs-tcl/tcl/form-processing-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/form-processing-procs.tcl,v
diff -u -r1.44 -r1.45
--- openacs-4/packages/acs-tcl/tcl/form-processing-procs.tcl 29 Jan 2004 10:12:44 -0000 1.44
+++ openacs-4/packages/acs-tcl/tcl/form-processing-procs.tcl 10 Feb 2004 17:41:22 -0000 1.45
@@ -321,6 +321,12 @@
+
+
-on_validation_error
+
A code block that is executed if validation fails. This can be done to set
+ a custom page title or some similar action.
+
+
Two hidden values of interest are available to the caller of ad_form when processing a submit:
@@ -491,9 +497,11 @@
return -code error "No arguments to ad_form"
}
- set valid_args { form method action mode html name select_query select_query_name new_data on_refresh
- edit_data validate on_submit after_submit confirm_template on_request new_request edit_request
- export cancel_url cancel_label has_submit has_edit actions edit_buttons display_buttons show_required_p };
+ set valid_args { form method action mode html name select_query select_query_name new_data
+ on_refresh edit_data validate on_submit after_submit confirm_template
+ on_request new_request edit_request export cancel_url cancel_label
+ has_submit has_edit actions edit_buttons display_buttons show_required_p
+ on_validation_error };
ad_arg_parser $valid_args $args
@@ -531,7 +539,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 export mode cancel_url has_edit has_submit actions edit_buttons display_buttons } $valid_arg ] == -1 } {
+ if { [lsearch { name form method action html validate export mode cancel_url has_edit has_submit actions edit_buttons display_buttons on_validation_error} $valid_arg ] == -1 } {
set af_parts(${form_name}__extend) ""
}
}
@@ -1004,122 +1012,123 @@
}
}
- if { [template::form is_submission $form_name] &&
- [uplevel #$level {set __refreshing_p}] } {
+ if { [template::form is_submission $form_name] } {
+ if { [uplevel #$level {set __refreshing_p}] } {
- uplevel array unset ${form_name}:error
+ uplevel array unset ${form_name}:error
- if { [info exists on_refresh] } {
- ad_page_contract_eval uplevel #$level $on_refresh
+ if { [info exists on_refresh] } {
+ ad_page_contract_eval uplevel #$level $on_refresh
+ }
}
- }
- if { [template::form is_valid $form_name] && ![uplevel #$level {set __refreshing_p}] } {
+ if { [template::form is_valid $form_name] } {
- # Run confirm and preview templates before we do final processing of the form
+ # Run confirm and preview templates before we do final processing of the form
- if { [info exists confirm_template] && ![uplevel #$level {set __confirmed_p}] } {
+ if { [info exists confirm_template] && ![uplevel #$level {set __confirmed_p}] } {
- # Pass the form variables to the confirm template, applying the to_html filter if present
+ # Pass the form variables to the confirm template, applying the to_html filter if present
- set args [list]
- foreach element_name $af_element_names($form_name) {
- if { [llength $element_name] == 1 } {
- if { [info exists af_to_html(${form_name}__$element_name)] } {
- uplevel #$level [list set $element_name \
- [uplevel #$level [list template::util::$af_type(${form_name}__$element_name)::get_property \
- $af_to_html(${form_name}__$element_name) \
- [uplevel #$level [list set $element_name]]]]]
+ set args [list]
+ foreach element_name $af_element_names($form_name) {
+ if { [llength $element_name] == 1 } {
+ if { [info exists af_to_html(${form_name}__$element_name)] } {
+ uplevel #$level [list set $element_name \
+ [uplevel #$level [list template::util::$af_type(${form_name}__$element_name)::get_property \
+ $af_to_html(${form_name}__$element_name) \
+ [uplevel #$level [list set $element_name]]]]]
+ }
+ lappend args [list $element_name [uplevel #$level [list set $element_name]]]
}
- lappend args [list $element_name [uplevel #$level [list set $element_name]]]
}
- }
- # This is serious abuse of ad_return_exception_template, but hell, I wrote it so I'm entitled ...
- ad_return_exception_template -status 200 -params $args $confirm_template
+ # This is serious abuse of ad_return_exception_template, but hell, I wrote it so I'm entitled ...
+ ad_return_exception_template -status 200 -params $args $confirm_template
- }
+ }
- # We have three possible ways to handle the form
+ # We have three possible ways to handle the form
- # 1. an on_submit block (useful for forms that don't touch the database or can share smart Tcl API
- # for both add and edit forms)
- # 2. an new_data block (when __new_p is true)
- # 3. an edit_data block (when __new_p is false)
- # 4. an after_submit block (for ad_returnredirect and the like that is the same for new and edit)
+ # 1. an on_submit block (useful for forms that don't touch the database or can share smart Tcl API
+ # for both add and edit forms)
+ # 2. an new_data block (when __new_p is true)
+ # 3. an edit_data block (when __new_p is false)
+ # 4. an after_submit block (for ad_returnredirect and the like that is the same for new and edit)
- # We don't need to interrogate the af_parts structure because we know we're in the last call to
- # to ad_form at this point and that this call contained the "action blocks".
+ # We don't need to interrogate the af_parts structure because we know we're in the last call to
+ # to ad_form at this point and that this call contained the "action blocks".
- # Execute our to_sql filters, if any, before passing control to the caller's
- # on_submit, new_data, edit_data or after_submit blocks
+ # Execute our to_sql filters, if any, before passing control to the caller's
+ # on_submit, new_data, edit_data or after_submit blocks
- foreach element_name $af_element_names($form_name) {
- if { [llength $element_name] == 1 } {
- if { [info exists af_to_sql(${form_name}__$element_name)] } {
- uplevel #$level [list set $element_name \
- [uplevel #$level [list template::util::$af_type(${form_name}__$element_name)::get_property \
- $af_to_sql(${form_name}__$element_name) \
- [uplevel #$level [list set $element_name]]]]]
+ foreach element_name $af_element_names($form_name) {
+ if { [llength $element_name] == 1 } {
+ if { [info exists af_to_sql(${form_name}__$element_name)] } {
+ uplevel #$level [list set $element_name \
+ [uplevel #$level [list template::util::$af_type(${form_name}__$element_name)::get_property \
+ $af_to_sql(${form_name}__$element_name) \
+ [uplevel #$level [list set $element_name]]]]]
+ }
}
}
- }
+ # Lars: We're wrapping this in a catch to allow people to throw a "break" inside
+ # the code block, causing submission to be canceled
+ # In order to make this work, I had to eliminate the ad_page_contract_eval's below
+ # and replace them with simple uplevel's. Otherwise, we'd get an error saying
+ # 'break used outside of a loop'.
+ set errno [catch {
+ if { [info exists on_submit] } {
+ uplevel #$level $on_submit
+ }
+ upvar #$level __new_p __new_p
- # Lars: We're wrapping this in a catch to allow people to throw a "break" inside
- # the code block, causing submission to be canceled
- # In order to make this work, I had to eliminate the ad_page_contract_eval's below
- # and replace them with simple uplevel's. Otherwise, we'd get an error saying
- # 'break used outside of a loop'.
- set errno [catch {
- if { [info exists on_submit] } {
- uplevel #$level $on_submit
- }
+ if { [info exists new_data] && $__new_p } {
+ uplevel #$level $new_data
+ template::element::set_value $form_name __new_p 0
+ } elseif { [info exists edit_data] && !$__new_p } {
+ uplevel #$level $edit_data
+ }
- upvar #$level __new_p __new_p
+ if { [info exists after_submit] } {
+ uplevel #$level $after_submit
+ }
+ } error]
- if { [info exists new_data] && $__new_p } {
- uplevel #$level $new_data
- template::element::set_value $form_name __new_p 0
- } elseif { [info exists edit_data] && !$__new_p } {
- uplevel #$level $edit_data
+ # Handle or propagate the error. Can't use the usual
+ # "return -code $errno..." trick due to the db_with_handle
+ # wrapped around this loop, so propagate it explicitly.
+ switch $errno {
+ 0 {
+ # TCL_OK
+ }
+ 1 {
+ # TCL_ERROR
+ global errorInfo errorCode
+ error $error $errorInfo $errorCode
+ }
+ 2 {
+ # TCL_RETURN
+ error "Cannot return from inside an ad_form block"
+ }
+ 3 {
+ # TCL_BREAK
+ # nothing -- this is what we want to support
+ }
+ 4 {
+ # TCL_CONTINUE
+ continue
+ }
+ default {
+ error "Unknown return code: $errno"
+ }
}
-
- if { [info exists after_submit] } {
- uplevel #$level $after_submit
- }
- } error]
-
- # Handle or propagate the error. Can't use the usual
- # "return -code $errno..." trick due to the db_with_handle
- # wrapped around this loop, so propagate it explicitly.
- switch $errno {
- 0 {
- # TCL_OK
- }
- 1 {
- # TCL_ERROR
- global errorInfo errorCode
- error $error $errorInfo $errorCode
- }
- 2 {
- # TCL_RETURN
- error "Cannot return from inside an ad_form block"
- }
- 3 {
- # TCL_BREAK
- # nothing -- this is what we want to support
- }
- 4 {
- # TCL_CONTINUE
- continue
- }
- default {
- error "Unknown return code: $errno"
- }
- }
+ } elseif { [info exists on_validation_error] } {
+ uplevel #$level $on_validation_error
+ }
}
template::element::set_value $form_name __refreshing_p 0