Index: openacs-4/packages/categories/tcl/widget-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/tcl/widget-procs.tcl,v
diff -u -r1.4 -r1.5
--- openacs-4/packages/categories/tcl/widget-procs.tcl	2 Feb 2004 15:47:29 -0000	1.4
+++ openacs-4/packages/categories/tcl/widget-procs.tcl	3 Feb 2004 18:36:14 -0000	1.5
@@ -1,3 +1,19 @@
+# Category widgets for the ArsDigita Templating System
+
+# Author: Timo Hentschel (timo@timohentschel.de)
+#
+# $Id: 
+
+# This is free software distributed under the terms of the GNU Public
+# License.  Full text of the license is available from the GNU Project:
+# http://www.fsf.org/copyleft/gpl.html
+
+namespace eval template {}
+namespace eval template::widget {}
+namespace eval template::data {}
+namespace eval template::data::transform {}
+namespace eval template::data::validate {}
+
 ad_proc -public template::widget::category { element_reference tag_attributes } {
     # author: Timo Hentschel (timo@timohentschel.de)
 
@@ -22,6 +38,8 @@
     set package_id {}
     set tree_id {}
     set subtree_id {}
+    set assign_single_p f
+
     if { [exists_and_not_null element(value)] && [llength $element(value)] == 2 } {
         # Legacy method for passing parameters
         set object_id [lindex $element(value) 0]
@@ -39,28 +57,36 @@
         if { [exists_and_not_null element(category_subtree_id)] } {
             set subtree_id $element(category_subtree_id)
         }
+        if { [exists_and_not_null element(category_assign_single_p)] } {
+            set assign_single_p $element(category_assign_single_p)
+        }
     }
     if { [empty_string_p $package_id] } {
 	set package_id [ad_conn package_id]
     }
 
-    if { ![empty_string_p $object_id] } {
+    if { ![empty_string_p $object_id] && ![info exists element(submit)] } {
         set mapped_categories [category::get_mapped_categories $object_id]
     } else {
-        set mapped_categories {}
+	set mapped_categories [ns_querygetall $element(id)]
+	# QUIRK: ns_querygetall returns a single-element list {{}} for no values
+	if { [string equal $mapped_categories {{}}] } {
+	    set mapped_categories [list]
+	}
     }
     set output {}
 
     if { [empty_string_p $tree_id] } {
         set mapped_trees [category_tree::get_mapped_trees $package_id]
     } else {
-        set mapped_trees [list [list $tree_id [category_tree::get_name $tree_id] $subtree_id f]]
+        set mapped_trees [list [list $tree_id [category_tree::get_name $tree_id] $subtree_id $assign_single_p $require_category_p]]
     }
 
     foreach tree $mapped_trees {
-	util_unlist $tree tree_id tree_name subtree_id assign_single_p
+	util_unlist $tree tree_id tree_name subtree_id assign_single_p require_category_p
 	set tree_name [ad_quotehtml $tree_name]
 	set one_tree [list]
+
 	foreach category [category_tree::get_tree -subtree_id $subtree_id $tree_id] {
 	    util_unlist $category category_id category_name deprecated_p level
 	    set category_name [ad_quotehtml $category_name]
@@ -69,11 +95,14 @@
 	    }
 	    lappend one_tree [list $category_name $category_id]
 	}
+
         if { [llength $mapped_trees] > 1 } {
             append output " $tree_name\: "
-        }
+	}
+
 	if {$assign_single_p == "t" || $all_single_p} {
 	    # single-select widget
+	    set one_tree [concat [list [list "" ""]] $one_tree]
 	    append output [template::widget::menu $element(name) $one_tree $mapped_categories attributes $element(mode)]
 	} else {
 	    # multiselect widget (if user didn't override with single option)
@@ -83,3 +112,108 @@
 
     return $output
 }
+
+ad_proc -public template::data::validate::category { value_ref message_ref } {
+    # author: Timo Hentschel (timo@timohentschel.de)
+
+    upvar 2 $message_ref message $value_ref values
+    set invalid_values [list]
+
+    foreach value $values {
+	if {![regexp {^[+-]?\d+$} $value]} {
+	    lappend invalid_values $value
+	}
+    }
+
+    set result 1
+    if {[llength $invalid_values] > 0} {
+	set result 0
+	if {[llength $invalid_values] == 1} {
+	    set message "Invalid category [lindex $invalid_values 0]"
+	} else {
+	    set message "Invalid categories [join $invalid_values ", "]"
+	}
+    }
+    
+    return $result 
+}
+
+ad_proc -public template::data::transform::category { element_ref } {
+    # author: Timo Hentschel (timo@timohentschel.de)
+
+    upvar $element_ref element
+    set values [ns_querygetall $element(id)]
+
+    # QUIRK: ns_querygetall returns a single-element list {{}} for no values
+    if { [string equal $values {{}}] } {
+	set values [list]
+    }
+
+    # to mark submission of form for rendering element in case of invalid data
+    # (to preselect with last selected values)
+    set element(submit) 1
+
+    # Get parameters for the category widget
+    set package_id {}
+    set tree_id {}
+    set subtree_id {}
+    set require_category_p f
+
+    if { [exists_and_not_null element(value)] && [llength $element(value)] == 2 } {
+        # Legacy method for passing parameters
+        set package_id [lindex $element(value) 1]
+    } else {
+        if { [exists_and_not_null element(category_application_id)] } {
+            set package_id $element(category_application_id)
+        }
+        if { [exists_and_not_null element(category_tree_id)] } {
+            set tree_id $element(category_tree_id)
+        }
+        if { [exists_and_not_null element(category_subtree_id)] } {
+            set subtree_id $element(category_subtree_id)
+        }
+        if { [exists_and_not_null element(category_require_category_p)] } {
+            set require_category_p $element(category_require_category_p)
+        }
+    }
+    if { [empty_string_p $package_id] } {
+	set package_id [ad_conn package_id]
+    }
+
+    if { [empty_string_p $tree_id] } {
+        set trees [db_list get_trees_requiring_category ""]
+    } else {
+	if {$require_category_p == "t"} {
+	    set trees [list [list $tree_id $subtree_id]]
+	} else {
+	    set trees [list]
+	}
+    }
+
+    set trees_without_category [list]
+    foreach tree $trees {
+	# get categories of every tree requiring a categorization
+	foreach category [category_tree::get_tree -all -subtree_id [lindex $tree 1] [lindex $tree 0]] {
+	    set tree_categories([lindex $category 0]) 1
+	}
+	set found_p 0
+	# check if at least one selected category is among tree categories
+	foreach value $values {
+	    if {[info exists tree_categories($value)]} {
+		set found_p 1
+	    }
+	}
+	if {!$found_p} {
+	    # no categories of this tree selected, so add for error message
+	    lappend trees_without_category [category_tree::get_name [lindex $tree 0]]
+	}
+	array unset tree_categories
+    }
+    if {[llength $trees_without_category] > 0} {
+	# some trees require category, but none selected
+	template::element::set_error $element(form_id) $element(id) "Please select a category for [join $trees_without_category ", "]."
+        return [list]
+    }
+
+    return $values
+}