Index: openacs-4/packages/categories/tcl/categories-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/categories/tcl/categories-procs.tcl,v diff -u -N -r1.8 -r1.9 --- openacs-4/packages/categories/tcl/categories-procs.tcl 4 Feb 2004 15:21:30 -0000 1.8 +++ openacs-4/packages/categories/tcl/categories-procs.tcl 6 Feb 2004 14:06:52 -0000 1.9 @@ -357,9 +357,10 @@ namespace eval category::ad_form {} ad_proc -public category::ad_form::add_widgets { - {-container_object_id:required} - {-categorized_object_id} - {-form_name:required} + {-container_object_id:required} + {-categorized_object_id} + {-form_name:required} + {-element_name "category_id"} } { For each category tree associated with this container_object_id (usually package_id) put a category widget into the ad_form. On form submission the @@ -371,19 +372,28 @@ set category_trees [category_tree::get_mapped_trees $container_object_id] foreach tree $category_trees { - foreach { tree_id name subtree_id } $tree {} + util_unlist $tree tree_id name subtree_id assign_single_p require_category_p + set options "" + if {$assign_single_p == "f"} { + set options ",multiple" + } + if {$require_category_p == "f"} { + append options ",optional" + } ad_form -extend -name $form_name -form \ - [list [list __category__ad_form__category_id_${tree_id}:integer(category),optional \ + [list [list __category__ad_form__$element_name\_${tree_id}:category$options \ {label $name} \ - {html {single single}} \ {category_tree_id $tree_id} \ {category_subtree_id $subtree_id} \ - {category_object_id {[value_if_exists categorized_object_id]}}]] + {category_object_id {[value_if_exists categorized_object_id]}} \ + {category_assign_single_p $assign_single_p} \ + {category_require_category_p $require_category_p}]] } } ad_proc -public category::ad_form::get_categories { - {-object_id:required} + {-container_object_id:required} + {-element_name "category_id"} } { Collects categories from the category widget in the format compatible with @@ -392,13 +402,13 @@ @author Branimir Dolicki (bdolicki@branimir.com) } { - set category_trees [category_tree::get_mapped_trees $object_id] + set category_trees [category_tree::get_mapped_trees $container_object_id] set category_ids [list] foreach tree $category_trees { - foreach { tree_id name dummy } $tree {} + util_unlist $tree tree_id name subtree_id assign_single_p require_category_p upvar #[template::adp_level] \ - __category__ad_form__category_id_${tree_id} my_category_id - lappend category_ids $my_category_id + __category__ad_form__$element_name\_${tree_id} my_category_ids + eval lappend category_ids $my_category_ids } return $category_ids } Index: openacs-4/packages/categories/tcl/category-trees-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/categories/tcl/category-trees-procs.tcl,v diff -u -N -r1.6 -r1.7 --- openacs-4/packages/categories/tcl/category-trees-procs.tcl 1 Feb 2004 19:12:51 -0000 1.6 +++ openacs-4/packages/categories/tcl/category-trees-procs.tcl 6 Feb 2004 14:06:52 -0000 1.7 @@ -181,13 +181,14 @@ Get the category trees mapped to an object. @param object_id object to get the mapped category trees. - @return tcl list of lists: tree_id tree_name subtree_category_id assign_single_p + @return tcl list of lists: tree_id tree_name subtree_category_id + assign_single_p require_category_p @author Timo Hentschel (timo@timohentschel.de) } { set result [list] db_foreach get_mapped_trees "" { - lappend result [list $tree_id [get_name $tree_id] $subtree_category_id $assign_single_p] + lappend result [list $tree_id [get_name $tree_id] $subtree_category_id $assign_single_p $require_category_p] } return $result Index: openacs-4/packages/categories/tcl/category-trees-procs.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/categories/tcl/category-trees-procs.xql,v diff -u -N -r1.3 -r1.4 --- openacs-4/packages/categories/tcl/category-trees-procs.xql 1 Feb 2004 19:12:51 -0000 1.3 +++ openacs-4/packages/categories/tcl/category-trees-procs.xql 6 Feb 2004 14:06:52 -0000 1.4 @@ -27,7 +27,8 @@ - select tree_id, subtree_category_id, assign_single_p + select tree_id, subtree_category_id, assign_single_p, + require_category_p from category_tree_map where object_id = :object_id 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 -N -r1.7 -r1.8 --- openacs-4/packages/categories/tcl/widget-procs.tcl 3 Feb 2004 23:55:55 -0000 1.7 +++ openacs-4/packages/categories/tcl/widget-procs.tcl 6 Feb 2004 14:06:52 -0000 1.8 @@ -39,7 +39,7 @@ set tree_id {} set subtree_id {} set assign_single_p f - set require_category_p t + set require_category_p f if { [exists_and_not_null element(value)] && [llength $element(value)] == 2 } { # Legacy method for passing parameters @@ -61,8 +61,8 @@ if { [exists_and_not_null element(category_assign_single_p)] } { set assign_single_p $element(category_assign_single_p) } - if { [exists_and_not_null element(require_category_p)] } { - set require_category_p $element(require_category_p) + 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] } { @@ -86,8 +86,8 @@ 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 require_category_p + foreach mapped_tree $mapped_trees { + util_unlist $mapped_tree tree_id tree_name subtree_id assign_single_p require_category_p set tree_name [ad_quotehtml $tree_name] set one_tree [list] @@ -106,7 +106,7 @@ if {$assign_single_p == "t" || $all_single_p} { # single-select widget - if { ![template::util::is_true $require_category_p] } { + if { $require_category_p == "f" } { set one_tree [concat [list [list "" ""]] $one_tree] } append output [template::widget::menu $element(name) $one_tree $mapped_categories attributes $element(mode)] @@ -187,7 +187,13 @@ } if { [empty_string_p $tree_id] } { - set trees [db_list get_trees_requiring_category ""] + set trees [list] + foreach tree [category_tree::get_mapped_trees $package_id] { + util_unlist $tree tree_id tree_name subtree_id assign_single_p require_category_p + if {$require_category_p == "t" || ![info exists element(optional)]} { + lappend trees [list $tree_id $subtree_id] + } + } } else { if {$require_category_p == "t"} { set trees [list [list $tree_id $subtree_id]] @@ -198,8 +204,9 @@ set trees_without_category [list] foreach tree $trees { + util_unlist $tree tree_id subtree_id # get categories of every tree requiring a categorization - foreach category [category_tree::get_tree -all -subtree_id [lindex $tree 1] [lindex $tree 0]] { + foreach category [category_tree::get_tree -all -subtree_id $subtree_id $tree_id] { set tree_categories([lindex $category 0]) 1 } set found_p 0 @@ -211,7 +218,7 @@ } 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]] + lappend trees_without_category [category_tree::get_name $tree_id] } array unset tree_categories } 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 -N --- openacs-4/packages/categories/tcl/widget-procs.xql 3 Feb 2004 18:36:14 -0000 1.1 +++ /dev/null 1 Jan 1970 00:00:00 -0000 @@ -1,15 +0,0 @@ - - - - - - - select tree_id, subtree_category_id - from category_tree_map - where object_id = :package_id - and require_category_p = 't' - - - - -