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 @@
         <blockquote style='margin-left: 2em; margin-right:0px;'>$cat_content</blockquote>\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]}]
+  }
 }
+