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
+}
Index: openacs-4/packages/categories/tcl/widget-procs.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/tcl/Attic/widget-procs.xql,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/tcl/widget-procs.xql 3 Feb 2004 18:36:14 -0000 1.1
@@ -0,0 +1,15 @@
+<?xml version="1.0"?>
+<queryset>
+
+<fullquery name="template::data::transform::category.get_trees_requiring_category">
+ <querytext>
+
+ select tree_id, subtree_category_id
+ from category_tree_map
+ where object_id = :package_id
+ and require_category_p = 't'
+
+ </querytext>
+</fullquery>
+
+</queryset>