Index: openacs-4/packages/xowiki/tcl/category-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/category-procs.tcl,v diff -u -r1.13 -r1.14 --- openacs-4/packages/xowiki/tcl/category-procs.tcl 28 Sep 2007 20:34:06 -0000 1.13 +++ openacs-4/packages/xowiki/tcl/category-procs.tcl 6 Nov 2008 20:53:45 -0000 1.14 @@ -122,4 +122,64 @@
$cat_content
\n" } + # + # Commonly used code for categories + # + Category proc get_mapped_trees { + -object_id + {-locale ""} + {-names ""} + {-output {tree_id tree_name subtree_category_id assign_single_p require_category_p}} + } { + # Return matched category trees matching the specified names (or all) + + # provide compatibility with earlier versions of categories + set have_locale [expr {[lsearch [info args category_tree::get_mapped_trees] locale] > -1}] + set mapped_trees [expr {$have_locale ? + [category_tree::get_mapped_trees $object_id $locale] : + [category_tree::get_mapped_trees $object_id]}] + set trees [list] + foreach tree $mapped_trees { + foreach {tree_id my_tree_name ...} $tree {break} + + # "names" is a list of category names + if {$names ne ""} { + # Check, if the current name matches any of the given + # names. If the name contains wild-cards, perform a string + # match, otherwise a string equal. + set match 0 + foreach n $names { + if {[string first * $n] > -1} { + if {![string match $n $my_tree_name]} { + set match 1 + break + } + } elseif {$n eq $my_tree_name} { + set match 1 + break + } + } + if {!$match} continue + } + # Get the values from info in "tree" into separate variables given by output. + # Note, that the order matters! + foreach $output $tree break + set l [list] + foreach __var $output {lappend l [set $__var]} + lappend trees $l + } + return $trees + } + + Category proc get_category_infos {{-all false} {-subtree_id ""} {-locale ""} -tree_id} { + # + # provide a common interface to older versions of categories + # + # provide compatibility with earlier versions of categories + set have_locale [expr {[lsearch [info args category_tree::get_tree] locale] > -1}] + return [expr {$have_locale ? + [category_tree::get_tree -all $all -subtree_id $subtree_id $tree_id $locale] : + [category_tree::get_tree -all $all -subtree_id $subtree_id $tree_id]}] + } } + Index: openacs-4/packages/xowiki/tcl/form-field-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/form-field-procs.tcl,v diff -u -r1.118 -r1.119 --- openacs-4/packages/xowiki/tcl/form-field-procs.tcl 23 Oct 2008 12:26:27 -0000 1.118 +++ openacs-4/packages/xowiki/tcl/form-field-procs.tcl 6 Nov 2008 20:53:45 -0000 1.119 @@ -1183,7 +1183,7 @@ } } enumeration instproc config_from_category_tree {tree_name} { - # Get the options of a select or rado from the specified + # Get the options of a select or radio from the specified # category tree. # # We could config as well from the mapped category tree, @@ -1192,24 +1192,26 @@ # The usage of the label does not seem to be very useful. # #set tree_id [category_tree::get_id $tree_name [my locale]] - set tree_id [category_tree::get_id $tree_name] + + set package_id [[my object] package_id] + set tree_ids [::xowiki::Category get_mapped_trees -object_id $package_id -locale [my locale] \ + -names $tree_name -output tree_id] + + # In case there are multiple trees with the same name, + # take the first one. + # + set tree_id [lindex $tree_ids 0] + if {$tree_id eq ""} { - my msg "cannot lookup category tree name '$tree_name'" + my msg "cannot lookup mapped category tree name '$tree_name'" return } - # - # In case there are multiple trees with the same named map, - # take the first one to avoid confusions. - # - #my msg tree_id=$tree_id - set tree_id [lindex $tree_id 0] set subtree_id "" set options [list] - foreach category [category_tree::get_tree -subtree_id $subtree_id $tree_id] { + foreach category [::xowiki::Category get_category_infos \ + -subtree_id $subtree_id -tree_id $tree_id] { foreach {category_id category_name deprecated_p level} $category break - #if {[lsearch $category_ids $category_id] > -1} {lappend value $category_id} - #lappend value $category_id set category_name [ad_quotehtml [lang::util::localize $category_name]] my set category_label($category_id) $category_name if { $level>1 } { Index: openacs-4/packages/xowiki/tcl/includelet-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/includelet-procs.tcl,v diff -u -r1.74 -r1.75 --- openacs-4/packages/xowiki/tcl/includelet-procs.tcl 31 Oct 2008 02:01:30 -0000 1.74 +++ openacs-4/packages/xowiki/tcl/includelet-procs.tcl 6 Nov 2008 20:53:45 -0000 1.75 @@ -547,18 +547,10 @@ foreach {locale locale_clause} \ [::xowiki::Includelet locale_clause -revisions r -items ci $package_id $locale] break - set have_locale [expr {[lsearch [info args category_tree::get_mapped_trees] locale] > -1}] - set mapped_trees [expr {$have_locale ? - [category_tree::get_mapped_trees $package_id $locale] : - [category_tree::get_mapped_trees $package_id]}] + set trees [::xowiki::Category get_mapped_trees -object_id $package_id -locale $locale \ + -names $tree_name \ + -output {tree_id tree_name}] - set trees [list] - foreach tree $mapped_trees { - foreach {tree_id my_tree_name ...} $tree {break} - if {$tree_name ne "" && ![string match $tree_name $my_tree_name]} continue - lappend trees [list $tree_id $my_tree_name] - } - #my msg "[llength $trees] == 0 && $tree_name" if {[llength $trees] == 0 && $tree_name ne ""} { # we have nothing left from mapped trees, maybe the tree_names are not mapped; @@ -569,10 +561,9 @@ } } - #my msg "nr trees = [llength $trees], tree:name = '$tree_name'" if {[llength $trees] == 0} { - my log "No category tree found\n\ - (mapped trees = [llength $mapped_trees],\n\ + my log "No mapped category tree found\n\ + (mapped trees = [llength $trees],\n\ tree_name = '$tree_name')" return "" } @@ -585,9 +576,7 @@ set categories [list] set pos 0 set cattree(0) [::xowiki::CatTree new -volatile -orderby pos -name $my_tree_name] - set category_infos [expr {$have_locale ? - [category_tree::get_tree $tree_id $locale] : - [category_tree::get_tree $tree_id]}] + set category_infos [::xowiki::Category get_category_infos -locale $locale -tree_id $tree_id] foreach category_info $category_infos { foreach {cid category_label deprecated_p level} $category_info {break} @@ -714,17 +703,10 @@ foreach {locale locale_clause} \ [::xowiki::Includelet locale_clause -revisions r -items ci $package_id $locale] break - set have_locale [expr {[lsearch [info args category_tree::get_mapped_trees] locale] > -1}] - set trees [expr {$have_locale ? - [category_tree::get_mapped_trees $package_id $locale] : - [category_tree::get_mapped_trees $package_id]}] - - foreach tree $trees { - foreach {tree_id my_tree_name ...} $tree {break} - if {$tree_name ne "" && ![string match $tree_name $my_tree_name]} continue - lappend tree_ids $tree_id - } - if {[info exists tree_ids]} { + set tree_ids [::xowiki::Category get_mapped_trees -object_id $package_id -locale $locale \ + -names $tree_name -output tree_id] + + if {$tree_ids ne ""} { set tree_select_clause "and c.tree_id in ([join $tree_ids ,])" } else { set tree_select_clause "" Index: openacs-4/packages/xowiki/tcl/notification-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/notification-procs.tcl,v diff -u -r1.10 -r1.11 --- openacs-4/packages/xowiki/tcl/notification-procs.tcl 7 Nov 2007 14:06:13 -0000 1.10 +++ openacs-4/packages/xowiki/tcl/notification-procs.tcl 6 Nov 2008 20:53:45 -0000 1.11 @@ -137,7 +137,7 @@ set tree_id [category::get_tree $cat_id] array unset cat array unset label - foreach category_info [category_tree::get_tree $tree_id] { + foreach category_info [::xowiki::Category get_category_infos -tree_id $tree_id] { foreach {category_id category_label deprecated_p level} $category_info {break} set cat($level) $category_id set label($level) $category_label Index: openacs-4/packages/xowiki/tcl/xowiki-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/xowiki-procs.tcl,v diff -u -r1.307 -r1.308 --- openacs-4/packages/xowiki/tcl/xowiki-procs.tcl 4 Nov 2008 20:46:19 -0000 1.307 +++ openacs-4/packages/xowiki/tcl/xowiki-procs.tcl 6 Nov 2008 20:53:45 -0000 1.308 @@ -326,7 +326,7 @@ array set data [category_tree::get_data $tree_id] set categories [list] if {[my exists __category_map]} {array set cm [my set __category_map]} - foreach category [category_tree::get_tree $tree_id] { + foreach category [::xowiki::Category get_category_infos -tree_id $tree_id] { foreach {category_id category_name deprecated_p level} $category break lappend categories $level $category_name set names($level) $category_name @@ -364,19 +364,21 @@ } Page instproc category_import {-name -description -locale -categories} { #my msg "...catetegoy_import [self args]" - # ignore locale in get_id for now, since it seems broken - set tree_id [category_tree::get_id $name] - set tree_id [lindex $tree_id 0]; # handle multiple trees with same name + + set tree_ids [::xowiki::Category get_mapped_trees -object_id $package_id -locale $locale \ + -names [list $name] -output tree_id] + set tree_id [lindex $tree_ids 0]; # handle multiple mapped trees with same name if {$tree_id eq ""} { # we have to import the category tree my log "...importing category tree $name" - category_tree::import -name $name -description $description \ - -locale $locale -categories $categories - set tree_id [category_tree::get_id $name] + set tree_id [category_tree::import -name $name -description $description \ + -locale $locale -categories $categories + set tree_id [category_tree::get_id $name]] + category_tree::map -tree_id $tree_id -object_id [my package_id] } # # build reverse category_map - foreach category [category_tree::get_tree $tree_id] { + foreach category [::xowiki::Category get_category_infos -tree_id $tree_id] { foreach {category_id category_name deprecated_p level} $category break lappend categories $level $category_name set names($level) $category_name Index: openacs-4/packages/xowiki/tcl/xowiki-www-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/xowiki-www-procs.tcl,v diff -u -r1.198 -r1.199 --- openacs-4/packages/xowiki/tcl/xowiki-www-procs.tcl 4 Nov 2008 20:46:19 -0000 1.198 +++ openacs-4/packages/xowiki/tcl/xowiki-www-procs.tcl 6 Nov 2008 20:53:45 -0000 1.199 @@ -582,6 +582,11 @@ FormPage instproc create_category_fields {} { set category_spec [my get_short_spec @categories] + # Per default, no category fields in FormPages, since the can be + # handled in more detail via form-fields. + if {$category_spec eq ""} {return [list]} + + # a value of "off" turns the off as well foreach f [split $category_spec ,] { if {$f eq "off"} {return [list]} } @@ -598,7 +603,8 @@ set options [list] #if {!$require_category_p} {lappend options [list "--" ""]} set value [list] - foreach category [category_tree::get_tree -subtree_id $subtree_id $tree_id] { + foreach category [::xowiki::Category get_category_infos \ + -subtree_id $subtree_id -tree_id $tree_id] { foreach {category_id category_name deprecated_p level} $category break if {[lsearch $category_ids $category_id] > -1} {lappend value $category_id} set category_name [ad_quotehtml [lang::util::localize $category_name]] Index: openacs-4/packages/xowiki/www/prototypes/categories-portlet.page =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/prototypes/categories-portlet.page,v diff -u -r1.3 -r1.4 --- openacs-4/packages/xowiki/www/prototypes/categories-portlet.page 3 Sep 2007 21:07:53 -0000 1.3 +++ openacs-4/packages/xowiki/www/prototypes/categories-portlet.page 6 Nov 2008 20:54:00 -0000 1.4 @@ -33,16 +33,19 @@ [::xo::db::CrClass lookup -name $open_page -parent_id $folder_id] : 0}] set content "" - foreach tree [category_tree::get_mapped_trees $package_id] { + + set tree_ids [::xowiki::Category get_mapped_trees -object_id $package_id \ + -names $tree_name -output {tree_id tree_name}] + + foreach tree $tree_ids { foreach {tree_id my_tree_name ...} $tree {break} - if {$tree_name ne "" && ![string match $tree_name $my_tree_name]} continue if {!$no_tree_name} { append content "

$my_tree_name

" } set categories [list] set pos 0 set cattree(0) [::xowiki::CatTree new -volatile -orderby pos -name $my_tree_name] - foreach category_info [category_tree::get_tree $tree_id] { + foreach category_info [::xowiki::Category get_category_infos -tree_id $tree_id] { foreach {cid category_label deprecated_p level} $category_info {break} set c [::xowiki::Category new -orderby pos -category_id $cid -package_id $package_id \ -level $level -label $category_label -pos [incr pos]]