Fisheye: Tag 1.4 refers to a dead (removed) revision in file `openacs-4/packages/dynamic-types/tcl/form-init.tcl'.
Fisheye: No comparison available.  Pass `N' to diff?
Index: openacs-4/packages/dynamic-types/tcl/form-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/dynamic-types/tcl/form-procs.tcl,v
diff -u -r1.9 -r1.10
--- openacs-4/packages/dynamic-types/tcl/form-procs.tcl	7 Jul 2005 00:21:13 -0000	1.9
+++ openacs-4/packages/dynamic-types/tcl/form-procs.tcl	29 Aug 2005 11:20:18 -0000	1.10
@@ -1,4 +1,3 @@
-
 ad_library {
     A library of functions to generate forms for acs_objects from stored 
     metadata.
@@ -41,8 +40,6 @@
     {-overrides {}}
     {-cr_widget textarea}
     {-cr_widget_options {}}
-    {-exclude {}}
-    {-exclude_static:boolean}
     {-variables {}}
 } {
     Adds the elements of the specified object types dynamic form and all of its
@@ -122,9 +119,7 @@
             -overrides [array get override] \
             -cr_widget $cr_widget \
             -cr_widget_options $cr_widget_options \
-	    -exclude_static_p $exclude_static_p \
-	    -exclude $exclude \
-	    -variables $variables
+            -variables $variables
     }
 }
 
@@ -140,8 +135,6 @@
     {-cr_widget textarea}
     {-cr_storage file}
     {-cr_mime_filters {text/html dtype::mime_filters::text_html}}
-    {-exclude {}}
-    {-exclude_static:boolean}
 } {
     Process a dynamic type form submission created by a function such as
     dtype::form::add_elements.  
@@ -326,71 +319,56 @@
 
         dtype::form::metadata::widgets -object_type $type \
             -dform $type_dform \
-	    -exclude_static_p $exclude_static_p \
             -indexed_array widgets
 
         set size [template::multirow size attributes]
         for {set i 1} {$i <= $size} {incr i} {
             template::multirow get attributes $i
             
-	    # exclude specified widgets
-            if {[lsearch -exact $exclude $attributes(name)] > -1} {
-		continue
-	    }
-
             set crv_$attributes(name) "" 
 
-            ns_log notice "PROCESSING: $attributes(name)"
             if {[info exists widgets($attributes(attribute_id))]} {
-                ns_log notice "PROCESSING: found $attributes(name) in form"
                 # first check for the attribute in the submitted form
                 array set this_widget_info $widgets($attributes(attribute_id))
                 switch $this_widget_info(widget) {
                     file {}
-		    checkbox - multiselect {
+                    checkbox - multiselect {
                         set crv_$attributes(name) [template::element::get_values $form ${prefix}$attributes(name)]
                     }
                     default {
                         set crv_$attributes(name) [template::element::get_value $form ${prefix}$attributes(name)]
                     }
                 }
             } elseif {[info exists default($attributes(name))]} {
-                ns_log debug "PROCESSING: using supplied default for $attributes(name)"
                 if {[empty_string_p [set crv_$attributes(name)]]} {
                     # second check if the caller supplied a default value
                     set crv_$attributes(name) $default($attributes(name))
-		}
+                }
+            } elseif {$new_p && ![empty_string_p $attributes(default_value)]} {
+                # if we are inserting a new object then use the attributes 
+                # default value
+                set crv_$attributes(name) $attributes(default_value)
+            } elseif {!$new_p} {
+                # append the column to missing columns so that the value
+                # is copied from the previous revision when we are dealing
+                # with content types
+                if {[lsearch -exact {creation_date last_modified modifying_ip} $attributes(name)] == -1} {
+                    lappend missing_columns $attributes(column_name)
+                }
+            }
 
-	    } elseif {$new_p && ![empty_string_p $attributes(default_value)]} {
-		ns_log debug "PROCESSING: using attribute default for $attributes(name)"
+            if {![empty_string_p [set crv_$attributes(name)]] && [lsearch -exact $columns $attributes(name)] == -1} {
+                lappend columns $attributes(column_name)
 
-		# if we are inserting a new object then use the attributes 
-		# default value
-		set crv_$attributes(name) $attributes(default_value)
-
-	    } elseif {!$new_p} {
-		ns_log debug "PROCESSING: using existing value for $attributes(name) (ie. adding it to missing columns)"
-
-		# append the column to missing columns so that the value
-		# is copied from the previous revision when we are dealing
-		# with content types
-		if {[lsearch -exact {creation_date last_modified modifying_ip} $attributes(name)] == -1} {
-		    lappend missing_columns $attributes(column_name)
-		}
-	    }
-
-	    if {![empty_string_p [set crv_$attributes(name)]] && [lsearch -exact $columns $attributes(name)] == -1} {
-		lappend columns $attributes(column_name)
-
-		# cast the value to the appropriate datatype
-		switch $attributes(datatype) {
-		    date - time_of_day - timestamp {
-			lappend values [template::util::date::get_property sql_date [lindex [set crv_$attributes(name)] 0]]
-		    }
-		    default {
-			lappend values ":crv_$attributes(name)"
-		    }
-		}
+                # cast the value to the appropriate datatype
+                switch $attributes(datatype) {
+                    date - time_of_day - timestamp {
+                        lappend values [template::util::date::get_property sql_date [lindex [set crv_$attributes(name)] 0]]
+                    }
+                    default {
+                        lappend values ":crv_$attributes(name)"
+                    }
+                }
             }
         }
     }
@@ -401,77 +379,77 @@
 
     # title, description, object_title
     if {$content_type_p} {
-	set pos [lsearch -exact $columns package_id]
-	set columns [lreplace $columns $pos $pos object_package_id]
-	set columns [concat "item_id" "revision_id" $columns]
-	set values [concat ":item_id" ":object_id" $values]
+        set pos [lsearch -exact $columns package_id]
+        set columns [lreplace $columns $pos $pos object_package_id]
+        set columns [concat "item_id" "revision_id" $columns]
+        set values [concat ":item_id" ":object_id" $values]
 
-	db_transaction {
-	    if {$new_p} { 
-		db_dml insert_statement "
-                    insert into ${type_info(table_name)}i 
-                    ([join $columns ", "])
-                    values 
-                    ([join $values ", "])"
-	    } else { 
-		set latest_revision [content::item::get_latest_revision -item_id $item_id]
-		set object_id [db_nextval acs_object_id_seq]
+        db_transaction {
+            if {$new_p} { 
+                db_dml insert_statement "
+                            insert into ${type_info(table_name)}i 
+                            ([join $columns ", "])
+                            values 
+                            ([join $values ", "])"
+            } else { 
+                set latest_revision [content::item::get_latest_revision -item_id $item_id]
+                set object_id [db_nextval acs_object_id_seq]
 
-		db_dml insert_statement "
-                    insert into ${type_info(table_name)}i 
-                    ([join [concat $columns $missing_columns] ", "])
-                    select  
-                    [join [concat $values $missing_columns] ", "]
-                    from ${type_info(table_name)}i
-                    where revision_id = $latest_revision"
-	    }
+                db_dml insert_statement "
+                            insert into ${type_info(table_name)}i 
+                            ([join [concat $columns $missing_columns] ", "])
+                            select  
+                            [join [concat $values $missing_columns] ", "]
+                            from ${type_info(table_name)}i
+                            where revision_id = $latest_revision"
+            }
 
-	    content::item::set_live_revision -revision_id $object_id
+            content::item::set_live_revision -revision_id $object_id
 
-	    set revision_ids [db_list get_revision_ids {}]
-	    set revision_id [lindex $revision_ids 0]
-	    set prev_revision_id [lindex $revision_ids 1]
+            set revision_ids [db_list get_revision_ids {}]
+            set revision_id [lindex $revision_ids 0]
+            set prev_revision_id [lindex $revision_ids 1]
 
-	    if {[string equal $cr_widget none] ||
-		([string equal $cr_widget file] && 
-		 [string equal $tmp_file ""])} {
+            if {[string equal $cr_widget none] ||
+                ([string equal $cr_widget file] && 
+                 [string equal $tmp_file ""])} {
 
-		# either a content widget wasn't included in the form or
-		# no new file was uploaded, so we want to preserve the previous
-		# revisions content
-		if {![string equal $prev_revision_id ""]} {
-		    db_dml update_content {}
-		}
-	    } else {
-		dtype::upload_content -item_id $item_id \
-		    -revision_id $revision_id \
-		    -file $tmp_file \
-		    -storage_type $cr_storage
+                # either a content widget wasn't included in the form or
+                # no new file was uploaded, so we want to preserve the previous
+                # revisions content
+                if {![string equal $prev_revision_id ""]} {
+                    db_dml update_content {}
+                }
+            } else {
+                dtype::upload_content -item_id $item_id \
+                    -revision_id $revision_id \
+                    -file $tmp_file \
+                    -storage_type $cr_storage
 
-		ns_unlink $tmp_file
-	    }
-	}
+                ns_unlink $tmp_file
+            }
+        }
     } else {
-	if {$new_p} { 
-	    db_dml insert_statement "
-                insert into ${type_info(table_name)}i ([join $columns ", "])
-                values ([join $values ", "])"
-	} else {
-	    set updates [list]
+        if {$new_p} { 
+            db_dml insert_statement "
+                    insert into ${type_info(table_name)}i ([join $columns ", "])
+                    values ([join $values ", "])"
+        } else {
+            set updates [list]
 
-	    set all_columns [concat $columns $missing_columns]
-	    set all_values [concat $values $missing_columns]
+            set all_columns [concat $columns $missing_columns]
+            set all_values [concat $values $missing_columns]
 
-	    set length [llength $all_columns]
-	    for {set i 0} {$i < $length} {incr i} {
-		lappend updates "[lindex $all_columns $i] = [lindex $all_values $i]"
-	    }
+            set length [llength $all_columns]
+            for {set i 0} {$i < $length} {incr i} {
+                lappend updates "[lindex $all_columns $i] = [lindex $all_values $i]"
+            }
 
-	    db_dml update_statement "
-                update ${type_info(table_name)}i 
-                set [join $updates ", "]
-                where $type_info(id_column) = :object_id"
-	}
+            db_dml update_statement "
+                    update ${type_info(table_name)}i 
+                    set [join $updates ", "]
+                    where $type_info(id_column) = :object_id"
+        }
     }
 
     return $object_id
@@ -487,8 +465,6 @@
     {-overrides {}}
     {-cr_widget textarea}
     {-cr_widget_options {}}
-    {-exclude_static_p 0}
-    {-exclude {}}
     {-variables {}}
 } {
     Adds the elements of the specified or implicit object form to the specified
@@ -511,7 +487,6 @@
     #
     dtype::form::metadata::widgets -object_type $object_type \
         -dform $dform \
-	-exclude_static_p $exclude_static_p \
         -multirow widgets
     
     dtype::form::metadata::params -object_type $object_type \
@@ -530,19 +505,14 @@
         set html_options [list]
         set widget_options [list]
 
-	# exclude specified widgets
-	if {[lsearch -exact $exclude $widgets(attribute_name)] > -1} {
-	    continue
-	}
-
         # set the default values for overridable options
-	set overridables(help_text) "[_ acs-translations.$widgets(object_type)\_$widgets(attribute_name)\_help]"
-	set message_key "acs-translations.$widgets(object_type)\_$widgets(attribute_name)"
-	if {[lang::message::message_exists_p $default_locale $message_key]} {
-	    set overridables(label) "[_ $message_key]"
-	} else {
-	    set overridables(label) $widgets(pretty_name)
-	}
+        set overridables(help_text) "[_ acs-translations.$widgets(object_type)\_$widgets(attribute_name)\_help]"
+        set message_key "acs-translations.$widgets(object_type)\_$widgets(attribute_name)"
+        if {[lang::message::message_exists_p $default_locale $message_key]} {
+            set overridables(label) "[_ $message_key]"
+        } else {
+            set overridables(label) $widgets(pretty_name)
+        }
 
         # Create the main element create line
         set element_create_cmd "template::element create \
@@ -816,7 +786,6 @@
     {-dform:required}
     {-multirow {}}
     {-indexed_array {}}
-    {-exclude_static_p 0}
 } {
     Returns the widget metadata for the specified object_type and dform
     as either a multirow or an indexed array.
@@ -863,7 +832,6 @@
 
     set metadata [dtype::form::metadata::widgets_list \
                       -object_type $object_type \
-		      -exclude_static_p $exclude_static_p \
                       -dform $dform]
 
     foreach widget $metadata {
@@ -883,7 +851,6 @@
     {-no_cache:boolean}
     {-object_type:required}
     {-dform:required}
-    {-exclude_static_p 0}
 } {
     Returns a list of lists with the widget metadata for the specified 
     object_type and dform.
@@ -893,13 +860,9 @@
     @param no_cache does not attempt to use the cache to retrieve the info
 } {
     if {$no_cache_p} {
-	if {$exclude_static_p} {
-	    return [db_list_of_lists select_dform_metadata_dynamic {}]
-	} else {
 	    return [db_list_of_lists select_dform_metadata {}]
-	}
     } else {
-        return [util_memoize "dtype::form::metadata::widgets_list -no_cache -object_type \"$object_type\" -dform \"$dform\" -exclude_static_p $exclude_static_p"]
+        return [util_memoize "dtype::form::metadata::widgets_list -no_cache -object_type \"$object_type\" -dform \"$dform\""]
     }
 }
 
@@ -982,27 +945,21 @@
 }
 
 ad_proc -private dtype::form::metadata::flush_cache {
-    {-type:required}
-    {-event:required}
+    {-object_type:required}
+    {-dform ""}
 } {
     Flushes the util_memoize cache of dtype::form::metadata calls for a given
     object type.
-
-    event is assumed to contain object_type.
 } {
-    upvar $event dtype_event
-
     set function "dtype::form::metadata::\[^ \]*_list -no_cache" 
-    set object_type "-object_type \"$dtype_event(object_type)\""
+    set type_switch "-object_type \"$object_type\""
 
-    if {[string equal $type dtype] || [string equal $type dtype.attribute]} {
+    if {[string equal $dform ""]} {
         # flush the default form
-        util_memoize_flush_regexp "$function $object_type -dform \"implicit\".*"
+        util_memoize_flush_regexp "$function $type_switch -dform \"implicit\".*"
     } else {
-        set dform $dtype_event(dform)
-
         # flush the form specified in the event
-        util_memoize_flush_regexp "$function $object_type -dform \"$dform\".*"
+        util_memoize_flush_regexp "$function $type_switch -dform \"$dform\".*"
     }
 }
 
@@ -1052,12 +1009,8 @@
 
     db_exec_plsql create_widget {}
 
-    set event(object_type) $object_type
-    set event(dform) $dform
-    set event(attribute) $attribute_name
-    set event(widget) $widget
-    set event(action) created
-    util::event::fire -event dtype.form.metadata.widget event
+    dtype::form::metadata::flush_cache -object_type $object_type \
+        -dform $dform
 }
 
 ad_proc -public dtype::form::metadata::delete_widget {
@@ -1072,11 +1025,8 @@
 
     db_exec_plsql delete_widget {}
 
-    set event(object_type) $object_type
-    set event(dform) $dform
-    set event(attribute) $attribute_name
-    set event(action) deleted
-    util::event::fire -event dtype.form.metadata.widget event
+    dtype::form::metadata::flush_cache -object_type $object_type \
+        -dform $dform
 }
 
 ad_proc -public dtype::form::metadata::create_widget_param {
@@ -1092,12 +1042,8 @@
 } {
     db_exec_plsql create_widget_param {}
 
-    set event(object_type) $object_type
-    set event(dform) $dform
-    set event(attribute) $attribute_name
-    set event(param) $param_name
-    set event(action) created
-    util::event::fire -event dtype.form.metadata.widget.param event
+    dtype::form::metadata::flush_cache -object_type $object_type \
+        -dform $dform
 }
 
 ad_proc -public dtype::form::metadata::clone_widget_template {
@@ -1160,15 +1106,13 @@
     Create new dynamic form
 } {
     if {[empty_string_p $form_id]} {
-	set form_id [db_nextval t_dtype_seq]
+        set form_id [db_nextval t_dtype_seq]
     }
 
     db_dml insert_form {}
 
-    set event(object_type) $object_type
-    set event(dform) $form_name
-    set event(action) created
-    util::event::fire -event dtype.form event
+    dtype::form::metadata::flush_cache -object_type $object_type \
+        -dform $dform
 }
 
 ad_proc -public dtype::form::edit {
@@ -1179,8 +1123,6 @@
 } {
     db_dml update_form {}
 
-    set event(object_type) $object_type
-    set event(dform) $form_name
-    set event(action) updated
-    util::event::fire -event dtype.form event
+    dtype::form::metadata::flush_cache -object_type $object_type \
+        -dform $dform
 }