Index: openacs-4/packages/categories/categories.info
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/categories.info,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/categories.info	23 Apr 2003 12:29:26 -0000	1.1
@@ -0,0 +1,27 @@
+<?xml version="1.0"?>
+<!-- Generated by the OpenACS Package Manager -->
+
+<package key="categories" url="http://www.arsdgita.com/acs-repository/apm/packages/categories" type="apm_service">
+    <package-name>Categories</package-name>
+    <pretty-plural>Categories</pretty-plural>
+    <initial-install-p>f</initial-install-p>
+    <singleton-p>f</singleton-p>
+    <auto-mount>categories</auto-mount>
+
+    <version name="0.1d" url="http://www.arsdgita.com/acs-repository/apm/packages/categories">
+        <owner>thentschel@sussdorff-roy.com</owner>
+        <summary>Manage categories in category trees and let users map objects to categories.</summary>
+        <release-date>2003-04-16</release-date>
+
+        <provides url="categories" version="0.1d"/>
+
+        <callbacks>
+            <callback type="after-install"  proc="category::after_install"/>
+            <callback type="before-uninstall"  proc="category::before_uninstall"/>
+        </callbacks>
+        <parameters>
+        <!-- No version parameters -->
+        </parameters>
+
+    </version>
+</package>
Index: openacs-4/packages/categories/sql/oracle/categories-create.sql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/sql/oracle/categories-create.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/sql/oracle/categories-create.sql	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,189 @@
+--
+-- The Categories Package
+--
+-- @author Timo Hentschel (thentschel@sussdorff-roy.com)
+-- @creation-date 2003-04-16
+--
+
+begin
+          -- create the object types
+ 
+        acs_object_type.create_type (
+                supertype       =>      'acs_object',
+                object_type     =>      'category_tree',
+                pretty_name     =>      'Category Tree',
+                pretty_plural   =>      'Category Trees',
+                table_name      =>      'category_trees',
+                id_column       =>      'tree_id',
+                name_method     =>      'category_tree.name'
+        );
+        acs_object_type.create_type (
+                supertype       =>      'acs_object',
+                object_type     =>      'category',
+                pretty_name     =>      'Category',
+                pretty_plural   =>      'Categories',
+                table_name      =>      'categories',
+                id_column       =>      'category_id',
+                name_method     =>      'category.name'
+        );
+end;
+/
+show errors
+
+create table category_trees (
+       tree_id			integer primary key constraint cat_trees_tree_id_fk references acs_objects on delete cascade,
+       site_wide_p		char(1) default 't' constraint cat_trees_site_wide_p_ck check (site_wide_p in ('t','f'))
+);
+
+comment on table category_trees is '
+  This is general data for each category tree.
+';
+comment on column category_trees.tree_id is '
+  ID of a tree.
+';
+comment on column category_trees.site_wide_p is '
+  Declares if a tree is site-wide or local (only usable by users/groups
+  that have permissions).
+';
+
+create table category_tree_translations (
+       tree_id			integer constraint cat_tree_trans_tree_id_fk references category_trees on delete cascade,
+       locale		        varchar2(5) not null constraint cat_tree_trans_locale_fk references ad_locales,
+       name			varchar2(50) not null,
+       description		varchar2(1000),
+       primary key (tree_id, locale)
+);
+
+comment on table category_tree_translations is '
+  Translations for names and descriptions of trees in different languages.
+';
+comment on column category_tree_translations.tree_id  is '
+  ID of a tree (see category_trees).
+';
+comment on column category_tree_translations.locale is '
+  ACS-Lang style locale if language ad country.
+';
+comment on column category_tree_translations.name is '
+  Name of the tree in the specified language.
+';
+comment on column category_tree_translations.description is '
+  Description of the tree in the specified language.
+';
+
+create table categories (
+       category_id		    integer primary key constraint cat_category_id_fk references acs_objects on delete cascade,
+       tree_id			    integer constraint cat_tree_id_fk references category_trees on delete cascade,
+       parent_id		    integer constraint cat_parent_id_fk references categories,
+       deprecated_p		    char(1) default 'f' constraint cat_deprecated_p_ck check (deprecated_p in ('t','f')),
+       left_ind			    integer,
+       right_ind		    integer
+);
+
+create unique index categories_left_ix on categories(tree_id, left_ind);
+create unique index categories_parent_ix on categories(parent_id, category_id);
+analyze table categories compute statistics;
+
+comment on table categories is '
+  Information about the categories in the tree structure.
+';
+comment on column categories.category_id is '
+  ID of a category.
+';
+comment on column categories.tree_id is '
+  ID of a tree (see category_trees).
+';
+comment on column categories.parent_id is '
+  Points to a parent category in the tree or null (if topmost category).
+';
+comment on column categories.deprecated_p is '
+  Marks categories to be no longer supported.
+';
+comment on column categories.left_ind is '
+  Left index in nested set structure of a tree.
+';
+comment on column categories.right_ind is '
+  Right index in nested set structure of a tree.
+';
+
+create table category_translations (
+       category_id	    integer constraint cat_trans_category_id_fk references categories on delete cascade,
+       locale		    varchar2(5) not null constraint cat_trans_locale_fk references ad_locales,
+       name		    varchar2(200),
+       description	    varchar2(4000),
+       primary key (category_id, locale)
+);
+
+comment on table category_translations is '
+  Translations for names and descriptions of categories in different languages.
+';
+comment on column category_translations.category_id is '
+  ID of a category (see categories).
+';
+comment on column category_translations.locale is '
+  ACS-Lang style locale if language ad country.
+';
+comment on column category_translations.name is '
+  Name of the category in the specified language.
+';
+comment on column category_translations.description is '
+  Description of the category in the specified language.
+';
+
+create table category_tree_map (
+	tree_id			integer constraint cat_tree_map_tree_id_fk references category_trees on delete cascade,
+	object_id		integer constraint cat_tree_map_object_id_fk references acs_objects on delete cascade,
+	subtree_category_id	integer default null constraint cat_tree_map_subtree_id_fk references categories,
+	primary key (object_id, tree_id)
+) organization index;
+
+create unique index cat_tree_map_ix on category_tree_map(tree_id, object_id);
+
+comment on table category_tree_map is '
+  Maps trees to objects (usually package instances) so that
+  other objects can be categorized.
+';
+comment on column category_tree_map.tree_id is '
+  ID of the mapped tree (see category_trees).
+';
+comment on column category_tree_map.object_id is '
+  ID of the mapped object (usually an apm_package if trees are to be used
+  in a whole package instance, i.e. file-storage).
+';
+comment on column category_tree_map.subtree_category_id is '
+  If a subtree is mapped, then this is the ID of the category on top
+  of the subtree, null otherwise.
+';
+
+create table category_object_map (
+       category_id		     integer constraint cat_object_map_category_id_fk references categories on delete cascade,
+       object_id		     integer constraint cat_object_map_object_id_fk references acs_objects on delete cascade,
+       primary key (category_id, object_id)
+) organization index;
+
+create unique index cat_object_map_ix on category_object_map(object_id, category_id);
+
+comment on table category_object_map is '
+  Maps categories to objects and thus categorizes and object.
+';
+comment on column category_object_map.category_id is '
+  ID of the mapped category (see categories).
+';
+comment on column category_object_map.object_id is '
+  ID of the mapped object.
+';
+
+create global temporary table category_temp (
+	category_id	integer
+) on commit delete rows;
+
+comment on table category_temp is '
+  Used mainly for multi-dimensional browsing to use only bind vars
+  in queries
+';
+
+@@category-tree-package.sql
+@@category-package.sql
+
+@@categories-permissions.sql
+
+@@categories-init.sql
Index: openacs-4/packages/categories/sql/oracle/categories-drop.sql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/sql/oracle/categories-drop.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/sql/oracle/categories-drop.sql	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,57 @@
+--
+-- The Categories Package
+--
+-- @author Timo Hentschel (thentschel@sussdorff-roy.com)
+-- @creation-date 2003-04-16
+--
+
+drop table category_temp;
+
+drop table category_object_map;
+
+drop table category_tree_map;
+
+drop table category_translations;
+
+drop table categories;
+
+drop table category_tree_translations;
+
+drop table category_trees;
+
+delete from acs_permissions where object_id in
+  (select object_id from acs_objects where object_type = 'category_tree');
+delete from acs_objects where object_type='category';
+delete from acs_objects where object_type='category_tree';
+
+
+begin
+   acs_object_type.drop_type('category', 't');
+   acs_object_type.drop_type('category_tree', 't');
+end;
+/
+show errors
+
+delete from acs_permissions
+    where privilege in
+        ('category_tree_write','category_tree_read',
+          'category_tree_grant_permissions','category_admin');
+
+delete from acs_privilege_hierarchy
+    where privilege in
+        ('category_tree_write','category_tree_read',
+          'category_tree_grant_permissions','category_admin');
+
+delete from acs_privilege_hierarchy
+    where child_privilege in
+        ('category_tree_write','category_tree_read',
+          'category_tree_grant_permissions','category_admin');
+
+delete from acs_privileges
+    where privilege in
+        ('category_tree_write','category_tree_read',
+          'category_tree_grant_permissions','category_admin');
+/
+
+drop package category_tree;
+drop package category;
Index: openacs-4/packages/categories/sql/oracle/categories-init.sql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/sql/oracle/categories-init.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/sql/oracle/categories-init.sql	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,70 @@
+--
+-- The Categories Package
+--
+-- @author Timo Hentschel (thentschel@sussdorff-roy.com)
+-- @creation-date 2003-04-16
+--
+
+
+-- This should eventually be added to the acs-service-contract installation files
+
+declare
+    v_id	integer;
+begin
+    v_id :=  acs_sc_contract.new(
+	    contract_name => 'AcsObject',
+	    contract_desc => 'Acs Object Id Handler'
+    );
+    v_id := acs_sc_msg_type.new(
+	    msg_type_name => 'AcsObject.PageUrl.InputType',
+	    msg_type_spec => 'object_id:integer'
+    );
+    v_id := acs_sc_msg_type.new(
+	    msg_type_name => 'AcsObject.PageUrl.OutputType',
+	    msg_type_spec => 'page_url:string'
+    );
+    v_id := acs_sc_operation.new(
+	    contract_name => 'AcsObject',
+	    operation_name => 'PageUrl',
+	    operation_desc => 'Returns the package specific url to a page that displays an object',
+	    operation_iscachable_p => 'f',
+	    operation_nargs => 1,
+	    operation_inputtype => 'AcsObject.PageUrl.InputType',
+	    operation_outputtype => 'AcsObject.PageUrl.OutputType'
+    );
+end;
+/
+show errors
+
+-- there should be an implementation of this contract
+-- for apm_package, user, group and other object types
+
+
+-- this should eventually be added to acs-kernel
+
+create table acs_named_objects (
+	object_id	integer not null
+			constraint acs_named_objs_pk primary key
+			constraint acs_named_objs_object_id_fk
+			references acs_objects(object_id) on delete cascade,
+	object_name	varchar2(200),
+	package_id	integer
+			constraint acs_named_objs_package_id_fk
+			references apm_packages(package_id) on delete cascade
+);
+
+create index acs_named_objs_name_ix on acs_named_objects (substr(upper(object_name),1,1));
+create index acs_named_objs_package_ix on acs_named_objects(package_id);
+
+begin
+        acs_object_type.create_type (
+                supertype       =>      'acs_object',
+                object_type     =>      'acs_named_object',
+                pretty_name     =>      'Named Object',
+                pretty_plural   =>      'Named Objects',
+                table_name      =>      'acs_named_objects',
+                id_column       =>      'object_id'
+        );
+end;
+/
+show errors
Index: openacs-4/packages/categories/sql/oracle/categories-permissions.sql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/sql/oracle/categories-permissions.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/sql/oracle/categories-permissions.sql	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,22 @@
+--
+-- The Categories Package
+--
+-- @author Timo Hentschel (thentschel@sussdorff-roy.com)
+-- @creation-date 2003-04-16
+--
+
+begin
+    -- create the privileges
+    acs_privilege.create_privilege('category_tree_write');
+    acs_privilege.create_privilege('category_tree_read');
+    acs_privilege.create_privilege('category_tree_grant_permissions');
+
+    acs_privilege.create_privilege('category_admin', 'Categories Administrator');
+    acs_privilege.add_child('admin','category_admin');      
+    acs_privilege.add_child('category_admin','category_tree_read');
+    acs_privilege.add_child('category_admin','category_tree_write');
+    acs_privilege.add_child('category_admin','category_tree_grant_permissions');
+end;
+/
+show errors;
+commit;
Index: openacs-4/packages/categories/sql/oracle/category-package.sql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/sql/oracle/category-package.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/sql/oracle/category-package.sql	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,351 @@
+--
+-- The Categories Package
+--
+-- @author Timo Hentschel (thentschel@sussdorff-roy.com)
+-- @creation-date 2003-04-16
+--
+
+CREATE or REPLACE PACKAGE category AS
+    FUNCTION new ( 
+        category_id         in categories.category_id%TYPE		default null,
+        tree_id		    in categories.tree_id%TYPE			default null,
+        locale		    in category_translations.locale%TYPE,
+	name		    in category_translations.name%TYPE,
+	description	    in category_translations.description%TYPE,
+	parent_id           in categories.parent_id%TYPE		default null,
+        deprecated_p        in categories.deprecated_p%TYPE		default 'f',
+	object_type         in acs_object_types.object_type%TYPE	default 'category',
+	creation_date       in acs_objects.creation_date%TYPE		default sysdate,
+	creation_user       in acs_objects.creation_user%TYPE		default null,
+	creation_ip         in acs_objects.creation_ip%TYPE		default null
+    ) RETURN integer;
+
+    PROCEDURE new_translation ( 
+        category_id         in categories.category_id%TYPE,
+        locale		    in category_translations.locale%TYPE,
+	name		    in category_translations.name%TYPE,
+	description	    in category_translations.description%TYPE,
+	modifying_date	in acs_objects.last_modified%TYPE	default sysdate,
+	modifying_user	in acs_objects.creation_user%TYPE	default null,
+	modifying_ip	in acs_objects.creation_ip%TYPE		default null
+    );
+
+    PROCEDURE del ( 
+	category_id	in categories.category_id%TYPE 
+    );
+   
+    PROCEDURE phase_out (
+        category_id	in categories.category_id%TYPE
+    );
+ 
+    PROCEDURE phase_in (
+        category_id	in categories.category_id%TYPE
+    );
+ 
+    PROCEDURE edit (
+        category_id	in categories.category_id%TYPE, 
+        locale		in category_translations.locale%TYPE,
+        name		in category_translations.name%TYPE,
+        description	in category_translations.description%TYPE,
+	modifying_date	in acs_objects.last_modified%TYPE	default sysdate,
+	modifying_user	in acs_objects.creation_user%TYPE	default null,
+	modifying_ip	in acs_objects.creation_ip%TYPE		default null
+    );
+
+    PROCEDURE change_parent (
+	category_id	in categories.category_id%TYPE,
+	tree_id		in categories.tree_id%TYPE,
+	parent_id	in categories.category_id%TYPE default null
+    );
+
+    FUNCTION name (
+	category_id	in categories.category_id%TYPE
+    ) return varchar2;
+END;
+/
+show errors
+
+CREATE OR REPLACE PACKAGE BODY CATEGORY AS
+
+    FUNCTION new ( 
+        category_id         in categories.category_id%TYPE		default null,
+        tree_id		    in categories.tree_id%TYPE			default null,
+        locale		    in category_translations.locale%TYPE,
+	name		    in category_translations.name%TYPE,
+	description	    in category_translations.description%TYPE,
+	parent_id           in categories.parent_id%TYPE		default null,
+        deprecated_p        in categories.deprecated_p%TYPE		default 'f',
+	object_type         in acs_object_types.object_type%TYPE	default 'category',
+	creation_date       in acs_objects.creation_date%TYPE		default sysdate,
+	creation_user       in acs_objects.creation_user%TYPE		default null,
+	creation_ip         in acs_objects.creation_ip%TYPE		default null
+    ) RETURN integer
+    IS  
+        v_category_id	integer; 
+	v_left_ind	integer;
+	v_right_ind	integer;
+    BEGIN
+	v_category_id := acs_object.new ( 
+		object_id     => category_id,
+		object_type   => 'category',
+		creation_date => creation_date,
+		creation_user => creation_user,
+		creation_ip   => creation_ip,
+		context_id    => tree_id
+	);
+
+	if (new.parent_id is null) then
+		select 1, nvl(max(right_ind)+1,1) into v_left_ind, v_right_ind
+		from categories
+		where tree_id = new.tree_id;
+	else
+		select left_ind, right_ind into v_left_ind, v_right_ind
+		from categories
+		where category_id = new.parent_id;
+	end if;
+
+ 	insert into categories
+        (category_id, tree_id, deprecated_p, parent_id, left_ind, right_ind)
+	values
+	(v_category_id, new.tree_id, new.deprecated_p, new.parent_id, -1, -2);
+
+	-- move right subtrees to make room for new category
+	update categories
+	set left_ind = left_ind + 2,
+	    right_ind = right_ind + 2
+	where tree_id = new.tree_id
+	and left_ind > v_right_ind;
+
+	-- expand upper nodes to make room for new category
+	update categories
+	set right_ind = right_ind + 2
+	where tree_id = new.tree_id
+	and left_ind <= v_left_ind
+	and right_ind >= v_right_ind;
+
+	-- insert new category
+	update categories
+	set left_ind = v_right_ind,
+	    right_ind = v_right_ind + 1
+	where category_id = v_category_id;
+
+	insert into category_translations
+	    (category_id, locale, name, description)
+	values
+	    (v_category_id, locale, name, description);
+
+	return v_category_id;
+    END new;
+
+
+    PROCEDURE new_translation ( 
+        category_id         in categories.category_id%TYPE,
+        locale		    in category_translations.locale%TYPE,
+	name		    in category_translations.name%TYPE,
+	description	    in category_translations.description%TYPE,
+	modifying_date	in acs_objects.last_modified%TYPE	default sysdate,
+	modifying_user	in acs_objects.creation_user%TYPE	default null,
+	modifying_ip	in acs_objects.creation_ip%TYPE		default null
+    ) IS
+    BEGIN
+	insert into category_translations
+	    (category_id, locale, name, description)
+	values
+	    (category_id, locale, name, description);
+
+	update acs_objects
+        set last_modified = new_translation.modifying_date,
+	    modifying_user = new_translation.modifying_user,
+	    modifying_ip = new_translation.modifying_ip
+	where object_id = new_translation.category_id;
+
+    END new_translation;
+
+
+    PROCEDURE phase_out (
+        category_id	in categories.category_id%TYPE
+    ) IS
+    BEGIN 
+       update categories
+       set deprecated_p = 't'
+       where category_id = phase_out.category_id;
+    END phase_out;
+ 
+
+    PROCEDURE phase_in (
+        category_id	in categories.category_id%TYPE
+    ) IS
+    BEGIN 
+       update categories
+       set deprecated_p = 'f'
+       where category_id = phase_in.category_id;
+    END phase_in;
+ 
+
+    PROCEDURE del ( 
+	category_id	in categories.category_id%TYPE 
+    )
+    IS
+	v_tree_id   integer;
+	v_left_ind  integer;
+	v_right_ind integer;
+    BEGIN
+        select tree_id, left_ind, right_ind
+	into v_tree_id, v_left_ind, v_right_ind
+	from categories where category_id = category.del.category_id;
+
+	for node in (select category_id
+		from categories
+		where tree_id = v_tree_id
+		and left_ind >= v_left_ind
+		and right_ind <= v_right_ind) loop
+
+	   delete from category_object_map where category_id = node.category_id;
+	   delete from category_translations where category_id = node.category_id;
+	   delete from categories where category_id = node.category_id;
+	   acs_object.delete(node.category_id);
+	end loop;
+
+	update categories
+	set right_ind = right_ind - (1 + v_right_ind - v_left_ind)
+	where left_ind <= v_left_ind
+	and right_ind > v_left_ind
+	and tree_id = v_tree_id;
+
+	update categories
+	set right_ind = right_ind - (1 + v_right_ind - v_left_ind),
+	    left_ind = left_ind - (1 + v_right_ind - v_left_ind)
+	where left_ind > v_left_ind
+	and tree_id = v_tree_id;
+	
+        -- for debugging reasons
+        category_tree.check_nested_ind(v_tree_id);
+    END del;
+
+
+    PROCEDURE edit (
+        category_id	in categories.category_id%TYPE, 
+        locale		in category_translations.locale%TYPE,
+	name		in category_translations.name%TYPE,
+        description	in category_translations.description%TYPE,
+	modifying_date	in acs_objects.last_modified%TYPE	default sysdate,
+	modifying_user	in acs_objects.creation_user%TYPE	default null,
+	modifying_ip	in acs_objects.creation_ip%TYPE		default null
+    ) IS
+    BEGIN
+
+	-- change category name
+	update category_translations
+	set name = edit.name,
+            description = edit.description
+      where category_id = edit.category_id
+        and locale = edit.locale;
+
+	update acs_objects
+        set last_modified = edit.modifying_date,
+	    modifying_user = edit.modifying_user,
+	    modifying_ip = edit.modifying_ip
+      where object_id = edit.category_id;
+
+    END edit;
+
+
+    PROCEDURE change_parent (
+	category_id	in categories.category_id%TYPE,
+	tree_id		in categories.tree_id%TYPE,
+	parent_id	in categories.category_id%TYPE default null
+    )
+    IS
+	v_old_left_ind integer;
+	v_old_right_ind integer;
+	v_new_left_ind integer;
+	v_new_right_ind integer;
+	v_width integer;
+    BEGIN
+ 	update categories
+	set parent_id = change_parent.parent_id
+	where category_id = change_parent.category_id;
+
+	-- first save the subtree, then compact tree, then expand tree to make room
+	-- for subtree, then insert it
+
+	select left_ind, right_ind into v_old_left_ind, v_old_right_ind
+	from categories
+	where category_id = change_parent.category_id;
+
+	v_width := v_old_right_ind - v_old_left_ind + 1;
+
+	-- cut out old subtree
+	update categories
+	set left_ind = -left_ind, right_ind = -right_ind
+	where tree_id = change_parent.tree_id
+	and left_ind >= v_old_left_ind
+	and right_ind <= v_old_right_ind;
+
+	-- compact parent trees
+	update categories
+	set right_ind = right_ind - v_width
+	where tree_id = change_parent.tree_id
+	and left_ind < v_old_left_ind
+	and right_ind > v_old_right_ind;
+
+	-- compact right tree portion
+	update categories
+	set left_ind = left_ind - v_width,
+	right_ind = right_ind - v_width
+	where tree_id = change_parent.tree_id
+	and left_ind > v_old_left_ind;
+
+	if (change_parent.parent_id is null) then
+	   select 1, max(right_ind)+1 into v_new_left_ind, v_new_right_ind
+	   from categories
+	   where tree_id = change_parent.tree_id;
+	else
+	   select left_ind, right_ind into v_new_left_ind, v_new_right_ind
+	   from categories
+	   where category_id = change_parent.parent_id;
+	end if;
+
+	-- move parent trees to make room
+	update categories
+	set right_ind = right_ind + v_width
+	where tree_id = change_parent.tree_id
+	and left_ind <= v_new_left_ind
+	and right_ind >= v_new_right_ind;
+
+	-- move right tree portion to make room
+	update categories
+	set left_ind = left_ind + v_width,
+	right_ind = right_ind + v_width
+	where tree_id = change_parent.tree_id
+	and left_ind > v_new_right_ind;
+
+	-- insert subtree at correct place
+	update categories
+	set left_ind = -left_ind + (v_new_right_ind - v_old_left_ind),
+	right_ind = -right_ind + (v_new_right_ind - v_old_left_ind)
+	where tree_id = change_parent.tree_id
+	and left_ind < 0;
+
+	-- for debugging reasons
+        category_tree.check_nested_ind(change_parent.tree_id);
+    END change_parent;
+
+
+    FUNCTION name (
+	category_id	in categories.category_id%TYPE
+    ) return varchar2
+    IS
+	v_name	category_translations.name%TYPE;
+    BEGIN
+	select name into v_name
+	from category_translations
+	where category_id = name.category_id
+	and locale = 'en_US';
+
+	return v_name;
+    END name;
+
+END category;
+/
+show errors
Index: openacs-4/packages/categories/sql/oracle/category-tree-package.sql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/sql/oracle/category-tree-package.sql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/sql/oracle/category-tree-package.sql	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,404 @@
+--
+-- The Categories Package
+--
+-- @author Timo Hentschel (thentschel@sussdorff-roy.com)
+-- @creation-date 2003-04-16
+--
+
+create or replace package category_tree
+as 
+
+    FUNCTION new (
+        tree_id		     in category_trees.tree_id%TYPE		 default null,
+	locale		     in category_tree_translations.locale%TYPE,
+	tree_name	     in category_tree_translations.name%TYPE,
+	description	     in category_tree_translations.description%TYPE,
+        site_wide_p          in category_trees.site_wide_p%TYPE		 default 'f',
+	creation_date        in acs_objects.creation_date%TYPE		 default sysdate,
+	creation_user        in acs_objects.creation_user%TYPE		 default null,
+	creation_ip          in acs_objects.creation_ip%TYPE		 default null,
+	context_id           in acs_objects.context_id%TYPE		 default null
+    ) RETURN category_trees.tree_id%TYPE;
+
+    PROCEDURE new_translation (
+        tree_id		     in category_trees.tree_id%TYPE,
+	locale		     in category_tree_translations.locale%TYPE,
+	tree_name	     in category_tree_translations.name%TYPE,
+	description	     in category_tree_translations.description%TYPE,
+	modifying_date       in acs_objects.last_modified%TYPE		 default sysdate,
+	modifying_user       in acs_objects.creation_user%TYPE		 default null,
+	modifying_ip         in acs_objects.creation_ip%TYPE		 default null
+    );
+
+    PROCEDURE del ( 
+	tree_id              in category_trees.tree_id%TYPE 
+    );
+
+    PROCEDURE edit (
+        tree_id		     in category_trees.tree_id%TYPE		 default null,
+	locale		     in category_tree_translations.locale%TYPE,
+	tree_name	     in category_tree_translations.name%TYPE,
+	description	     in category_tree_translations.description%TYPE,
+        site_wide_p          in category_trees.site_wide_p%TYPE		 default 'f',
+	modifying_date       in acs_objects.last_modified%TYPE		 default sysdate,
+	modifying_user       in acs_objects.creation_user%TYPE		 default null,
+	modifying_ip         in acs_objects.creation_ip%TYPE		 default null
+    );
+
+    PROCEDURE copy (
+	source_tree           in category_trees.tree_id%TYPE,
+	dest_tree             in category_trees.tree_id%TYPE,
+	creation_user         in acs_objects.creation_user%TYPE		default null, 
+	creation_ip           in acs_objects.creation_ip%TYPE		default null
+    );
+
+    PROCEDURE map (
+	object_id		in acs_objects.object_id%TYPE,
+	tree_id			in category_trees.tree_id%TYPE,
+	subtree_category_id	in categories.category_id%TYPE		default null);
+
+    PROCEDURE unmap (
+	object_id in acs_objects.object_id%TYPE,
+	tree_id   in category_trees.tree_id%TYPE);
+    
+    FUNCTION name (
+	tree_id	in category_trees.tree_id%TYPE
+    ) return varchar2;
+
+    PROCEDURE check_nested_ind (tree_id in category_trees.tree_id%TYPE);
+
+    PROCEDURE refresh_nested_ind (tree_id in category_trees.tree_id%TYPE);
+end; 
+/ 
+show errors
+
+create or replace package body category_tree 
+as 
+    ------------------------------------------------------------
+    --	LOCAL FUNCTIONS and PROCEDURES
+    ------------------------------------------------------------
+    FUNCTION index_childs(p_parent_id integer, ind integer) RETURN integer;
+
+    ------------------------------------------------------------
+    --	PUBLIC FUNCTIONS and PROCEDURES
+    ------------------------------------------------------------
+    FUNCTION new (
+        tree_id		     in category_trees.tree_id%TYPE	         default null, 
+	locale		     in category_tree_translations.locale%TYPE,
+	tree_name	     in category_tree_translations.name%TYPE,
+	description	     in category_tree_translations.description%TYPE,
+        site_wide_p          in category_trees.site_wide_p%TYPE		 default 'f',
+	creation_date        in acs_objects.creation_date%TYPE		 default sysdate,
+	creation_user        in acs_objects.creation_user%TYPE		 default null,
+	creation_ip          in acs_objects.creation_ip%TYPE		 default null,
+	context_id           in acs_objects.context_id%TYPE		 default null
+    ) RETURN category_trees.tree_id%TYPE
+    IS
+        v_tree_id integer;
+    BEGIN
+	v_tree_id := acs_object.new (
+		object_id     => tree_id,
+		object_type   => 'category_tree',
+		creation_date => creation_date,
+		creation_user => creation_user,
+		creation_ip   => creation_ip,
+		context_id    => context_id 
+	);
+
+	insert into category_trees
+	   (tree_id, site_wide_p)
+	values
+	   (v_tree_id, site_wide_p);
+
+	acs_permission.grant_permission (
+		object_id  => v_tree_id,
+		grantee_id => creation_user,
+		privilege  => 'category_tree_read'
+	);
+	acs_permission.grant_permission (
+		object_id  => v_tree_id,
+		grantee_id => creation_user,
+		privilege  => 'category_tree_write'
+	);
+	acs_permission.grant_permission (
+		object_id  => v_tree_id,
+		grantee_id => creation_user,
+		privilege  => 'category_tree_grant_permissions'
+	);
+
+	insert into category_tree_translations
+	    (tree_id, locale, name, description)
+	values
+	    (v_tree_id, locale, tree_name, description);
+
+	return v_tree_id;
+    END new;
+
+
+    PROCEDURE new_translation (
+        tree_id		     in category_trees.tree_id%TYPE,
+	locale		     in category_tree_translations.locale%TYPE,
+	tree_name	     in category_tree_translations.name%TYPE,
+	description	     in category_tree_translations.description%TYPE,
+	modifying_date       in acs_objects.last_modified%TYPE		 default sysdate,
+	modifying_user       in acs_objects.creation_user%TYPE		 default null,
+	modifying_ip         in acs_objects.creation_ip%TYPE		 default null
+    ) IS
+    BEGIN
+	insert into category_tree_translations
+	    (tree_id, locale, name, description)
+	values
+	    (tree_id, locale, tree_name, description);
+
+	update acs_objects
+	set last_modified = new_translation.modifying_date,
+	    modifying_user = new_translation.modifying_user,
+	    modifying_ip = new_translation.modifying_ip
+	where object_id = new_translation.tree_id;
+    END new_translation;
+
+
+    PROCEDURE del ( 
+	tree_id         in category_trees.tree_id%TYPE 
+    ) 
+    IS
+    BEGIN 
+       delete from category_tree_map where tree_id = category_tree.del.tree_id;
+
+       delete from category_object_map where category_id in (select category_id from categories where tree_id = category_tree.del.tree_id);
+
+       delete from category_translations where category_id in (select category_id from categories where tree_id = category_tree.del.tree_id);
+ 
+       delete from categories where tree_id = category_tree.del.tree_id;
+ 
+       delete from acs_objects where context_id = category_tree.del.tree_id;
+
+       delete from acs_permissions where object_id = category_tree.del.tree_id;
+
+       delete from category_tree_translations where tree_id  = category_tree.del.tree_id;
+       delete from category_trees where tree_id  = category_tree.del.tree_id;
+ 
+       acs_object.delete(category_tree.del.tree_id);
+    END del;
+
+
+    PROCEDURE edit (
+        tree_id		     in category_trees.tree_id%TYPE		 default null,
+	locale		     in category_tree_translations.locale%TYPE,
+	tree_name	     in category_tree_translations.name%TYPE,
+	description	     in category_tree_translations.description%TYPE,
+        site_wide_p          in category_trees.site_wide_p%TYPE		 default 'f',
+	modifying_date       in acs_objects.last_modified%TYPE		 default sysdate,
+	modifying_user       in acs_objects.creation_user%TYPE		 default null,
+	modifying_ip         in acs_objects.creation_ip%TYPE		 default null
+    ) is
+    BEGIN
+	update category_trees
+	set site_wide_p = edit.site_wide_p
+	where tree_id = edit.tree_id;
+
+	update category_tree_translations
+	set name = edit.tree_name,
+	    description = edit.description
+	where tree_id = edit.tree_id
+	and locale = edit.locale;
+
+	update acs_objects
+	set last_modified = edit.modifying_date,
+	    modifying_user = edit.modifying_user,
+	    modifying_ip = edit.modifying_ip
+	where object_id = edit.tree_id;
+    END edit;
+
+
+    PROCEDURE copy (
+	source_tree           in category_trees.tree_id%TYPE,
+	dest_tree             in category_trees.tree_id%TYPE,
+	creation_user         in acs_objects.creation_user%TYPE		default null, 
+	creation_ip           in acs_objects.creation_ip%TYPE		default null
+    ) IS 
+	v_new_left_ind	categories.left_ind%TYPE;
+	v_category_id	categories.category_id%TYPE;
+    BEGIN
+	select nvl(max(right_ind),0) into v_new_left_ind 
+	from categories
+	where tree_id = copy.dest_tree;
+
+	for source in (select category_id, parent_id, left_ind, right_ind from categories where tree_id = copy.source_tree) loop
+
+	   v_category_id := acs_object.new ( 
+		object_type   => 'category', 
+		creation_date => sysdate,
+		creation_user => copy.creation_user,
+		creation_ip   => copy.creation_ip,
+	  	context_id    => copy.dest_tree
+	   );
+
+	   insert into categories
+	   (category_id, tree_id, parent_id, left_ind, right_ind)
+	   values
+	   (v_category_id, copy.dest_tree, source.parent_id, source.left_ind + v_new_left_ind, source.right_ind + v_new_left_ind);
+	end loop;
+
+	-- correct parent_ids
+	update categories c
+	set parent_id = (select t.category_id
+			from categories s, categories t
+			where s.category_id = c.parent_id
+			and t.tree_id = copy.dest_tree
+			and s.left_ind + v_new_left_ind = t.left_ind)
+	where tree_id = copy.dest_tree;
+
+	-- copy all translations
+	insert into category_translations
+	(category_id, locale, name, description)
+	(select ct.category_id, t.locale, t.name, t.description
+	from category_translations t, categories cs, categories ct
+	where ct.tree_id = copy.dest_tree
+	and cs.tree_id = copy.source_tree
+	and cs.left_ind + v_new_left_ind = ct.left_ind
+	and t.category_id = cs.category_id);
+
+	-- for debugging reasons
+	check_nested_ind(dest_tree);
+    END copy;
+
+
+    PROCEDURE map (
+	object_id		in acs_objects.object_id%TYPE,
+	tree_id			in category_trees.tree_id%TYPE,
+	subtree_category_id	in categories.category_id%TYPE		default null
+    ) is
+	v_map_count integer;
+    BEGIN
+	select count(*) 
+	into v_map_count
+	from category_tree_map
+	where object_id = map.object_id
+	and tree_id = map.tree_id;
+
+	if v_map_count = 0 then
+	   insert into category_tree_map
+	   (tree_id, subtree_category_id, object_id)
+	   values (map.tree_id, map.subtree_category_id, map.object_id);
+	end if;
+
+    END map;
+
+
+    PROCEDURE unmap (
+	object_id in acs_objects.object_id%TYPE,
+	tree_id   in category_trees.tree_id%TYPE
+    ) IS
+    BEGIN
+	delete from category_tree_map
+	where object_id = unmap.object_id
+	and tree_id = unmap.tree_id;
+    END unmap;
+
+
+    FUNCTION name (
+	tree_id	in category_trees.tree_id%TYPE
+    ) return varchar2
+    IS
+	v_name	category_tree_translations.name%TYPE;
+    BEGIN
+	select name into v_name
+	from category_tree_translations
+	where tree_id = name.tree_id
+	and locale = 'en_US';
+
+	return v_name;
+    END name;
+
+
+    PROCEDURE check_nested_ind (
+	tree_id in category_trees.tree_id%TYPE
+    )
+    IS
+	v_negative number;
+	v_order number;
+	v_parent number;
+    BEGIN
+        select count(*) into v_negative from categories
+	where tree_id = check_nested_ind.tree_id and (left_ind < 1 or right_ind < 1);
+
+	if v_negative>0 then raise_application_error (-20001,'Negative Index not allowed!'); end if;
+
+        select count(*) into v_order from categories
+	where tree_id = check_nested_ind.tree_id
+	and left_ind >= right_ind;
+	
+	if v_order>0 then raise_application_error (-20002,'Right Index must be greater than left Index!'); end if;
+
+        select count(*) into v_parent
+	from categories parent, categories child
+		where parent.tree_id = check_nested_ind.tree_id
+		and child.tree_id = parent.tree_id
+		and (parent.left_ind >= child.left_ind or parent.right_ind <= child.right_ind)
+		and child.parent_id = parent.category_id;
+
+	if v_parent>0 then raise_application_error (-20003,'Child Index must be between parent Index!'); end if;
+    END check_nested_ind;
+
+
+    PROCEDURE refresh_nested_ind (
+	tree_id in category_trees.tree_id%TYPE
+    )
+    IS
+	v_left_ind	categories.left_ind%TYPE;
+	v_right_ind	categories.right_ind%TYPE;
+    BEGIN
+	v_left_ind := 1;
+	for top_nodes in (select category_id
+			  from categories
+			  where tree_id = refresh_nested_ind.tree_id
+			  and parent_id is null) loop
+		v_right_ind := index_childs(top_nodes.category_id, v_left_ind);
+
+		update categories
+		set left_ind = v_left_ind,
+		right_ind = v_right_ind + 1
+		where category_id = top_nodes.category_id;
+
+		v_left_ind := v_right_ind + 2;
+	end loop;
+    END refresh_nested_ind;
+
+    ---------------------------------------------------------------------
+
+    FUNCTION index_childs(p_parent_id integer, ind integer) return integer 
+    IS
+	TYPE type_categories IS TABLE OF integer;
+	nodes type_categories := type_categories();
+	TYPE type_cursor IS REF CURSOR ;
+	cc type_cursor;
+	i integer := 0;
+	v_category_id integer;
+	v_ind integer := ind;
+	v_left_ind integer;
+    BEGIN
+	open cc for 'select category_id from categories where parent_id = :p_parent_id ' using p_parent_id;
+	loop	    
+	    fetch cc into v_category_id;
+	    exit when cc%NOTFOUND;
+	    i := i + 1; 
+	    nodes.extend;
+	    nodes(i) := v_category_id;
+	end loop;
+	close cc;
+	if i > 0 then
+	   for j in 1..i loop
+	        v_ind := v_ind + 1;
+	        v_left_ind := v_ind;
+	        v_ind:= index_childs(nodes(j), v_ind);
+	        v_ind := v_ind + 1;
+		update categories set left_ind = v_left_ind, right_ind = v_ind where category_id = nodes(j);
+	   end loop;
+	end if;
+	return v_ind;
+    END index_childs;
+
+end category_tree;
+/
+show errors
Index: openacs-4/packages/categories/tcl/categories-init.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/tcl/categories-init.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/tcl/categories-init.tcl	23 Apr 2003 12:29:26 -0000	1.1
@@ -0,0 +1,12 @@
+ad_library {
+    Procs for the site-wide categorization package.
+
+    @author Timo Hentschel (thentschel@sussdorff-roy.com)
+
+    @creation-date 16 April 2003
+    @cvs-id $Id:
+}
+
+category::reset_translation_cache
+category_tree::reset_translation_cache
+category_tree::reset_cache
Index: openacs-4/packages/categories/tcl/categories-procs-oracle.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/tcl/categories-procs-oracle.xql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/tcl/categories-procs-oracle.xql	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,135 @@
+<?xml version="1.0"?>
+
+<queryset>
+   <rdbms><type>oracle</type><version>8.1.6</version></rdbms>
+
+<fullquery name="add.insert_category">      
+      <querytext>
+      
+		begin
+		:1 := category.new (
+				    category_id   => :category_id,
+				    locale        => :locale,
+				    name          => :name,
+				    description   => :description,
+				    tree_id       => :tree_id,
+				    parent_id     => :parent_id,
+				    creation_user => :user_id,
+				    creation_ip   => :creation_ip
+				    );
+		end;
+	    
+      </querytext>
+</fullquery>
+
+ 
+<fullquery name="add.insert_default_category">      
+      <querytext>
+      
+		    begin
+		    category.new_translation (
+					      category_id    => :category_id,
+					      locale         => :default_locale,
+					      name           => :name,
+					      description    => :description,
+					      modifying_user => :user_id,
+					      modifying_ip   => :creation_ip
+					      );
+		    end;
+		
+      </querytext>
+</fullquery>
+
+ 
+<fullquery name="update.insert_category_translation">      
+      <querytext>
+      
+		    begin
+		    category.new_translation (
+					      category_id    => :category_id,
+					      locale         => :locale,
+					      name           => :name,
+					      description    => :description,
+					      modifying_user => :user_id,
+					      modifying_ip   => :modifying_ip
+					      );
+		    end;
+		
+      </querytext>
+</fullquery>
+
+ 
+<fullquery name="update.update_category_translation">      
+      <querytext>
+      
+		    begin
+		    category.edit (
+				   category_id    => :category_id,
+				   locale         => :locale,
+				   name           => :name,
+				   description    => :description,
+				   modifying_user => :user_id,
+				   modifying_ip   => :modifying_ip
+				   );
+		    end;
+		
+      </querytext>
+</fullquery>
+
+ 
+<fullquery name="delete.delete_category">      
+      <querytext>
+      
+	    begin
+	    category.del ( :category_id );
+	    end;
+	
+      </querytext>
+</fullquery>
+
+ 
+<fullquery name="change_parent.change_parent_category">      
+      <querytext>
+      
+	    begin
+	    category.change_parent (
+				    category_id  => :category_id,
+				    tree_id      => :tree_id,
+				    parent_id    => :parent_id
+				    );
+	    end;
+	
+      </querytext>
+</fullquery>
+
+ 
+<fullquery name="phase_in.phase_in">      
+      <querytext>
+      
+	    begin
+	    category.phase_in(:category_id);
+	    end;
+	
+      </querytext>
+</fullquery>
+
+ 
+<fullquery name="phase_out.phase_out">      
+      <querytext>
+      
+	    begin
+	    category.phase_out(:category_id);
+	    end;
+	
+      </querytext>
+</fullquery>
+
+ 
+<fullquery name="get_object_context.object_name">      
+      <querytext>
+      select acs_object.name(:object_id) from dual
+      </querytext>
+</fullquery>
+
+ 
+</queryset>
Index: openacs-4/packages/categories/tcl/categories-procs-postgresql.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/tcl/categories-procs-postgresql.xql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/tcl/categories-procs-postgresql.xql	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,151 @@
+<?xml version="1.0"?>
+
+<queryset>
+   <rdbms><type>postgresql</type><version>7.1</version></rdbms>
+
+<fullquery name="add.insert_category">      
+      <querytext>
+      FIX ME PLSQL
+FIX ME PLSQL
+
+		begin
+		:1 := category__new (
+				    category_id   => :category_id,
+				    locale        => :locale,
+				    name          => :name,
+				    description   => :description,
+				    tree_id       => :tree_id,
+				    parent_id     => :parent_id,
+				    creation_user => :user_id,
+				    creation_ip   => :creation_ip
+				    );
+		end;
+	    
+      </querytext>
+</fullquery>
+
+ 
+<fullquery name="add.insert_default_category">      
+      <querytext>
+      FIX ME PLSQL
+FIX ME PLSQL
+
+		    begin
+		    category__new_translation (
+					      category_id    => :category_id,
+					      locale         => :default_locale,
+					      name           => :name,
+					      description    => :description,
+					      modifying_user => :user_id,
+					      modifying_ip   => :creation_ip
+					      );
+		    end;
+		
+      </querytext>
+</fullquery>
+
+ 
+<fullquery name="update.insert_category_translation">      
+      <querytext>
+      FIX ME PLSQL
+FIX ME PLSQL
+
+		    begin
+		    category__new_translation (
+					      category_id    => :category_id,
+					      locale         => :locale,
+					      name           => :name,
+					      description    => :description,
+					      modifying_user => :user_id,
+					      modifying_ip   => :modifying_ip
+					      );
+		    end;
+		
+      </querytext>
+</fullquery>
+
+ 
+<fullquery name="update.update_category_translation">      
+      <querytext>
+      FIX ME PLSQL
+FIX ME PLSQL
+
+		    begin
+		    category__edit (
+				   category_id    => :category_id,
+				   locale         => :locale,
+				   name           => :name,
+				   description    => :description,
+				   modifying_user => :user_id,
+				   modifying_ip   => :modifying_ip
+				   );
+		    end;
+		
+      </querytext>
+</fullquery>
+
+ 
+<fullquery name="delete.delete_category">      
+      <querytext>
+      FIX ME PLSQL
+FIX ME PLSQL
+
+	    begin
+	    category__del ( :category_id );
+	    end;
+	
+      </querytext>
+</fullquery>
+
+ 
+<fullquery name="change_parent.change_parent_category">      
+      <querytext>
+      FIX ME PLSQL
+FIX ME PLSQL
+
+	    begin
+	    category__change_parent (
+				    category_id  => :category_id,
+				    tree_id      => :tree_id,
+				    parent_id    => :parent_id
+				    );
+	    end;
+	
+      </querytext>
+</fullquery>
+
+ 
+<fullquery name="phase_in.phase_in">      
+      <querytext>
+      FIX ME PLSQL
+FIX ME PLSQL
+
+	    begin
+	    category__phase_in(:category_id);
+	    end;
+	
+      </querytext>
+</fullquery>
+
+ 
+<fullquery name="phase_out.phase_out">      
+      <querytext>
+      FIX ME PLSQL
+FIX ME PLSQL
+
+	    begin
+	    category__phase_out(:category_id);
+	    end;
+	
+      </querytext>
+</fullquery>
+
+ 
+<fullquery name="get_object_context.object_name">      
+      <querytext>
+      select acs_object__name(:object_id) 
+      </querytext>
+</fullquery>
+
+ 
+</queryset>
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
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/tcl/categories-procs.tcl	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,421 @@
+ad_library {
+    Procs for the site-wide categorization package.
+
+    @author Timo Hentschel (thentschel@sussdorff-roy.com)
+
+    @creation-date 16 April 2003
+    @cvs-id $Id:
+}
+
+
+namespace eval category {
+
+    ad_proc -public add {
+	{-category_id ""}
+	-tree_id:required
+	-parent_id:required
+	-name:required
+	{-locale ""}
+	{-description ""}
+	{-user_id ""}
+	{-creation_ip ""}
+    } {
+	Insert a new category. The same translation will be added in the default
+	language if it's in a different language.
+
+	@option category_id category_id of the category to be inserted.
+	@option locale locale of the language. [ad_conn locale] used by default.
+	@option name category name.
+	@option description description of the category.
+	@option tree_id tree_id of the category the category should be added.
+	@option parent_id id of the parent category. "" if top level category.
+	@option user_id user that adds the category. [ad_conn user_id] used by default.
+	@option creation_ip ip-address of the user that adds the category. [ad_conn peeraddr] used by default.
+	@returns category_id
+	@author Timo Hentschel (thentschel@sussdorff-roy.com)
+    } {
+	if {[empty_string_p $user_id]} {
+	    set user_id [ad_conn user_id]
+	}
+	if {[empty_string_p $creation_ip]} {
+	    set creation_ip [ad_conn peeraddr]
+	}
+	if {[empty_string_p $locale]} {
+	    set locale [ad_conn locale]
+	}
+	db_transaction {
+	    set category_id [db_exec_plsql insert_category {
+		begin
+		:1 := category.new (
+				    category_id   => :category_id,
+				    locale        => :locale,
+				    name          => :name,
+				    description   => :description,
+				    tree_id       => :tree_id,
+				    parent_id     => :parent_id,
+				    creation_user => :user_id,
+				    creation_ip   => :creation_ip
+				    );
+		end;
+	    }]
+	    set default_locale [ad_parameter DefaultLocale acs-lang "en_US"]
+	    if {$locale != $default_locale} {
+		db_exec_plsql insert_default_category {
+		    begin
+		    category.new_translation (
+					      category_id    => :category_id,
+					      locale         => :default_locale,
+					      name           => :name,
+					      description    => :description,
+					      modifying_user => :user_id,
+					      modifying_ip   => :creation_ip
+					      );
+		    end;
+		}
+	    }
+	    category_tree::flush_cache $tree_id
+	    flush_translation_cache $category_id
+	}
+	return $category_id
+    }
+
+    ad_proc -public update {
+	-category_id:required
+	-name:required
+	{-locale ""}
+	{-description ""}
+	{-user_id ""}
+	{-modifying_ip ""}
+    } {
+	Updates/inserts a category translation.
+
+	@option category_id category_id of the category to be updated.
+	@option locale locale of the language. [ad_conn locale] used by default.
+	@option name category name.
+	@option description description of the category.
+	@option user_id user that updates the category. [ad_conn user_id] used by default.
+	@option modifying_ip ip-address of the user that updates the category. [ad_conn peeraddr] used by default.
+	@author Timo Hentschel (thentschel@sussdorff-roy.com)
+    } {
+	if {[empty_string_p $user_id]} {
+	    set user_id [ad_conn user_id]
+	}
+	if {[empty_string_p $modifying_ip]} {
+	    set modifying_ip [ad_conn peeraddr]
+	}
+	if {[empty_string_p $locale]} {
+	    set locale [ad_conn locale]
+	}
+	db_transaction {
+	    if {![db_0or1row check_category_existence {
+		select 1
+		from category_translations
+		where category_id = :category_id
+		and locale = :locale
+	    }]} {
+		db_exec_plsql insert_category_translation {
+		    begin
+		    category.new_translation (
+					      category_id    => :category_id,
+					      locale         => :locale,
+					      name           => :name,
+					      description    => :description,
+					      modifying_user => :user_id,
+					      modifying_ip   => :modifying_ip
+					      );
+		    end;
+		}
+	    } else {
+		db_exec_plsql update_category_translation {
+		    begin
+		    category.edit (
+				   category_id    => :category_id,
+				   locale         => :locale,
+				   name           => :name,
+				   description    => :description,
+				   modifying_user => :user_id,
+				   modifying_ip   => :modifying_ip
+				   );
+		    end;
+		}
+	    }
+	    flush_translation_cache $category_id
+	}
+    }
+
+    ad_proc -public delete {
+	-batch_mode:boolean
+	category_id
+    } {
+	Deletes a category.
+	category_tree:flush_cache should be used afterwards.
+
+	@option batch_mode Indicates that the cache for category translations
+	                   should not be flushed. Useful when deleting several
+	                   categories at once.
+	                   Don't forget to call reset_translation_cache
+	@param category_id category_id of the category to be deleted.
+	@see category::reset_translation_cache
+	@see category_tree::flush_cache
+	@author Timo Hentschel (thentschel@sussdorff-roy.com)
+    } {
+	db_exec_plsql delete_category {
+	    begin
+	    category.del ( :category_id );
+	    end;
+	}
+	if {!$batch_mode_p} {
+	    flush_translation_cache $category_id
+	}
+    }
+
+    ad_proc -public change_parent {
+	-category_id:required
+	-tree_id:required
+	{-parent_id [db_null]}
+    } {
+	Changes parent category of a category.
+	@option category_id category_id whose parent should change.
+	@option tree_id tree_id of the category tree.
+	@option parent_id new parent category_id.
+	@author Timo Hentschel (thentschel@sussdorff-roy.com)
+    } {
+	db_exec_plsql change_parent_category {
+	    begin
+	    category.change_parent (
+				    category_id  => :category_id,
+				    tree_id      => :tree_id,
+				    parent_id    => :parent_id
+				    );
+	    end;
+	}
+	category_tree::flush_cache $tree_id
+    }
+
+    ad_proc -public phase_in { category_id } {
+	Marks a category to be visible for categorizing new objects /
+	update existing objects.
+	Make sure to use category_tree::flush_cache afterwards.
+
+	@param category_id category_id of the category to be phased in
+	@see category::phase_out
+	@see category_tree::flush_cache
+	@author Timo Hentschel (thentschel@sussdorff-roy.com)
+    } {
+	db_exec_plsql phase_in {
+	    begin
+	    category.phase_in(:category_id);
+	    end;
+	}
+    }
+
+    ad_proc -public phase_out { category_id } {
+	Marks a category to be phasing out. That means this category and
+	all its subcategories will no longer appear in the categorization
+	widget to categorize new objects / update existing objects,
+	but all existing categorizations will still remain valid.
+	Make sure to use category_tree::flush_cache afterwards.
+
+	@param category_id category_id of the category to be phased out
+	@see category::phase_in
+	@see category_tree::flush_cache
+	@author Timo Hentschel (thentschel@sussdorff-roy.com)
+    } {
+	db_exec_plsql phase_out {
+	    begin
+	    category.phase_out(:category_id);
+	    end;
+	}
+    }
+
+    ad_proc -public map_object {
+	{-remove_old:boolean}
+	-object_id:required
+	category_id_list
+    } {
+	Map an object to several categories.
+
+	@option remove_old Modifier to be used when categorizing existing objects. Will make sure to delete all old categorizations.
+	@option object_id object to be categorized.
+	@param category_id_list tcl-list of category_ids to be mapped to the object.
+	@author Timo Hentschel (thentschel@sussdorff-roy.com)
+    } {
+	db_transaction {
+	    # Remove any already mapped categories if we are updating
+	    if { $remove_old_p } {
+		db_dml remove_mapped_categories {
+		    delete from category_object_map
+		    where object_id = :object_id
+		}
+	    }
+
+	    foreach category_id $category_id_list {
+		if ![empty_string_p $category_id] {
+		    db_dml insert_mapped_categories {
+			insert into category_object_map (category_id, object_id)
+			values (:category_id, :object_id)
+		    }
+		}
+	    }
+	}
+    }
+
+    ad_proc -public get_mapped_categories { object_id } {
+	Gets the list of categories mapped to an object.
+
+	@param object_id object of which we want to know the mapped categories.
+	@return tcl-list of category_ids
+	@author Timo Hentschel (thentschel@sussdorff-roy.com)
+    } {
+	set result [db_list get_mapped_categories {
+	    select category_id
+	    from category_object_map
+	    where object_id = :object_id
+	}]
+
+	return $result
+    }
+
+    ad_proc -public reset_translation_cache { } {
+	Reloads all category translations in the cache.
+	@author Timo Hentschel (thentschel@sussdorff-roy.com)
+    } {
+	catch {nsv_unset categories}
+	set category_id_old 0
+	db_foreach reset_translation_cache {
+	    select category_id, locale, name
+	    from category_translations
+	    order by category_id, locale
+	} {
+	    if {$category_id != $category_id_old && $category_id_old != 0} {
+		nsv_set categories $category_id_old [array get cat_lang]
+		unset cat_lang
+	    }
+	    set category_id_old $category_id
+	    set cat_lang($locale) $name
+	}
+	if {$category_id_old != 0} {
+	    nsv_set categories $category_id [array get cat_lang]
+	}
+    }
+
+    ad_proc -public flush_translation_cache { category_id } {
+	Flushes category translation cache of one category.
+
+	@param category_id category to be flushed.
+	@author Timo Hentschel (thentschel@sussdorff-roy.com)
+    } {
+	db_foreach flush_translation_cache {
+	    select locale, name
+	    from category_translations
+	    where category_id = :category_id
+	    order by locale
+	} {
+	    set cat_lang($locale) $name
+	}
+	if {[info exists cat_lang]} {
+	    nsv_set categories $category_id [array get cat_lang]
+	} else {
+	    nsv_set categories $category_id ""
+	}
+    }
+
+    ad_proc -public get_name {
+	category_id
+	{locale ""}
+    } {
+	Gets the category name in the specified language, if available.
+	Use default language otherwise.
+
+	@param category_id category of which to get the name.
+	@param locale language in which to get the name. [ad_conn locale] used by default.
+	@author Timo Hentschel (thentschel@sussdorff-roy.com)
+    } {
+	if {[empty_string_p $locale]} {
+	    set locale [ad_conn locale]
+	}
+	if {[catch {array set cat_lang [nsv_get categories $category_id]}]} {
+	    return
+	}
+	if {![catch {set name $cat_lang($locale)}]} {
+	    # exact match: found name for this locale
+	    return $name
+	}
+	if {![catch {set name $cat_lang([ad_parameter DefaultLocale acs-lang "en_US"])}]} {
+	    # default locale found
+	    return $name
+	}
+	# tried default locale, but nothing found
+	return
+    }
+
+    ad_proc -public get_object_context { object_id } {
+	Returns the object name and url to be used in a context bar.
+
+	@param object_id object_id to get the name of.
+	@author Timo Hentschel (thentschel@sussdorff-roy.com)
+    } {
+	set object_name [db_string object_name "select acs_object.name(:object_id) from dual"]
+	return [list "/o/$object_id" $object_name]
+    }
+
+    ad_proc repeat_string { string iteration_number } {
+	Repeat a string a given number of times.
+
+	@param string string to be repeated.
+	@param iteration_number number of times the string should be repeated.
+	@author Timo Hentschel (thentschel@sussdorff-roy.com)
+    } {
+	if { $iteration_number <= 0} {
+	    return ""
+	} 
+
+	set return_string ""
+	for { set i 0 } { $i < $iteration_number } { incr i } {
+	    append return_string $string
+	}
+
+	return $return_string
+    }
+
+    ad_proc pageurl { object_id } {
+	Returns the page that displays a category.
+	To be used by the AcsObject.PageUrl service contract.
+
+	@param object_id category to be displayed.
+	@author Timo Hentschel (thentschel@sussdorff-roy.com)
+    } {
+	db_1row get_tree_id_for_pageurl {
+	    select tree_id
+	    from categories
+	    where category_id = :object_id
+	}
+	return "categories-browse?tree_ids=$tree_id&category_ids=$object_id"
+    }
+
+    ad_proc -private after_install {} {
+	Callback to be called after package installation.
+	Adds the service contract implementations.
+
+	@author Timo Hentschel (thentschel@sussdorff-roy.com)
+    } {
+	acs_sc::impl::new -contract_name AcsObject -name category_idhandler -owner categories
+	acs_sc::impl::alias::new -contract_name AcsObject -impl_name category_idhandler -operation PageUrl -alias category::pageurl
+	acs_sc::impl::binding::new -contract_name AcsObject -impl_name category_idhandler
+
+	acs_sc::impl::new -contract_name AcsObject -name category_tree_idhandler -owner categories
+	acs_sc::impl::alias::new -contract_name AcsObject -impl_name category_tree_idhandler -operation PageUrl -alias category_tree::pageurl
+	acs_sc::impl::binding::new -contract_name AcsObject -impl_name category_tree_idhandler
+    }
+
+    ad_proc -private before_uninstall {} {
+	Callback to be called before package uninstallation.
+	Removes the service contract implementations.
+
+	@author Timo Hentschel (thentschel@sussdorff-roy.com)
+    } {
+	# shouldn't we first delete the bindings?
+	acs_sc::impl::delete -contract_name AcsObject -impl_name category_idhandler
+	acs_sc::impl::delete -contract_name AcsObject -impl_name category_tree_idhandler
+    }
+}
Index: openacs-4/packages/categories/tcl/categories-procs.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/tcl/Attic/categories-procs.xql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/tcl/categories-procs.xql	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,81 @@
+<?xml version="1.0"?>
+<queryset>
+
+<fullquery name="update.check_category_existence">      
+      <querytext>
+      
+		select 1
+		from category_translations
+		where category_id = :category_id
+		and locale = :locale
+	    
+      </querytext>
+</fullquery>
+
+ 
+<fullquery name="map_object.remove_mapped_categories">      
+      <querytext>
+      
+		    delete from category_object_map
+		    where object_id = :object_id
+		
+      </querytext>
+</fullquery>
+
+ 
+<fullquery name="map_object.insert_mapped_categories">      
+      <querytext>
+      
+			insert into category_object_map (category_id, object_id)
+			values (:category_id, :object_id)
+		    
+      </querytext>
+</fullquery>
+
+ 
+<fullquery name="get_mapped_categories.get_mapped_categories">      
+      <querytext>
+      
+	    select category_id
+	    from category_object_map
+	    where object_id = :object_id
+	
+      </querytext>
+</fullquery>
+
+ 
+<fullquery name="reset_translation_cache.reset_translation_cache">      
+      <querytext>
+      
+	    select category_id, locale, name
+	    from category_translations
+	    order by category_id, locale
+	
+      </querytext>
+</fullquery>
+
+ 
+<fullquery name="flush_translation_cache.flush_translation_cache">      
+      <querytext>
+      
+	    select locale, name
+	    from category_translations
+	    where category_id = :category_id
+	    order by locale
+	
+      </querytext>
+</fullquery>
+
+ 
+<fullquery name="pageurl.get_tree_id_for_pageurl">      
+      <querytext>
+      
+	    select tree_id
+	    from categories
+	    where category_id = :object_id
+	
+      </querytext>
+</fullquery>
+
+ 
+</queryset>
Index: openacs-4/packages/categories/tcl/category-trees-procs-oracle.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/tcl/category-trees-procs-oracle.xql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/tcl/category-trees-procs-oracle.xql	23 Apr 2003 12:29:26 -0000	1.1
@@ -0,0 +1,148 @@
+<?xml version="1.0"?>
+
+<queryset>
+   <rdbms><type>oracle</type><version>8.1.6</version></rdbms>
+
+<fullquery name="map.map_tree">      
+      <querytext>
+      
+	    begin
+	    category_tree.map(
+			      object_id           => :object_id,
+			      subtree_category_id => :subtree_category_id,
+			      tree_id             => :tree_id);
+	    end;
+	
+      </querytext>
+</fullquery>
+
+ 
+<fullquery name="unmap.unmap_tree">      
+      <querytext>
+      
+	    begin
+	    category_tree.unmap(
+				object_id => :object_id,
+				tree_id   => :tree_id);
+	    end;
+	
+      </querytext>
+</fullquery>
+
+ 
+<fullquery name="copy.copy_tree">      
+      <querytext>
+      
+	    begin
+	    category_tree.copy(
+			       source_tree         => :source_tree,
+			       dest_tree           => :dest_tree
+			       );
+	    end;
+	
+      </querytext>
+</fullquery>
+
+ 
+<fullquery name="add.insert_tree">      
+      <querytext>
+      
+		begin
+		:1 := category_tree.new (
+					 tree_id       => :tree_id,
+					 tree_name     => :name,
+					 description   => :description,
+					 locale        => :locale,
+					 creation_user => :user_id,
+					 creation_ip   => :creation_ip,
+					 context_id    => :context_id
+					 );
+		end;
+	    
+      </querytext>
+</fullquery>
+
+ 
+<fullquery name="add.insert_default_tree">      
+      <querytext>
+      
+		    begin
+		    category_tree.new_translation (
+						   tree_id        => :tree_id,
+						   tree_name      => :name,
+						   description    => :description,
+						   locale         => :default_locale,
+						   modifying_user => :user_id,
+						   modifying_ip   => :creation_ip
+						   );
+		    end;
+		
+      </querytext>
+</fullquery>
+
+ 
+<fullquery name="update.insert_tree_translation">      
+      <querytext>
+      
+		    begin
+		    category_tree.new_translation (
+						   tree_id        => :tree_id,
+						   tree_name      => :name,
+						   description    => :description,
+						   locale         => :locale,
+						   modifying_user => :user_id,
+						   modifying_ip   => :modifying_ip
+						   );
+		    end;
+		
+      </querytext>
+</fullquery>
+
+ 
+<fullquery name="update.update_tree_translation">      
+      <querytext>
+      
+		    begin
+		    category_tree.edit (
+					tree_id        => :tree_id,
+					tree_name      => :name,
+					description    => :description,
+					locale         => :locale,
+					modifying_user => :user_id,
+					modifying_ip   => :modifying_ip
+					);
+		    end;
+		
+      </querytext>
+</fullquery>
+
+ 
+<fullquery name="delete.delete_tree">      
+      <querytext>
+      
+	    begin
+	    category_tree.del ( :tree_id );
+	    end;
+	
+      </querytext>
+</fullquery>
+
+ 
+<fullquery name="usage.category_tree_usage">      
+      <querytext>
+      
+	    select t.pretty_plural, n.object_id, n.object_name, p.package_id,
+	           p.instance_name,
+	           acs_permission.permission_p(n.object_id, :user_id, 'read') as read_p
+	    from category_tree_map m, acs_named_objects n,
+	         apm_packages p, apm_package_types t
+	    where m.tree_id = :tree_id
+	    and n.object_id = m.object_id
+	    and p.package_id = n.package_id
+	    and t.package_key = p.package_key
+	
+      </querytext>
+</fullquery>
+
+ 
+</queryset>
Index: openacs-4/packages/categories/tcl/category-trees-procs-postgresql.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/tcl/category-trees-procs-postgresql.xql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/tcl/category-trees-procs-postgresql.xql	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,164 @@
+<?xml version="1.0"?>
+
+<queryset>
+   <rdbms><type>postgresql</type><version>7.1</version></rdbms>
+
+<fullquery name="map.map_tree">      
+      <querytext>
+      FIX ME PLSQL
+FIX ME PLSQL
+
+	    begin
+	    category_tree__map(
+			      object_id           => :object_id,
+			      subtree_category_id => :subtree_category_id,
+			      tree_id             => :tree_id);
+	    end;
+	
+      </querytext>
+</fullquery>
+
+ 
+<fullquery name="unmap.unmap_tree">      
+      <querytext>
+      FIX ME PLSQL
+FIX ME PLSQL
+
+	    begin
+	    category_tree__unmap(
+				object_id => :object_id,
+				tree_id   => :tree_id);
+	    end;
+	
+      </querytext>
+</fullquery>
+
+ 
+<fullquery name="copy.copy_tree">      
+      <querytext>
+      FIX ME PLSQL
+FIX ME PLSQL
+
+	    begin
+	    category_tree__copy(
+			       source_tree         => :source_tree,
+			       dest_tree           => :dest_tree
+			       );
+	    end;
+	
+      </querytext>
+</fullquery>
+
+ 
+<fullquery name="add.insert_tree">      
+      <querytext>
+      FIX ME PLSQL
+FIX ME PLSQL
+
+		begin
+		:1 := category_tree__new (
+					 tree_id       => :tree_id,
+					 tree_name     => :name,
+					 description   => :description,
+					 locale        => :locale,
+					 creation_user => :user_id,
+					 creation_ip   => :creation_ip,
+					 context_id    => :context_id
+					 );
+		end;
+	    
+      </querytext>
+</fullquery>
+
+ 
+<fullquery name="add.insert_default_tree">      
+      <querytext>
+      FIX ME PLSQL
+FIX ME PLSQL
+
+		    begin
+		    category_tree__new_translation (
+						   tree_id        => :tree_id,
+						   tree_name      => :name,
+						   description    => :description,
+						   locale         => :default_locale,
+						   modifying_user => :user_id,
+						   modifying_ip   => :creation_ip
+						   );
+		    end;
+		
+      </querytext>
+</fullquery>
+
+ 
+<fullquery name="update.insert_tree_translation">      
+      <querytext>
+      FIX ME PLSQL
+FIX ME PLSQL
+
+		    begin
+		    category_tree__new_translation (
+						   tree_id        => :tree_id,
+						   tree_name      => :name,
+						   description    => :description,
+						   locale         => :locale,
+						   modifying_user => :user_id,
+						   modifying_ip   => :modifying_ip
+						   );
+		    end;
+		
+      </querytext>
+</fullquery>
+
+ 
+<fullquery name="update.update_tree_translation">      
+      <querytext>
+      FIX ME PLSQL
+FIX ME PLSQL
+
+		    begin
+		    category_tree__edit (
+					tree_id        => :tree_id,
+					tree_name      => :name,
+					description    => :description,
+					locale         => :locale,
+					modifying_user => :user_id,
+					modifying_ip   => :modifying_ip
+					);
+		    end;
+		
+      </querytext>
+</fullquery>
+
+ 
+<fullquery name="delete.delete_tree">      
+      <querytext>
+      FIX ME PLSQL
+FIX ME PLSQL
+
+	    begin
+	    category_tree__del ( :tree_id );
+	    end;
+	
+      </querytext>
+</fullquery>
+
+ 
+<fullquery name="usage.category_tree_usage">      
+      <querytext>
+      
+	    select t.pretty_plural, n.object_id, n.object_name, p.package_id,
+	           p.instance_name,
+	           acs_permission__permission_p(n.object_id, :user_id, 'read') as read_p
+	    from category_tree_map m, acs_named_objects n,
+	         apm_packages p, apm_package_types t
+	    where m.tree_id = :tree_id
+	    and n.object_id = m.object_id
+	    and p.package_id = n.package_id
+	    and t.package_key = p.package_key
+	
+      </querytext>
+</fullquery>
+
+ 
+</queryset>
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
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/tcl/category-trees-procs.tcl	23 Apr 2003 12:29:26 -0000	1.1
@@ -0,0 +1,518 @@
+ad_library {
+    Procs for the site-wide categorization package.
+
+    @author Timo Hentschel (thentschel@sussdorff-roy.com)
+
+    @creation-date 16 April 2003
+    @cvs-id $Id:
+}
+
+namespace eval category_tree {
+
+    ad_proc -public get_data {
+	tree_id
+	{locale ""}
+    } {
+	Get category tree name, description and other data.
+
+	@param tree_id category tree to get the data of.
+	@param locale language in which to get the name and description.
+	@return array: tree_name description site_wide_p
+	@author Timo Hentschel (thentschel@sussdorff-roy.com)
+    } {
+	db_1row get_tree_data {
+	    select site_wide_p
+	    from category_trees
+	    where tree_id = :tree_id
+	} -column_array tree
+
+	util_unlist [get_translation $tree_id $locale] tree(tree_name) tree(description)
+	return [array get tree]
+    }
+
+    ad_proc -public map {
+	-tree_id:required
+	-object_id:required
+	{-subtree_category_id ""}
+    } {
+	Map a category tree to a package (or other object).
+
+	@option tree_id category tree to be mapped.
+	@option object_id object to map the category tree to.
+	@option subtree_category_id category_id of the subtree to be mapped.
+	                            If not provided, the whole category tree will be mapped.
+	@author Timo Hentschel (thentschel@sussdorff-roy.com)
+    } {
+	db_exec_plsql map_tree {
+	    begin
+	    category_tree.map(
+			      object_id           => :object_id,
+			      subtree_category_id => :subtree_category_id,
+			      tree_id             => :tree_id);
+	    end;
+	}
+    }
+
+    ad_proc -public unmap {
+	-tree_id:required
+	-object_id:required
+    } {
+	Unmap a category tree from a package (or other object)
+	Note: This will not delete existing categorizations of objects.
+
+	@option tree_id category tree to be unmapped.
+	@option object_id object to unmap the category tree from.
+	@author Timo Hentschel (thentschel@sussdorff-roy.com)
+    } {
+	db_exec_plsql unmap_tree {
+	    begin
+	    category_tree.unmap(
+				object_id => :object_id,
+				tree_id   => :tree_id);
+	    end;
+	}
+    }
+
+    ad_proc -public copy {
+	-source_tree:required
+	-dest_tree:required
+    } {
+	Copies a category tree into another category tree.
+
+	@option source_tree tree_id of the category tree to copy.
+	@option dest_tree tree_id of the category tree to copy into.
+	@author Timo Hentschel (thentschel@sussdorff-roy.com)
+    } {
+	db_exec_plsql copy_tree {
+	    begin
+	    category_tree.copy(
+			       source_tree         => :source_tree,
+			       dest_tree           => :dest_tree
+			       );
+	    end;
+	}
+	flush_cache $dest_tree
+	flush_translation_cache $dest_tree
+	category::reset_translation_cache
+    }
+
+    ad_proc -public add {
+	{-tree_id ""}
+	-name:required
+	{-description ""}
+	{-locale ""}
+	{-user_id ""}
+	{-creation_ip ""}
+	{-context_id ""}
+    } {
+	Insert a new category tree. The same translation will be added in the default
+	language if it's in a different language.
+
+	@option tree_id tree_id of the category tree to be inserted.
+	@option locale locale of the language. [ad_conn locale] used by default.
+	@option name tree name.
+	@option description description of the category tree.
+	@option user_id user that adds the category tree. [ad_conn user_id] used by default.
+	@option creation_ip ip-address of the user that adds the category tree. [ad_conn peeraddr] used by default.
+	@option context_id context_id of the category tree. [ad_conn package_id] used by default.
+	@returns tree_id
+	@author Timo Hentschel (thentschel@sussdorff-roy.com)
+    } {
+	if {[empty_string_p $user_id]} {
+	    set user_id [ad_conn user_id]
+	}
+	if {[empty_string_p $creation_ip]} {
+	    set creation_ip [ad_conn peeraddr]
+	}
+	if {[empty_string_p $locale]} {
+	    set locale [ad_conn locale]
+	}
+	if {[empty_string_p $context_id]} {
+	    set context_id [ad_conn package_id]
+	}
+	db_transaction {
+	    set tree_id [db_exec_plsql insert_tree {
+		begin
+		:1 := category_tree.new (
+					 tree_id       => :tree_id,
+					 tree_name     => :name,
+					 description   => :description,
+					 locale        => :locale,
+					 creation_user => :user_id,
+					 creation_ip   => :creation_ip,
+					 context_id    => :context_id
+					 );
+		end;
+	    }]
+	    set default_locale [ad_parameter DefaultLocale acs-lang "en_US"]
+	    if {$locale != $default_locale} {
+		db_exec_plsql insert_default_tree {
+		    begin
+		    category_tree.new_translation (
+						   tree_id        => :tree_id,
+						   tree_name      => :name,
+						   description    => :description,
+						   locale         => :default_locale,
+						   modifying_user => :user_id,
+						   modifying_ip   => :creation_ip
+						   );
+		    end;
+		}
+	    }
+	}
+	flush_translation_cache $tree_id
+	return $tree_id
+    }
+
+    ad_proc -public update {
+	-tree_id:required
+	-name:required
+	{-description ""}
+	{-locale ""}
+	{-user_id ""}
+	{-modifying_ip ""}
+    } {
+	Updates / inserts a category tree translation.
+
+	@option tree_id tree_id of the category tree to be updated.
+	@option locale locale of the language. [ad_conn locale] used by default.
+	@option name tree name.
+	@option description description of the category tree.
+	@option user_id user that adds the category tree. [ad_conn user_id] used by default.
+	@option modifying_ip ip-address of the user that updated the category tree. [ad_conn peeraddr] used by default.
+	@author Timo Hentschel (thentschel@sussdorff-roy.com)
+    } {
+	if {[empty_string_p $user_id]} {
+	    set user_id [ad_conn user_id]
+	}
+	if {[empty_string_p $modifying_ip]} {
+	    set modifying_ip [ad_conn peeraddr]
+	}
+	if {[empty_string_p $locale]} {
+	    set locale [ad_conn locale]
+	}
+	db_transaction {
+	    if {![db_0or1row check_tree_existence {
+		select 1
+		from category_tree_translations
+		where tree_id = :tree_id
+		and locale = :locale
+	    }]} {
+		db_exec_plsql insert_tree_translation {
+		    begin
+		    category_tree.new_translation (
+						   tree_id        => :tree_id,
+						   tree_name      => :name,
+						   description    => :description,
+						   locale         => :locale,
+						   modifying_user => :user_id,
+						   modifying_ip   => :modifying_ip
+						   );
+		    end;
+		}
+	    } else {
+		db_exec_plsql update_tree_translation {
+		    begin
+		    category_tree.edit (
+					tree_id        => :tree_id,
+					tree_name      => :name,
+					description    => :description,
+					locale         => :locale,
+					modifying_user => :user_id,
+					modifying_ip   => :modifying_ip
+					);
+		    end;
+		}
+	    }
+	}
+	flush_translation_cache $tree_id
+    }
+
+    ad_proc -public delete { tree_id } {
+	Deletes a category tree.
+
+	@param tree_id category tree to be deleted.
+	@author Timo Hentschel (thentschel@sussdorff-roy.com)
+    } {
+	db_exec_plsql delete_tree {
+	    begin
+	    category_tree.del ( :tree_id );
+	    end;
+	}
+	flush_cache $tree_id
+	flush_translation_cache $tree_id
+	category::reset_translation_cache
+    }
+
+    ad_proc -public get_mapped_trees { object_id } {
+	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
+	@author Timo Hentschel (thentschel@sussdorff-roy.com)
+    } {
+	set result [list]
+
+	db_foreach get_mapped_trees {
+	    select tree_id, subtree_category_id
+	    from category_tree_map
+	    where object_id = :object_id
+	} {
+	    lappend result [list $tree_id [get_name $tree_id] $subtree_category_id]
+	}
+
+	return $result
+    }
+
+    ad_proc -public get_tree {
+	-all:boolean
+	{-subtree_id ""}
+	tree_id
+	{locale ""}
+    } {
+	Get all categories of a category tree from the cache.
+
+	@option all Indicates that phased_out categories should be included.
+	@option subtree_id Return only categories of the given subtree.
+	@param tree_id category tree to get the categories of.
+	@param locale language in which to get the categories. [ad_conn locale] used by default.
+	@return tcl list of lists: category_id category_name deprecated_p level
+	@author Timo Hentschel (thentschel@sussdorff-roy.com)
+    } {
+	if {[catch {set tree [nsv_get category_trees $tree_id]}]} {
+	    return
+	}
+	set result ""
+	if {[empty_string_p $subtree_id]} {
+	    foreach category $tree {
+		util_unlist $category category_id deprecated_p level
+		if {$all_p || $deprecated_p == "f"} {
+		    lappend result [list $category_id [category::get_name $category_id $locale] $deprecated_p $level]
+		}
+	    }
+	} else {
+	    set in_subtree_p 0
+	    set subtree_level 0
+	    foreach category $tree {
+		util_unlist $category category_id deprecated_p level
+		if {$level == $subtree_level} {
+		    set in_subtree_p 0
+		}
+		if {$in_subtree_p && $deprecated_p == "f"} {
+		    lappend result [list $category_id [category::get_name $category_id $locale] $deprecated_p [expr $level - $subtree_level]]
+		}
+		if {$category_id == $subtree_id} {
+		    set in_subtree_p 1
+		    set subtree_level $level
+		}
+	    }
+	}
+
+	return $result
+    }
+
+    ad_proc -public usage { tree_id } {
+	Gets all package instances using a category tree.
+
+	@param tree_id category tree to get the using packages for.
+	@return tcl list of lists: package_pretty_plural object_id object_name package_id instance_name read_p
+	@author Timo Hentschel (thentschel@sussdorff-roy.com)	
+    } {
+	set user_id [ad_conn user_id]
+
+	set result [db_list_of_lists category_tree_usage {
+	    select t.pretty_plural, n.object_id, n.object_name, p.package_id,
+	           p.instance_name,
+	           acs_permission.permission_p(n.object_id, :user_id, 'read') as read_p
+	    from category_tree_map m, acs_named_objects n,
+	         apm_packages p, apm_package_types t
+	    where m.tree_id = :tree_id
+	    and n.object_id = m.object_id
+	    and p.package_id = n.package_id
+	    and t.package_key = p.package_key
+	}]
+
+	return $result
+    }
+
+    ad_proc -public reset_cache { } {
+	Reloads all category tree hierarchies in the cache.
+	@author Timo Hentschel (thentschel@sussdorff-roy.com)
+    } {
+	catch {nsv_unset category_trees}
+	set tree_id_old 0
+	set cur_level 1
+	set stack [list]
+	set invalid_p ""
+	set tree [list]
+	db_foreach reset_cache {
+	    select tree_id, category_id, left_ind, right_ind,
+	           decode(deprecated_p,'f','','1') as deprecated_p
+	    from categories
+	    order by tree_id, left_ind
+	} {
+	    if {$tree_id != $tree_id_old && $tree_id_old != 0} {
+		nsv_set category_trees $tree_id_old $tree
+		set cur_level 1
+		set stack [list]
+		set invalid_p ""
+		set tree [list]
+	    }
+	    set tree_id_old $tree_id
+	    lappend tree [list $category_id [ad_decode "$invalid_p$deprecated_p" "" f t] $cur_level]
+	    if { [expr $right_ind - $left_ind] > 1} {
+		incr cur_level 1
+		set invalid_p "$invalid_p$deprecated_p"
+		set stack [linsert $stack 0 [list $right_ind $invalid_p]]
+	    } else {
+		incr right_ind 1
+		while {$right_ind == [lindex [lindex $stack 0] 0] && $cur_level > 0} {
+		    incr cur_level -1
+		    incr right_ind 1
+		    set stack [lrange $stack 1 end]
+		}
+		set invalid_p [lindex [lindex $stack 0] 1]
+	    }
+	}
+	if {$tree_id_old != 0} {
+	    nsv_set category_trees $tree_id $tree
+	}
+    }
+
+    ad_proc -public flush_cache { tree_id } {
+	Flushes category tree hierarchy cache of one category tree.
+
+	@param tree_id category tree to be flushed.
+	@author Timo Hentschel (thentschel@sussdorff-roy.com)
+    } {
+	set cur_level 1
+	set stack [list]
+	set invalid_p ""
+	set tree [list]
+	db_foreach flush_cache {
+	    select category_id, left_ind, right_ind,
+	           decode(deprecated_p,'f','','1') as deprecated_p
+	    from categories
+	    where tree_id = :tree_id
+	    order by left_ind
+	} {
+	    lappend tree [list $category_id [ad_decode "$invalid_p$deprecated_p" "" f t] $cur_level]
+	    if { [expr $right_ind - $left_ind] > 1} {
+		incr cur_level 1
+		set invalid_p "$invalid_p$deprecated_p"
+		set stack [linsert $stack 0 [list $right_ind $invalid_p]]
+	    } else {
+		incr right_ind 1
+		while {$right_ind == [lindex [lindex $stack 0] 0] && $cur_level > 0} {
+		    incr cur_level -1
+		    incr right_ind 1
+		    set stack [lrange $stack 1 end]
+		}
+		set invalid_p [lindex [lindex $stack 0] 1]
+	    }
+	}
+	if {[info exists category_id]} {
+	    nsv_set category_trees $tree_id $tree
+	} else {
+	    nsv_set category_trees $tree_id ""
+	}
+    }
+
+    ad_proc -public reset_translation_cache { } {
+	Reloads all category tree translations in the cache.
+	@author Timo Hentschel (thentschel@sussdorff-roy.com)
+    } {
+	catch {nsv_unset category_tree_translations}
+	set tree_id_old 0
+	db_foreach reset_translation_cache {
+	    select tree_id, locale, name, description
+	    from category_tree_translations
+	    order by tree_id, locale
+	} {
+	    if {$tree_id != $tree_id_old && $tree_id_old != 0} {
+		nsv_set category_tree_translations $tree_id_old [array get tree_lang]
+		unset tree_lang
+	    }
+	    set tree_id_old $tree_id
+	    set tree_lang($locale) [list $name $description]
+	}
+	if {$tree_id_old != 0} {
+	    nsv_set category_tree_translations $tree_id [array get tree_lang]
+	}
+    }
+
+    ad_proc -public flush_translation_cache { tree_id } {
+	Flushes category tree translation cache of one category tree.
+
+	@param tree_id category tree to be flushed.
+	@author Timo Hentschel (thentschel@sussdorff-roy.com)
+    } {
+	db_foreach flush_translation_cache {
+	    select locale, name, description
+	    from category_tree_translations
+	    where tree_id = :tree_id
+	    order by locale
+	} {
+	    set tree_lang($locale) [list $name $description]
+	}
+	if {[info exists tree_lang]} {
+	    nsv_set category_tree_translations $tree_id [array get tree_lang]
+	} else {
+	    nsv_set category_tree_translations $tree_id ""
+	}
+    }
+
+    ad_proc -public get_translation {
+	tree_id
+	{locale ""}
+    } {
+	Gets the category tree name and description in the given language, if available.
+	Uses the default language otherwise.
+
+	@param tree_id category tree to get the name and description of.
+	@param locale language in which to get the name and description. [ad_conn locale] used by default.
+	@return tcl-list: name description
+	@author Timo Hentschel (thentschel@sussdorff-roy.com)
+    } {
+	if {[empty_string_p $locale]} {
+	    set locale [ad_conn locale]
+	}
+	if {[catch {array set tree_lang [nsv_get category_tree_translations $tree_id]}]} {
+	    return
+	}
+	if {![catch {set names $tree_lang($locale)}]} {
+	    # exact match: found name for this locale
+	    return $names
+	}
+	if {![catch {set names $tree_lang([ad_parameter DefaultLocale acs-lang "en_US"])}]} {
+	    # default locale found
+	    return $names
+	}
+	# tried default locale, but nothing found
+	return
+    }
+
+    ad_proc -public get_name {
+	tree_id
+	{locale ""}
+    } {
+	Gets the category tree name in the given language, if available.
+	Uses the default language otherwise.
+
+	@param tree_id category tree to get the name of.
+	@param locale language in which to get the name. [ad_conn locale] used by default.
+	@author Timo Hentschel (thentschel@sussdorff-roy.com)
+    } {
+	return [lindex [get_translation $tree_id] 0]
+    }
+
+    ad_proc pageurl { object_id } {
+	Returns the page that displays a category tree
+	To be used by the AcsObject.PageUrl service contract.
+
+	@param object_id category tree to be displayed.
+	@author Timo Hentschel (thentschel@sussdorff-roy.com)
+    } {
+	return "categories-browse?tree_ids=$object_id"
+    }
+}
Index: openacs-4/packages/categories/tcl/category-trees-procs.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/tcl/Attic/category-trees-procs.xql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/tcl/category-trees-procs.xql	23 Apr 2003 12:29:26 -0000	1.1
@@ -0,0 +1,86 @@
+<?xml version="1.0"?>
+<queryset>
+
+<fullquery name="get_data.get_tree_data">      
+      <querytext>
+      
+	    select site_wide_p
+	    from category_trees
+	    where tree_id = :tree_id
+	
+      </querytext>
+</fullquery>
+
+ 
+<fullquery name="update.check_tree_existence">      
+      <querytext>
+      
+		select 1
+		from category_tree_translations
+		where tree_id = :tree_id
+		and locale = :locale
+	    
+      </querytext>
+</fullquery>
+
+ 
+<fullquery name="get_mapped_trees.get_mapped_trees">      
+      <querytext>
+      
+	    select tree_id, subtree_category_id
+	    from category_tree_map
+	    where object_id = :object_id
+	
+      </querytext>
+</fullquery>
+
+ 
+<fullquery name="reset_cache.reset_cache">      
+      <querytext>
+      
+	    select tree_id, category_id, left_ind, right_ind,
+	           case when deprecated_p = 'f' then '' else '1' end as deprecated_p
+	    from categories
+	    order by tree_id, left_ind
+	
+      </querytext>
+</fullquery>
+
+ 
+<fullquery name="flush_cache.flush_cache">      
+      <querytext>
+      
+	    select category_id, left_ind, right_ind,
+	           case when deprecated_p = 'f' then '' else '1' end as deprecated_p
+	    from categories
+	    where tree_id = :tree_id
+	    order by left_ind
+	
+      </querytext>
+</fullquery>
+
+ 
+<fullquery name="reset_translation_cache.reset_translation_cache">      
+      <querytext>
+      
+	    select tree_id, locale, name, description
+	    from category_tree_translations
+	    order by tree_id, locale
+	
+      </querytext>
+</fullquery>
+
+ 
+<fullquery name="flush_translation_cache.flush_translation_cache">      
+      <querytext>
+      
+	    select locale, name, description
+	    from category_tree_translations
+	    where tree_id = :tree_id
+	    order by locale
+	
+      </querytext>
+</fullquery>
+
+ 
+</queryset>
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
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/tcl/widget-procs.tcl	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,41 @@
+ad_proc -public template::widget::category { element_reference tag_attributes } {
+    # author: Timo Hentschel (thentschel@sussdorff-roy.com)
+
+    upvar $element_reference element
+
+    if { [info exists element(html)] } {
+	array set attributes $element(html)
+    }
+    array set attributes $tag_attributes
+    set attributes(multiple) {}
+
+    # Determine the size automatically for a multiselect
+    if { ! [info exists attributes(size)] } {
+	set attributes(size) 5
+    }
+
+    set object_id [lindex $element(value) 0]
+    set package_id [lindex $element(value) 1]
+    if {[empty_string_p $package_id]} {
+	set package_id [ad_conn package_id]
+    }
+    set mapped_categories [category::get_mapped_categories $object_id]
+    set output ""
+
+    foreach tree [category_tree::get_mapped_trees $package_id] {
+	util_unlist $tree tree_id tree_name subtree_id
+	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]
+	    if {$level>1} {
+		set category_name "[category::repeat_string "&nbsp;" [expr 2*$level -4]]..$category_name"
+	    }
+	    lappend one_tree [list $category_name $category_id]
+	}
+	append output " $tree_name\: [template::widget::menu $element(name) $one_tree $mapped_categories attributes $element(mode)]"
+    }
+
+    return $output
+}
Index: openacs-4/packages/categories/www/categories-browse.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/categories-browse.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/categories-browse.adp	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,58 @@
+<master src="master">
+<property name="page_title">@page_title;noquote@</property>
+<property name="context_bar">@context_bar;noquote@</property>
+
+<form action="categories-browse">
+  @form_vars;noquote@
+  <multiple name=trees>
+    @trees.tree_name@:
+    <select name=category_ids multiple size=5>
+    <group column=tree_id>
+      <option value="@trees.category_id@"<if @trees.selected_p@ eq 1> selected</if>>@trees.indent;noquote@@trees.category_name@
+    </group>
+    </select>
+    <if @trees.rownum@ ne @trees:rowcount@>
+      <b>AND</b>
+    </if>
+  </multiple>
+  <input type=submit name=button value="Show">
+</form>
+
+To deselect or select multiple categories use the Control-Key on your keyboard.
+<p>
+
+<!-- pagination context bar -->
+<table cellpadding=4 cellspacing=0 border=0 width="95%">
+<tr><td></td><td align=center>@object_count@ objects on @page_count@ pages</td><td></td></tr>
+<tr>
+  <td align=left width="5%">
+    <if @info.previous_group@ not nil>
+      <a href="categories-browse?page=@info.previous_group@&@url_vars;noquote@&orderby=@orderby@">&lt;&lt;</a>&nbsp;
+    </if>
+    <if @info.previous_page@ gt 0>
+      <a href="categories-browse?page=@info.previous_page@&@url_vars;noquote@&orderby=@orderby@">&lt;</a>&nbsp;
+    </if>
+  </td>
+  <td align=center>
+    <multiple name=pages>
+      <if @page@ ne @pages.page@>
+        <a href="categories-browse?page=@pages.page@&@url_vars;noquote@&orderby=@orderby@">@pages.page@</a>
+      </if>
+      <else>
+        @page@
+      </else>
+    </multiple>
+  </td>
+  <td align=right width="5%">
+    <if @info.next_page@ not nil>
+      &nbsp;<a href="categories-browse?page=@info.next_page@&@url_vars;noquote@&orderby=@orderby@">&gt;</a>
+    </if>
+    <if @info.next_group@ not nil>
+      &nbsp;<a href="categories-browse?page=@info.next_group@&@url_vars;noquote@&orderby=@orderby@">&gt;&gt;</a>
+    </if>
+  </td>
+</tr>
+</table>
+@dimension_bar;noquote@
+<p>
+@items;noquote@
Index: openacs-4/packages/categories/www/categories-browse.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/categories-browse.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/categories-browse.tcl	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,182 @@
+ad_page_contract {
+
+    Multi-dimensional browsing of selected category trees.
+    Shows a list of all objects mapped to selected categories
+    using ad_table, ad_dimensional and paginator.
+
+    @author Timo Hentschel (thentschel@sussdorff-roy.com)
+    @cvs-id $Id:
+} {
+    tree_ids:integer,multiple
+    {category_ids:integer,multiple,optional ""}
+    {page:integer,optional 1}
+    {orderby:optional object_name}
+    {subtree_p:optional f}
+    {letter:optional all}
+} -properties {
+    page_title:onevalue
+    context_bar:onevalue
+    trees:multirow
+    url_vars:onevalue
+    form_vars:onevalue
+    object_count:onevalue
+    page_count:onevalue
+    page:onevalue
+    orderby:onevalue
+    items:onevalue
+    dimension_bar:onevalue
+    info:onerow
+    pages:onerow
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+
+set page_title "Browse categories"
+
+set context_bar [list "Browse categories"]
+set url_vars [export_url_vars tree_ids:multiple category_ids:multiple subtree_p letter]
+set form_vars [export_form_vars tree_ids:multiple orderby subtree_p letter]
+
+set tree_ids [db_list check_permissions_on_trees [subst {
+    select tree_id
+    from category_trees
+    where (site_wide_p = 't'
+    or acs_permission.permission_p(tree_id, :user_id, 'category_tree_read') = 't')
+    and tree_id in ([join $tree_ids ,])
+}]]
+
+template::multirow create trees tree_id tree_name category_id category_name indent selected_p
+template::util::list_to_lookup $category_ids category_selected
+
+# get tree structures and names from the cache
+foreach tree_id $tree_ids {
+    set tree_name [category_tree::get_name $tree_id]
+    foreach category [category_tree::get_tree $tree_id] {
+	util_unlist $category category_id category_name deprecated_p level
+	set indent ""
+	if {$level>1} {
+	    set indent "[category::repeat_string "&nbsp;" [expr 2*$level -4]].."
+	}
+	template::multirow append trees $tree_id $tree_name $category_id $category_name $indent [info exists category_selected($category_id)]
+    }
+}
+
+set table_def {
+    {object_name "Object Name" {upper(n.object_name) $order} {<td><a href="/o/$object_id">$object_name</a></td>}}
+    {instance_name "Package" {} {<td align=right><a href="/o/$package_id">$instance_name</a></td>}}
+    {package_type "Package Type" {} r}
+    {creation_date "Creation Date" {} r}
+}
+
+set order_by_clause [ad_order_by_from_sort_spec $orderby $table_def]
+
+set dimensional_def {
+    {subtree_p "Categorization" f {
+	{f "Exact"}
+	{t "Include Subcategories"}
+    }}
+    {letter "Name" all {{A "A"} {B "B"} {C "C"} {D "D"} {E "E"} {F "F"} {G "G"} {H "H"} {I "I"} {J "J"} {K "K"} {L "L"} {M "M"} {N "N"} {O "O"} {P "P"} {Q "Q"} {R "R"} {S "S"} {T "T"} {U "U"} {V "V"} {W "W"} {X "X"} {Y "Y"} {Z "Z"} {other "Other"} {all "All"}
+    }}
+}
+
+set form [ns_getform]
+ns_set delkey $form page
+ns_set delkey $form button
+set dimension_bar [ad_dimensional $dimensional_def categories-browse $form]
+
+# generate sql for selecting object names beginning with selected letter
+switch -exact $letter {
+    other {
+	set letter_sql "and (upper(n.object_name) < 'A' or upper(n.object_name) > 'Z')"
+    }
+    all {
+	set letter_sql ""
+    }
+    default {
+	set bind_letter "$letter%"
+	set letter_sql "and upper(n.object_name) like :bind_letter"
+    }
+}
+
+set category_ids_length [llength $category_ids]
+if {$subtree_p == "t"} {
+    # generate sql for exact categorizations plus subcategories
+    set subtree_sql {
+	select v.object_id
+	from (select distinct m.object_id, c.category_id
+	      from category_object_map m, categories c, category_temp t
+	      where c.category_id = t.category_id
+	      and m.category_id in (select c_sub.category_id
+				    from categories c_sub
+				    where c_sub.tree_id = c.tree_id
+				    and c_sub.left_ind >= c.left_ind
+				    and c_sub.left_ind < c.right_ind)) v
+	group by v.object_id having count(*) = :category_ids_length
+    }
+} else {
+    # generate sql for exact categorization
+    set subtree_sql {
+	select m.object_id
+	from category_object_map m, category_temp t
+	where acs_permission.permission_p(m.object_id, :user_id, 'read') = 't'
+	and m.category_id = t.category_id
+	group by m.object_id having count(*) = :category_ids_length
+    }
+}
+
+# query to get the number of pages, number of objects etc used by the paginator
+set count_query [subst {
+    select n.object_id
+    from acs_named_objects n, ($subtree_sql) s
+    where n.object_id = s.object_id
+    $letter_sql
+}]
+
+# paginated query to get the actual objects
+set paginated_query [subst {
+    select r.*
+    from (select n.object_id, n.object_name as object_name, o.creation_date,
+	         t.pretty_name as package_type, n.package_id, p.instance_name,
+                 row_number() over ($order_by_clause) as row_number
+	  from acs_objects o, acs_named_objects n, apm_packages p, apm_package_types t,
+               ($subtree_sql) s
+	  where n.object_id = s.object_id
+	  and o.object_id = n.object_id
+	  and p.package_id = n.package_id
+	  and t.package_key = p.package_key
+	  $letter_sql
+	  $order_by_clause) r
+    where r.row_number between :first_row and :last_row
+}]
+
+set p_name "browse_categories"
+request create
+request set_param page -datatype integer -value 1
+
+db_transaction {
+    # use temporary table to use only bind vars in queries
+    foreach category_id $category_ids {
+	db_dml insert_tmp_categories {
+	    insert into category_temp
+	    values (:category_id)
+	}
+    }
+
+    # execute query to count objects and pages
+    paginator create get_categorized_object_count $p_name $count_query -pagesize 20 -groupsize 10 -contextual -timeout 0
+    set first_row [paginator get_row $p_name $page]
+    set last_row [paginator get_row_last $p_name $page]
+
+    # execute query to get the objects on current page
+    set items [ad_table -Torderby $orderby get_categorized_objects $paginated_query $table_def]
+}
+
+paginator get_display_info $p_name info $page
+set group [paginator get_group $p_name $page]
+paginator get_context $p_name pages [paginator get_pages $p_name $group]
+paginator get_context $p_name groups [paginator get_groups $p_name $group 10]
+
+set object_count [paginator get_row_count $p_name]
+set page_count [paginator get_page_count $p_name]
+
+ad_return_template
Index: openacs-4/packages/categories/www/index-oracle.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/Attic/index-oracle.xql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/index-oracle.xql	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,17 @@
+<?xml version="1.0"?>
+
+<queryset>
+   <rdbms><type>oracle</type><version>8.1.6</version></rdbms>
+
+<fullquery name="get_trees">      
+      <querytext>
+      
+    select tree_id, site_wide_p,
+           acs_permission.permission_p(tree_id, :user_id, 'category_tree_read') has_read_p
+    from category_trees t
+
+      </querytext>
+</fullquery>
+
+ 
+</queryset>
Index: openacs-4/packages/categories/www/index-postgresql.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/Attic/index-postgresql.xql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/index-postgresql.xql	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,17 @@
+<?xml version="1.0"?>
+
+<queryset>
+   <rdbms><type>postgresql</type><version>7.1</version></rdbms>
+
+<fullquery name="get_trees">      
+      <querytext>
+      
+    select tree_id, site_wide_p,
+           acs_permission__permission_p(tree_id, :user_id, 'category_tree_read') has_read_p
+    from category_trees t
+
+      </querytext>
+</fullquery>
+
+ 
+</queryset>
Index: openacs-4/packages/categories/www/index.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/index.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/index.adp	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,26 @@
+<master src="master">
+<property name="page_title">@page_title;noquote@</property>
+<property name="context_bar">@context_bar;noquote@</property>
+
+<if @admin_p@ eq 1>
+  <a href="cadmin/">Category Administration</a><br>
+</if>
+
+<h3> Select Trees for browsing: </h3>
+
+<if @trees:rowcount@ gt "0">
+  <form action="categories-browse">
+    <table>
+      <multiple name="trees">
+        <tr>
+         <td><input type=checkbox name=tree_ids value=@trees.tree_id@>&nbsp;</td>
+         <td>@trees.tree_name@</td>
+        </tr>
+      </multiple>
+      <tr><td></td><td><input type=submit name=button value="Browse"></td></tr>
+    </table>
+  </form>
+</if>
+<else>
+  <ul><li><i>No Trees added yet.</i></li></ul>
+</else>
Index: openacs-4/packages/categories/www/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/index.tcl	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,36 @@
+ad_page_contract {
+
+    The index page to browse category trees.
+
+    @author Timo Hentschel (thentschel@sussdorff-roy.com)
+    @cvs-id $Id:
+} {
+} -properties {
+    page_title:onevalue
+    context_bar:onevalue
+    trees:multirow
+}
+
+set page_title "Categories"
+set context_bar ""
+
+set user_id [ad_maybe_redirect_for_registration]
+set package_id [ad_conn package_id]
+set locale [ad_conn locale]
+
+set admin_p [permission::permission_p -object_id $package_id -privilege category_admin]
+
+template::multirow create trees tree_id tree_name site_wide_p short_name
+
+db_foreach get_trees {
+    select tree_id, site_wide_p,
+           acs_permission.permission_p(tree_id, :user_id, 'category_tree_read') has_read_p
+    from category_trees t
+} {
+    if { [string equal $has_read_p "t"] || [string equal $site_wide_p "t"] } {
+	set tree_name [category_tree::get_name $tree_id $locale]
+	template::multirow append trees $tree_id $tree_name $site_wide_p
+    }
+}
+
+ad_return_template
Index: openacs-4/packages/categories/www/master.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/Attic/master.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/master.adp	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,7 @@
+<master>
+<property name="title">@page_title;noquote@</property>
+<property name="context">@context_bar;noquote@</property>
+
+<slave>
+
+
Index: openacs-4/packages/categories/www/master.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/Attic/master.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/master.tcl	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,12 @@
+#
+# author: Timo Hentschel (thentschel@sussdorff-roy.com)
+#
+
+# There seems to be no way to elegantly set default values here
+if { ![info exists path_id] } {
+    set path_id ""
+}
+
+if { ![info exists context_bar] } {
+    set context_bar ""
+}
Index: openacs-4/packages/categories/www/cadmin/category-delete-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/category-delete-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/category-delete-2.tcl	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,24 @@
+ad_page_contract {
+
+    Deletes a category from a category tree
+
+    @author Timo Hentschel (thentschel@sussdorff-roy.com)
+    @cvs-id $Id:
+} {
+    tree_id:integer
+    category_id:integer
+    {locale ""}
+    object_id:integer,optional
+}
+
+permission::require_permission -object_id $tree_id -privilege category_tree_write
+
+db_transaction {
+    category::delete $category_id
+    category_tree::flush_cache $tree_id
+} on_error {
+    ad_return_complaint "Error Deleting Node" "<p> This node contains leaf (child) nodes. If you really want to delete those leaf nodes, plesae delete them first. Thank you."
+    return
+}
+
+ad_returnredirect "tree-view?[export_url_vars tree_id locale object_id]"
Index: openacs-4/packages/categories/www/cadmin/category-delete-oracle.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/category-delete-oracle.xql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/category-delete-oracle.xql	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,17 @@
+<?xml version="1.0"?>
+
+<queryset>
+   <rdbms><type>oracle</type><version>8.1.6</version></rdbms>
+
+<fullquery name="check_mapped_objects">      
+      <querytext>
+      
+    select case when count(*) = 0 then 0 else 1 end from dual
+    where exists (select 1 from category_object_map
+                  where category_id = :category_id)
+
+      </querytext>
+</fullquery>
+
+ 
+</queryset>
Index: openacs-4/packages/categories/www/cadmin/category-delete-postgresql.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/category-delete-postgresql.xql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/category-delete-postgresql.xql	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,17 @@
+<?xml version="1.0"?>
+
+<queryset>
+   <rdbms><type>postgresql</type><version>7.1</version></rdbms>
+
+<fullquery name="check_mapped_objects">      
+      <querytext>
+      
+    select case when count(*) = 0 then 0 else 1 end 
+    where exists (select 1 from category_object_map
+                  where category_id = :category_id)
+
+      </querytext>
+</fullquery>
+
+ 
+</queryset>
Index: openacs-4/packages/categories/www/cadmin/category-delete.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/category-delete.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/category-delete.adp	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,23 @@
+<master src="master">
+<property name="page_title">@page_title;noquote@</property>
+<property name="context_bar">@context_bar;noquote@</property>
+<property name="locale">@locale@</property>
+
+<if @mapped_objects_p@ eq 1>
+This category is still mapped to some objects.
+</if>
+Are you sure you want to delete category "@category_name@"?
+
+<center>
+<form action="category-delete-2">
+  @form_vars;noquote@
+  <input type=submit value="Yes">
+</form>  
+
+
+<form action="tree-view">
+  @form_vars;noquote@
+  <input type=submit value="No">
+</form>  
+
+</center>
Index: openacs-4/packages/categories/www/cadmin/category-delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/category-delete.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/category-delete.tcl	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,43 @@
+ad_page_contract {
+
+    Deletes a category
+
+    @author Timo Hentschel (thentschel@sussdorff-roy.com)
+    @cvs-id $Id:
+} {
+    tree_id:integer
+    category_id:integer
+    {locale ""}
+    object_id:integer,optional
+} -properties {
+    page_title:onevalue
+    context_bar:onevalue
+    locale:onevalue
+    form_vars:onevalue
+    mapped_objects_p:onevalue
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+permission::require_permission -object_id $tree_id -privilege category_tree_write
+
+set category_name [category::get_name $category_id $locale]
+array set tree [category_tree::get_data $tree_id $locale]
+set tree_name $tree(tree_name)
+
+set mapped_objects_p [db_string check_mapped_objects {
+    select decode(count(*),0,0,1) from dual
+    where exists (select 1 from category_object_map
+                  where category_id = :category_id)
+}]
+    
+set form_vars [export_form_vars tree_id category_id locale object_id]
+set page_title "Delete category \"$category_name\""
+
+if {[info exists object_id]} {
+    set context_bar [list [category::get_object_context $object_id] [list "one-object?[export_url_vars locale object_id]" "Category Management"]]
+} else {
+    set context_bar [list [list ".?[export_url_vars locale]" "Category Management"]]
+}
+lappend context_bar [list "tree-view?[export_url_vars tree_id locale object_id]" $tree_name] "Delete \"$category_name\""
+
+ad_return_template 
Index: openacs-4/packages/categories/www/cadmin/category-form.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/category-form.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/category-form.adp	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,8 @@
+<master src="master">
+<property name="page_title">@page_title@</property>
+<property name="context_bar">@context_bar;noquote@</property>
+<property name="change_locale">f</property>
+
+<blockquote>
+  <formtemplate id="category_form"></formtemplate>
+</blockquote>
Index: openacs-4/packages/categories/www/cadmin/category-form.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/category-form.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/category-form.tcl	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,76 @@
+ad_page_contract {
+    Form to add/edit a category.
+
+    @author Timo Hentschel (thentschel@sussdorff-roy.com)
+    @cvs-id $Id:
+} {
+    tree_id:integer
+    category_id:integer,optional
+    {parent_id:integer,optional [db_null]}
+    {locale ""}
+    object_id:integer,optional
+} -properties {
+    context_bar:onevalue
+    page_title:onevalue
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+set package_id [ad_conn package_id]
+permission::require_permission -object_id $tree_id -privilege category_tree_write
+
+if {[info exists category_id]} {
+    set page_title "Edit category"
+} else {
+    set page_title "Add category"
+}
+
+array set tree [category_tree::get_data $tree_id $locale]
+set tree_name $tree(tree_name)
+
+if {[info exists object_id]} {
+    set context_bar [list [category::get_object_context $object_id] [list "one-object?[export_url_vars locale object_id]" "Category Management"]]
+} else {
+    set context_bar [list [list ".?[export_url_vars locale]" "Category Management"]]
+}
+lappend context_bar [list "tree-view?[export_url_vars tree_id locale object_id]" $tree_name] $page_title
+
+set languages [db_list_of_lists get_ad_locales {
+    select label as name, locale as value
+    from ad_locales
+}]
+
+ad_form -name category_form -action category-form -export { tree_id parent_id locale object_id } -form {
+    {category_id:key}
+    {name:text {label "Name"} {html {size 50 maxlength 200}}}
+    {language:text(select) {label "Language"} {value $locale} {options $languages}}
+    {description:text(textarea),optional {label "Description"} {html {rows 5 cols 80}}}
+} -new_request {
+    set name ""
+    set description ""
+} -edit_request {
+    if {![db_0or1row get_category {
+	select name, description
+	from category_translations
+	where category_id = :category_id
+	and locale = :locale
+    }]} {
+	set default_locale [ad_parameter DefaultLocale acs-lang "en_US"]
+	db_1row get_default_category {
+	    select name, description
+	    from category_translations
+	    where category_id = :category_id
+	    and locale = :default_locale
+	}
+    }
+} -on_submit {
+    set description [util_close_html_tags $description 4000]
+} -new_data {
+    category::add -category_id $category_id -tree_id $tree_id -parent_id $parent_id -locale $language -name $name -description $description
+} -edit_data {
+    category::update -category_id $category_id -locale $language -name $name -description $description
+} -after_submit {
+    ad_returnredirect "tree-view?[export_url_vars tree_id locale object_id]"
+    ad_script_abort
+}
+
+ad_return_template
Index: openacs-4/packages/categories/www/cadmin/category-form.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/category-form.xql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/category-form.xql	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,38 @@
+<?xml version="1.0"?>
+<queryset>
+
+<fullquery name="get_ad_locales">      
+      <querytext>
+      
+    select label as name, locale as value
+    from ad_locales
+
+      </querytext>
+</fullquery>
+
+ 
+<fullquery name="get_category">      
+      <querytext>
+      
+	select name, description
+	from category_translations
+	where category_id = :category_id
+	and locale = :locale
+    
+      </querytext>
+</fullquery>
+
+ 
+<fullquery name="get_default_category">      
+      <querytext>
+      
+	    select name, description
+	    from category_translations
+	    where category_id = :category_id
+	    and locale = :default_locale
+	
+      </querytext>
+</fullquery>
+
+ 
+</queryset>
Index: openacs-4/packages/categories/www/cadmin/category-phase-out.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/category-phase-out.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/category-phase-out.tcl	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,24 @@
+ad_page_contract {
+    Phases a category in/out.
+
+    @author Timo Hentschel (thentschel@sussdorff-roy.com)
+    @cvs-id $Id:
+} {
+    tree_id:integer
+    category_id:integer
+    phase_out_p:integer
+    {locale ""}
+    object_id:integer,optional
+} 
+
+permission::require_permission -object_id $tree_id -privilege category_tree_write
+
+if {$phase_out_p} {
+    category::phase_out $category_id
+    category_tree::flush_cache $tree_id
+} else {
+    category::phase_in $category_id
+    category_tree::flush_cache $tree_id
+}
+
+ad_returnredirect "tree-view?[export_url_vars tree_id locale object_id]"
Index: openacs-4/packages/categories/www/cadmin/category-set-parent-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/Attic/category-set-parent-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/category-set-parent-2.tcl	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,19 @@
+ad_page_contract {
+
+    Changes the parent category of a category.
+
+    @author Timo Hentschel (thentschel@sussdorff-roy.com)
+    @cvs-id $Id:
+} {
+    tree_id:integer
+    category_id:integer
+    {parent_id:integer,optional [db_null]}
+    {locale ""}
+    object_id:integer,optional
+}
+
+permission::require_permission -object_id $tree_id -privilege category_tree_write
+
+category::change_parent -tree_id $tree_id -category_id $category_id -parent_id $parent_id
+
+ad_returnredirect "tree-view?[export_url_vars tree_id locale object_id]"
Index: openacs-4/packages/categories/www/cadmin/category-set-parent-oracle.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/Attic/category-set-parent-oracle.xql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/category-set-parent-oracle.xql	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,22 @@
+<?xml version="1.0"?>
+
+<queryset>
+   <rdbms><type>oracle</type><version>8.1.6</version></rdbms>
+
+<fullquery name="subtree">      
+      <querytext>
+      
+    select /*+INDEX(child categories_left_ix)*/
+           child.category_id
+    from categories parent, categories child
+    where parent.category_id = :category_id
+    and child.left_ind >= parent.left_ind
+    and child.left_ind <= parent.right_ind
+    and child.tree_id = parent.tree_id
+    order by child.left_ind
+
+      </querytext>
+</fullquery>
+
+ 
+</queryset>
Index: openacs-4/packages/categories/www/cadmin/category-set-parent.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/Attic/category-set-parent.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/category-set-parent.adp	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,29 @@
+<master src="master">
+<property name="page_title">@page_title;noquote@</property>
+<property name="context_bar">@context_bar;noquote@</property>
+<property name="locale">@locale@</property>
+
+<if @tree:rowcount@ gt 0>
+  <table>
+   <tr><th>Category Name</th><th>Hierarchy Level</th></tr>
+   <tr><td> <a href="category-set-parent-2?@url_vars;noquote@">Root Level </a></td><td align=center>0</td></tr>
+
+   <multiple name="tree">
+     <tr>
+       <td>
+         @tree.left_indent;noquote@
+         <if @tree.url_p@ eq "1">
+           <a href="category-set-parent-2?parent_id=@tree.category_id@&@url_vars;noquote@">@tree.category_name@</a>
+         </if>
+         <else>
+             @tree.category_name@
+         </else>
+                    
+       </td>
+       <td align=center>
+           @tree.level@
+       </td>
+      </tr>
+    </multiple>
+  </table>
+</if>
Index: openacs-4/packages/categories/www/cadmin/category-set-parent.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/Attic/category-set-parent.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/category-set-parent.tcl	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,62 @@
+ad_page_contract {
+    
+    Changes the parent category of a category.
+
+    @author Timo Hentschel (thentschel@sussdorff-roy.com)
+    @cvs-id $Id:
+} {
+    tree_id:integer
+    category_id:integer
+    {locale ""}
+    object_id:integer,optional
+} -properties {
+    page_title:onevalue
+    context_bar:onevalue
+    locale:onevalue
+    tree_name:onevalue
+    url_vars:onevalue
+    tree:multirow
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+permission::require_permission -object_id $tree_id -privilege category_tree_write
+
+array set one_tree [category_tree::get_data $tree_id $locale]
+set tree_name $one_tree(tree_name)
+
+set url_vars [export_url_vars tree_id category_id locale object_id]
+set page_title "Choose a parent node"
+
+if {[info exists object_id]} {
+    set context_bar [list [category::get_object_context $object_id] [list "one-object?[export_url_vars locale object_id]" "Category Management"]]
+} else {
+    set context_bar [list [list ".?[export_url_vars locale]" "Category Management"]]
+}
+lappend context_bar [list "tree-view?[export_url_vars tree_id locale object_id]" $tree_name] "Choose parent"
+
+
+set subtree_categories_list [db_list subtree {
+    select /*+INDEX(child categories_left_ix)*/
+           child.category_id
+    from categories parent, categories child
+    where parent.category_id = :category_id
+    and child.left_ind >= parent.left_ind
+    and child.left_ind <= parent.right_ind
+    and child.tree_id = parent.tree_id
+    order by child.left_ind
+}]
+
+template::multirow create tree category_name category_id deprecated_p level left_indent url_p
+
+foreach category [category_tree::get_tree -all $tree_id $locale] {
+    util_unlist $category category_id category_name deprecated_p level
+
+    if { [lsearch $subtree_categories_list $category_id]==-1 } {
+	set url_p 1
+    } else {
+	set url_p 0
+    }
+    template::multirow append tree $category_name $category_id $deprecated_p $level [category::repeat_string "&nbsp;" [expr ($level-1)*5]] $url_p
+}
+
+ad_return_template
Index: openacs-4/packages/categories/www/cadmin/category-set-parent.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/Attic/category-set-parent.xql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/category-set-parent.xql	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,21 @@
+<?xml version="1.0"?>
+<queryset>
+
+<fullquery name="subtree">      
+      <querytext>
+      FIX ME REMOVE OPTIMIZATION HINT
+
+    select /*+INDEX(child categories_left_ix)*/
+           child.category_id
+    from categories parent, categories child
+    where parent.category_id = :category_id
+    and child.left_ind >= parent.left_ind
+    and child.left_ind <= parent.right_ind
+    and child.tree_id = parent.tree_id
+    order by child.left_ind
+
+      </querytext>
+</fullquery>
+
+ 
+</queryset>
Index: openacs-4/packages/categories/www/cadmin/category-usage.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/category-usage.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/category-usage.adp	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,39 @@
+<master src="master">
+<property name="page_title">@page_title;noquote@</property>
+<property name="context_bar">@context_bar;noquote@</property>
+<property name="locale">@locale@</property>
+
+<!-- pagination context bar -->
+<table cellpadding=4 cellspacing=0 border=0 width="95%">
+<tr><td></td><td align=center>@object_count@ objects on @page_count@ pages</td><td></td></tr>
+<tr>
+  <td align=left width="5%">
+    <if @info.previous_group@ not nil>
+      <a href="category-usage?page=@info.previous_group@&@url_vars;noquote@&orderby=@orderby@">&lt;&lt;</a>&nbsp;
+    </if>
+    <if @info.previous_page@ gt 0>
+      <a href="category-usage?page=@info.previous_page@&@url_vars;noquote@&orderby=@orderby@">&lt;</a>&nbsp;
+    </if>
+  </td>
+  <td align=center>
+    <multiple name=pages>
+      <if @page@ ne @pages.page@>
+        <a href="category-usage?page=@pages.page@&@url_vars;noquote@&orderby=@orderby@">@pages.page@</a>
+      </if>
+      <else>
+        @page@
+      </else>
+    </multiple>
+  </td>
+  <td align=right width="5%">
+    <if @info.next_page@ not nil>
+      &nbsp;<a href="category-usage?page=@info.next_page@&@url_vars;noquote@&orderby=@orderby@">&gt;</a>
+    </if>
+    <if @info.next_group@ not nil>
+      &nbsp;<a href="category-usage?page=@info.next_group@&@url_vars;noquote@&orderby=@orderby@">&gt;&gt;</a>
+    </if>
+  </td>
+</tr>
+</table>
+<p>
+@items;noquote@
Index: openacs-4/packages/categories/www/cadmin/category-usage.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/category-usage.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/category-usage.tcl	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,102 @@
+ad_page_contract {
+
+    Show all objects mapped to a category.
+
+    @author Timo Hentschel (thentschel@sussdorff-roy.com)
+    @cvs-id $Id:
+} {
+    category_id:integer
+    tree_id:integer
+    {locale ""}
+    object_id:integer,optional
+    {page:integer,optional 1}
+    {orderby:optional object_name}
+} -properties {
+    page_title:onevalue
+    context_bar:onevalue
+    locale:onevalue
+    url_vars:onevalue
+    object_count:onevalue
+    page_count:onevalue
+    page:onevalue
+    orderby:onevalue
+    items:onevalue
+    info:onerow
+    pages:onerow
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+array set tree [category_tree::get_data $tree_id $locale]
+if {$tree(site_wide_p) == "f"} {
+    permission::require_permission -object_id $tree_id -privilege category_tree_read
+}
+
+set tree_name $tree(tree_name)
+set category_name [category::get_name $category_id $locale]
+set page_title "Objects using category \"$category_name\" of tree \"$tree_name\""
+set url_vars [export_url_vars category_id tree_id locale object_id]
+
+if {[info exists object_id]} {
+    set context_bar [list [category::get_object_context $object_id] [list "one-object?[export_url_vars locale object_id]" "Category Management"]]
+} else {
+    set context_bar [list [list ".?[export_url_vars locale]" "Category Management"]]
+}
+lappend context_bar [list "tree-view?[export_url_vars tree_id locale object_id]" $tree_name] "\"$category_name\" Usage"
+
+set table_def {
+    {object_name "Object Name" {upper(n.object_name) $order} {<td><a href="/o/$object_id">$object_name</a></td>}}
+    {instance_name "Package" {} {<td align=right><a href="/o/$package_id">$instance_name</a></td>}}
+    {package_type "Package Type" {} r}
+    {creation_date "Creation Date" {} r}
+}
+
+set order_by_clause [ad_order_by_from_sort_spec $orderby $table_def]
+
+# query to get the number of pages, number of objects etc used by the paginator
+set count_query {
+    select n.object_id
+    from category_object_map m, acs_named_objects n
+    where acs_permission.permission_p(m.object_id, :user_id, 'read') = 't'
+    and m.category_id = :category_id
+    and n.object_id = m.object_id
+}
+
+# paginated query to get the actual objects
+set paginated_query [subst {
+    select r.*
+    from (select n.object_id, n.object_name as object_name, o.creation_date,
+	         t.pretty_name as package_type, n.package_id, p.instance_name,
+                 row_number() over ($order_by_clause) as row_number
+	  from acs_objects o, acs_named_objects n, apm_packages p, apm_package_types t,
+               category_object_map m
+	  where n.object_id = m.object_id
+	  and o.object_id = n.object_id
+	  and p.package_id = n.package_id
+	  and t.package_key = p.package_key
+	  and m.category_id = :category_id
+	  and acs_permission.permission_p(m.object_id, :user_id, 'read') = 't'
+	  $order_by_clause) r
+    where r.row_number between :first_row and :last_row
+}]
+
+set p_name "category-usage"
+request create
+request set_param page -datatype integer -value 1
+
+# execute query to count objects and pages
+paginator create get_category_usages $p_name $count_query -pagesize 20 -groupsize 10 -contextual -timeout 0
+set first_row [paginator get_row $p_name $page]
+set last_row [paginator get_row_last $p_name $page]
+
+# execute query to get the objects on current page
+set items [ad_table -Torderby $orderby get_objects_using_category $paginated_query $table_def]
+
+paginator get_display_info $p_name info $page
+set group [paginator get_group $p_name $page]
+paginator get_context $p_name pages [paginator get_pages $p_name $group]
+paginator get_context $p_name groups [paginator get_groups $p_name $group 10]
+
+set object_count [paginator get_row_count $p_name]
+set page_count [paginator get_page_count $p_name]
+
+ad_return_template
Index: openacs-4/packages/categories/www/cadmin/index-oracle.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/Attic/index-oracle.xql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/index-oracle.xql	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,18 @@
+<?xml version="1.0"?>
+
+<queryset>
+   <rdbms><type>oracle</type><version>8.1.6</version></rdbms>
+
+<fullquery name="trees">      
+      <querytext>
+      
+         select tree_id, site_wide_p,
+                acs_permission.permission_p(tree_id, :user_id, 'category_tree_write') has_write_p,
+                acs_permission.permission_p(tree_id, :user_id, 'category_tree_read') has_read_p
+           from category_trees t
+
+      </querytext>
+</fullquery>
+
+ 
+</queryset>
Index: openacs-4/packages/categories/www/cadmin/index-postgresql.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/Attic/index-postgresql.xql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/index-postgresql.xql	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,18 @@
+<?xml version="1.0"?>
+
+<queryset>
+   <rdbms><type>postgresql</type><version>7.1</version></rdbms>
+
+<fullquery name="trees">      
+      <querytext>
+      
+         select tree_id, site_wide_p,
+                acs_permission__permission_p(tree_id, :user_id, 'category_tree_write') has_write_p,
+                acs_permission__permission_p(tree_id, :user_id, 'category_tree_read') has_read_p
+           from category_trees t
+
+      </querytext>
+</fullquery>
+
+ 
+</queryset>
Index: openacs-4/packages/categories/www/cadmin/index.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/index.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/index.adp	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,55 @@
+<master src="master">
+<property name="page_title">@page_title;noquote@</property>
+<property name="context_bar">@context_bar;noquote@</property>
+<property name="locale">@locale@</property>
+
+<h3> Trees you have the write permission on: </h3>
+
+<if @trees_with_write_permission:rowcount@ gt "0">
+  <table>
+
+    <tr><th> Name</th><th></th></tr>
+    <multiple name="trees_with_write_permission">
+     <tr>
+      <td>
+        <a href="tree-view?tree_id=@trees_with_write_permission.tree_id@&@url_vars;noquote@">@trees_with_write_permission.tree_name@</a> 
+      </td>
+      <td> 
+        <if @trees_with_write_permission.site_wide_p@ eq "t"> (Site-Wide Tree) </if>
+      </td>
+     </tr>
+      </multiple>
+
+  </table>
+</if>
+<else>
+  <ul><li><i>None</i></li></ul>
+</else>
+
+
+<p>
+
+<h3> Trees you have only the read permission on: </h3>
+
+<if @trees_with_read_permission:rowcount@ not nil and @trees_with_read_permission:rowcount@ gt "0">
+  <table>
+    <tr><th> Name</th><th></th></tr> 
+    <multiple name="trees_with_read_permission">
+      <tr>
+       <td>
+         <a href="tree-view?tree_id=@trees_with_read_permission.tree_id@&@url_vars;noquote@">@trees_with_read_permission.tree_name@</a>
+       </td>
+       <td>
+        <if @trees_with_read_permission.site_wide_p@ eq "t"> (Site-Wide Tree) </if>
+       </td>
+      </tr>
+    </multiple>
+  </table>
+</if>
+<else>
+  <ul><li><i>None</i></li></ul>
+</else>
+
+<p>
+<a href="tree-form?@url_vars;noquote@">Create a new tree</a>
+<p>
Index: openacs-4/packages/categories/www/cadmin/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/index.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/index.tcl	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,48 @@
+ad_page_contract {
+
+    The index page of the category trees administration
+    presenting a list of trees the person has a permission to see/modify
+
+    @author Timo Hentschel (thentschel@sussdorff-roy.com)
+    @cvs-id $Id:
+} {
+    {locale ""}
+} -properties {
+    page_title:onevalue
+    context_bar:onevalue
+    locale:onevalue
+    url_vars:onevalue
+    trees_with_write_permission:multirow
+    trees_with_read_permission:multirow
+}
+
+set page_title "Category Management"
+set context_bar [list $page_title]
+set url_vars [export_url_vars locale]
+
+set user_id [ad_maybe_redirect_for_registration]
+set package_id [ad_conn package_id]
+
+permission::require_permission -object_id $package_id -privilege category_admin
+
+template::multirow create trees_with_write_permission tree_id tree_name site_wide_p short_name
+template::multirow create trees_with_read_permission tree_id tree_name site_wide_p short_name
+
+
+db_foreach trees {
+         select tree_id, site_wide_p,
+                acs_permission.permission_p(tree_id, :user_id, 'category_tree_write') has_write_p,
+                acs_permission.permission_p(tree_id, :user_id, 'category_tree_read') has_read_p
+           from category_trees t
+} {
+    if { [string equal $has_write_p "t"] } {
+	set tree_name [category_tree::get_name $tree_id $locale]
+	template::multirow append trees_with_write_permission $tree_id $tree_name $site_wide_p
+    } elseif { [string equal $has_read_p "t"] || [string equal $site_wide_p "t"] } {
+	set tree_name [category_tree::get_name $tree_id $locale]
+	template::multirow append trees_with_read_permission $tree_id $tree_name $site_wide_p
+    }
+}
+
+
+ad_return_template
Index: openacs-4/packages/categories/www/cadmin/master.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/master.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/master.adp	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,17 @@
+<master>
+<property name="title">@page_title;noquote@</property>
+<property name="context">@context_bar;noquote@</property>
+
+<if @change_locale@ eq t>
+  <form action="@current_page@">
+    @form_vars;noquote@
+    <select name=locale>
+      <multiple name=languages>
+        <option value="@languages.locale@"<if @locale@ eq @languages.locale@> selected</if>>@languages.label@
+      </multiple>
+    </select>
+    <input type=submit name=xx value="Change">
+  </form>
+</if>
+
+<slave>
Index: openacs-4/packages/categories/www/cadmin/master.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/master.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/master.tcl	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,28 @@
+#
+# author: Timo Hentschel (thentschel@sussdorff-roy.com)
+#
+
+# There seems to be no way to elegantly set default values here
+if { ![info exists path_id] } {
+    set path_id ""
+}
+
+if { ![info exists context_bar] } {
+    set context_bar ""
+}
+
+if { ![info exists change_locale] } {
+    set change_locale t
+}
+
+if {![exists_and_not_null locale]} {
+    set locale [ad_parameter DefaultLocale acs-lang "en_US"]
+}
+
+db_multirow languages get_locales {
+    select label, locale
+    from ad_locales
+}
+
+set current_page [ad_conn url]
+set form_vars [export_ns_set_vars form [list locale xx] [ad_conn form]]
Index: openacs-4/packages/categories/www/cadmin/master.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/Attic/master.xql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/master.xql	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,14 @@
+<?xml version="1.0"?>
+<queryset>
+
+<fullquery name="get_locales">      
+      <querytext>
+      
+    select label, locale
+    from ad_locales
+
+      </querytext>
+</fullquery>
+
+ 
+</queryset>
Index: openacs-4/packages/categories/www/cadmin/one-object-oracle.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/Attic/one-object-oracle.xql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/one-object-oracle.xql	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,21 @@
+<?xml version="1.0"?>
+
+<queryset>
+   <rdbms><type>oracle</type><version>8.1.6</version></rdbms>
+
+<fullquery name="get_unmapped_trees">      
+      <querytext>
+      
+    select tree_id, site_wide_p,
+          acs_permission.permission_p(tree_id, :user_id, 'category_tree_read') has_read_permission  
+     from category_trees t
+    where not exists (select 1 from category_tree_map m
+                       where m.object_id = :object_id
+                         and m.tree_id = t.tree_id)
+    order by t.tree_id
+
+      </querytext>
+</fullquery>
+
+ 
+</queryset>
Index: openacs-4/packages/categories/www/cadmin/one-object-postgresql.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/Attic/one-object-postgresql.xql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/one-object-postgresql.xql	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,21 @@
+<?xml version="1.0"?>
+
+<queryset>
+   <rdbms><type>postgresql</type><version>7.1</version></rdbms>
+
+<fullquery name="get_unmapped_trees">      
+      <querytext>
+      
+    select tree_id, site_wide_p,
+          acs_permission__permission_p(tree_id, :user_id, 'category_tree_read') has_read_permission  
+     from category_trees t
+    where not exists (select 1 from category_tree_map m
+                       where m.object_id = :object_id
+                         and m.tree_id = t.tree_id)
+    order by t.tree_id
+
+      </querytext>
+</fullquery>
+
+ 
+</queryset>
Index: openacs-4/packages/categories/www/cadmin/one-object.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/Attic/one-object.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/one-object.adp	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,65 @@
+<master src="master">
+<property name="page_title">@page_title;noquote@</property>
+<property name="context_bar">@context_bar;noquote@</property>
+<property name="locale">@locale@</property>
+
+<ul>
+  <li>
+  <p>
+  <if @mapped_trees:rowcount@ not nil and @mapped_trees:rowcount@ gt "0">
+The following category trees are mapped to "@object_name@":
+
+<table>
+    <tr><th> Name</th><th></th></tr>
+     <multiple name="mapped_trees">
+     <tr>
+        <td>
+            <a href="tree-view?tree_id=@mapped_trees.tree_id@&@url_vars;noquote@">@mapped_trees.tree_name@ <if @mapped_trees.subtree_category_name@ not nil> :: </if>@mapped_trees.subtree_category_name@</a>
+        </td>
+        <td>
+          [ <a href="tree-unmap?tree_id=@mapped_trees.tree_id@&@url_vars;noquote@">unmap</a> ] 
+        </td>
+        <td>
+          <if @mapped_trees.site_wide_p@ eq "t"> (Site-Wide Tree) </if> 
+        </td>
+    </tr>
+  </multiple>
+ </table>
+</if>
+<else>
+There are no category trees mapped to "@object_name@"
+</else>
+</p>
+</ul>
+
+<ul>
+<if @unmapped_trees:rowcount@ gt "0">
+  <p>
+  <li> The following category trees are available:
+
+  <table>
+    <tr><th> Name</th><th></th><th></th></tr>
+      <multiple name="unmapped_trees">
+      <tr>
+        <td>
+           <a href="tree-view?tree_id=@unmapped_trees.tree_id@&@url_vars;noquote@">@unmapped_trees.tree_name@</a> 
+        </td>
+        <td align=center>
+           [ <a href="tree-map?tree_id=@unmapped_trees.tree_id@&@url_vars;noquote@"> map tree </a>]
+        </td>
+        <td>
+           [ <a href="subtree-choose?tree_id=@unmapped_trees.tree_id@&@url_vars;noquote@"> Choose a subtree to map </a> ]
+        </td>
+        <td>
+          <if @unmapped_trees.site_wide_p@ eq "t"> (Site-Wide Tree) </if> 
+        </td> 
+      </tr>
+  </multiple>
+  </table>
+  
+
+</if>
+</ul>
+
+<p>
+<a href="tree-form?@url_vars;noquote@">Create and map a new category tree</a>
Index: openacs-4/packages/categories/www/cadmin/one-object.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/one-object.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/one-object.tcl	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,68 @@
+ad_page_contract {
+    
+    This entry page for different object in ACS that
+    need to manage which categories that can be mapped
+    to contained objects. 
+
+    @author Timo Hentschel (thentschel@sussdorff-roy.com)
+    @cvs-id $Id:
+} {
+    object_id:integer,notnull
+    {locale ""}
+} -properties {
+    page_title:onevalue
+    context_bar:onevalue
+    locale:onevalue
+    mapped_trees:multirow
+    unmapped_trees:multirow
+    object_name:onevalue
+    url_vars:onevalue
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+permission::require_permission -object_id $object_id -privilege admin
+
+set context_bar [category::get_object_context $object_id]
+set object_name [lindex $context_bar 1]
+set page_title "Category Management"
+set context_bar [list $context_bar $page_title]
+set url_vars [export_url_vars locale object_id]
+
+template::multirow create mapped_trees tree_name tree_id site_wide_p subtree_category_id subtree_category_name
+
+db_foreach get_mapped_trees {
+         select t.tree_id, t.site_wide_p, m.subtree_category_id
+           from category_trees t, category_tree_map m
+          where m.object_id = :object_id
+            and m.tree_id = t.tree_id
+       order by t.tree_id
+} {
+    if {![empty_string_p $subtree_category_id]} {
+	set subtree_category_name [category::get_name $subtree_category_id $locale]
+    } else {
+	set subtree_category_name ""
+    }
+    set tree_name [category_tree::get_name $tree_id $locale]
+    template::multirow append mapped_trees $tree_name $tree_id $site_wide_p $subtree_category_id $subtree_category_name
+}
+
+
+
+template::multirow create unmapped_trees tree_id tree_name site_wide_p
+
+db_foreach get_unmapped_trees {
+    select tree_id, site_wide_p,
+          acs_permission.permission_p(tree_id, :user_id, 'category_tree_read') has_read_permission  
+     from category_trees t
+    where not exists (select 1 from category_tree_map m
+                       where m.object_id = :object_id
+                         and m.tree_id = t.tree_id)
+    order by t.tree_id
+} {
+    if { [string equal $has_read_permission t] || [string equal $site_wide_p t] } {
+	set tree_name [category_tree::get_name $tree_id $locale]
+	template::multirow append unmapped_trees $tree_id $tree_name $site_wide_p
+    }
+}
+
+ad_return_template
Index: openacs-4/packages/categories/www/cadmin/one-object.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/Attic/one-object.xql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/one-object.xql	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,17 @@
+<?xml version="1.0"?>
+<queryset>
+
+<fullquery name="get_mapped_trees">      
+      <querytext>
+      
+         select t.tree_id, t.site_wide_p, m.subtree_category_id
+           from category_trees t, category_tree_map m
+          where m.object_id = :object_id
+            and m.tree_id = t.tree_id
+       order by t.tree_id
+
+      </querytext>
+</fullquery>
+
+ 
+</queryset>
Index: openacs-4/packages/categories/www/cadmin/permission-manage.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/permission-manage.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/permission-manage.adp	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,18 @@
+<master src="master">
+<property name="page_title">@page_title;noquote@</property>
+<property name="context_bar">@context_bar;noquote@</property>
+<property name="change_locale">f</property>
+
+<p>
+<if @sw_tree_p@ eq 1>
+  This is a site wide category tree
+  <if @admin_p@ eq 1>
+    <a href="site-wide-status-change?action=0&@url_vars@">Make it Local</a>
+  </if>
+</if>
+<else>
+  This tree is local
+  <if @admin_p@ eq 1>
+    <a href="site-wide-status-change?action=1&@url_vars@">Make it Site-Wide</a>
+  </if>
+</else>  
Index: openacs-4/packages/categories/www/cadmin/permission-manage.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/permission-manage.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/permission-manage.tcl	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,37 @@
+ad_page_contract {
+    Let the user toggle the site-wide status of a category tree.
+
+    @author Timo Hentschel (thentschel@sussdorff-roy.com)
+    @cvs-id $Id:
+} {
+    tree_id:integer
+    object_id:integer,optional
+    {locale ""}
+} -properties {
+    page_title:onevalue
+    context_bar:onevalue
+    sw_tree_p:onevalue
+    admin_p:onevalue
+    url_vars:onevalue
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+permission::require_permission -object_id $tree_id -privilege category_tree_grant_permissions
+
+array set tree [category_tree::get_data $tree_id $locale]
+set tree_name $tree(tree_name)
+set page_title "Permission Management for $tree_name"
+
+if {[info exists object_id]} {
+    set context_bar [list [category::get_object_context $object_id] [list "one-object?[export_url_vars locale object_id]" "Category Management"]]
+} else {
+    set context_bar [list [list ".?[export_url_vars locale]" "Category Management"]]
+}
+lappend context_bar [list "tree-view?[export_url_vars tree_id locale object_id]" $tree_name] "Manage Permissions"
+
+set url_vars [export_url_vars tree_id object_id locale]
+set package_id [ad_conn package_id]
+set admin_p [permission::permission_p -object_id $package_id -privilege category_admin]
+set sw_tree_p [ad_decode $tree(site_wide_p) f 0 1]
+
+ad_return_template
Index: openacs-4/packages/categories/www/cadmin/site-wide-status-change.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/site-wide-status-change.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/site-wide-status-change.tcl	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,23 @@
+ad_page_contract {
+    Toggle the site-wide status of a category tree.
+
+    @author Timo Hentschel (thentschel@sussdorff-roy.com)
+    @cvs-id $Id:
+} {
+    tree_id:integer
+    action:integer
+    {locale ""}
+    object_id:integer,optional
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+set package_id [ad_conn package_id]
+permission::require_permission -object_id $package_id -privilege category_admin
+
+db_dml site_wide_status {
+    update category_trees
+    set site_wide_p = decode(:action,'1','t','f')
+    where tree_id  = :tree_id
+}
+
+ad_returnredirect "permission-manage?[export_url_vars tree_id locale object_id]"
Index: openacs-4/packages/categories/www/cadmin/site-wide-status-change.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/site-wide-status-change.xql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/site-wide-status-change.xql	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,15 @@
+<?xml version="1.0"?>
+<queryset>
+
+<fullquery name="site_wide_status">      
+      <querytext>
+      
+    update category_trees
+    set site_wide_p = case when :action = '1' then 't' else 'f' end
+    where tree_id  = :tree_id
+
+      </querytext>
+</fullquery>
+
+ 
+</queryset>
Index: openacs-4/packages/categories/www/cadmin/subtree-choose.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/Attic/subtree-choose.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/subtree-choose.adp	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,17 @@
+<master src="master">
+<property name="page_title">@page_title;noquote@</property>
+<property name="context_bar">@context_bar;noquote@</property>
+<property name="locale">@locale@</property>
+
+<if @tree:rowcount@ lt 2>
+  <ul>
+  <li><i> none available</i>
+  </ul>
+</if>
+<else>
+  <table>
+    <multiple name="tree">
+      <tr><td>@tree.left_indent;noquote@ @tree.category_name@ [ <font size=-1><a href="subtree-map?category_id=@tree.category_id@&source_tree_id=@tree_id@&@url_vars;noquote@">Add this subtree</a> </font> ]</td><td align=center> @tree.level@ </font></td></tr>
+    </multiple>
+  </table>
+</else>
Index: openacs-4/packages/categories/www/cadmin/subtree-choose.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/Attic/subtree-choose.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/subtree-choose.tcl	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,41 @@
+ad_page_contract {
+
+    This page displays a category tree.
+    Next to each category there will be a map subtree link. 
+
+    @author Timo Hentschel (thentschel@sussdorff-roy.com)
+    @cvs-id $Id:
+} {
+    tree_id:integer
+    {locale ""}
+    object_id:integer,notnull
+} -properties {
+    page_title:onevalue
+    context_bar:onevalue
+    locale:onevalue
+    url_vars:onevalue
+    tree:multirow
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+permission::require_permission -object_id $object_id -privilege admin
+
+array set tree_data [category_tree::get_data $tree_id $locale]
+if {$tree_data(site_wide_p) == "f"} {
+    permission::require_permission -object_id $tree_id -privilege category_tree_read
+}
+
+set page_title "Choose a subtree to map"
+set url_vars [export_url_vars locale object_id]
+
+set context_bar [list [category::get_object_context $object_id] [list "one-object?[export_url_vars locale object_id]" "Category Management"] "Map subtree"]
+
+template::multirow create tree category_id category_name level left_indent
+
+foreach category [category_tree::get_tree -all $tree_id $locale] {
+    util_unlist $category category_id category_name deprecated_p level
+
+    template::multirow append tree $category_id $category_name $level [category::repeat_string "&nbsp;" [expr ($level-1)*5]]
+}
+
+ad_return_template
Index: openacs-4/packages/categories/www/cadmin/subtree-map.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/Attic/subtree-map.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/subtree-map.tcl	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,24 @@
+ad_page_contract {
+
+    Map a subtree to a package (or object)
+
+    @author Timo Hentschel (thentschel@sussdorff-roy.com)
+    @cvs-id $Id:
+} {
+    source_tree_id:integer,notnull
+    category_id:integer,notnull
+    {locale ""}
+    object_id:integer,notnull
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+permission::require_permission -object_id $object_id -privilege admin
+
+array set tree [category_tree::get_data $source_tree_id $locale]
+if {$tree(site_wide_p) == "f"} {
+    permission::require_permission -object_id $source_tree_id -privilege category_tree_read
+}
+
+category_tree::map -tree_id $source_tree_id -subtree_category_id $category_id -object_id $object_id
+
+ad_returnredirect "one-object?[export_url_vars locale object_id]"
Index: openacs-4/packages/categories/www/cadmin/tree-copy-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/tree-copy-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/tree-copy-2.tcl	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,19 @@
+ad_page_contract {
+
+    This page copies a category tree into another category tree
+
+    @author Timo Hentschel (thentschel@sussdorff-roy.com)
+    @cvs-id $Id:
+} {
+    tree_id:integer
+    source_tree_id:integer
+    {locale ""}
+    object_id:integer,optional
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+permission::require_permission -object_id $tree_id -privilege category_tree_write
+
+category_tree::copy -source_tree $source_tree_id -dest_tree $tree_id
+
+ad_returnredirect "tree-view?[export_url_vars tree_id locale object_id]"
Index: openacs-4/packages/categories/www/cadmin/tree-copy-oracle.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/Attic/tree-copy-oracle.xql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/tree-copy-oracle.xql	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,18 @@
+<?xml version="1.0"?>
+
+<queryset>
+   <rdbms><type>oracle</type><version>8.1.6</version></rdbms>
+
+<fullquery name="trees_select">      
+      <querytext>
+      
+    select tree_id as source_tree_id, site_wide_p,
+           acs_permission.permission_p(tree_id, :user_id, 'category_tree_read') as has_read_p
+    from category_trees
+    where tree_id <> :tree_id
+
+      </querytext>
+</fullquery>
+
+ 
+</queryset>
Index: openacs-4/packages/categories/www/cadmin/tree-copy-postgresql.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/Attic/tree-copy-postgresql.xql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/tree-copy-postgresql.xql	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,18 @@
+<?xml version="1.0"?>
+
+<queryset>
+   <rdbms><type>postgresql</type><version>7.1</version></rdbms>
+
+<fullquery name="trees_select">      
+      <querytext>
+      
+    select tree_id as source_tree_id, site_wide_p,
+           acs_permission__permission_p(tree_id, :user_id, 'category_tree_read') as has_read_p
+    from category_trees
+    where tree_id <> :tree_id
+
+      </querytext>
+</fullquery>
+
+ 
+</queryset>
Index: openacs-4/packages/categories/www/cadmin/tree-copy.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/tree-copy.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/tree-copy.adp	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,24 @@
+<master src="master">
+<property name="page_title">@page_title;noquote@</property>
+<property name="context_bar">@context_bar;noquote@</property>
+<property name="locale">@locale@</property>
+
+<ul>
+  <multiple name="trees">
+    <li>
+      <a href="tree-view-simple?tree_id=@trees.tree_id@&target_tree_id=@tree_id@&@url_vars;noquote@">
+        @trees.tree_name@</a> &nbsp 
+       <if @trees.site_wide_p@ eq "t"> (Site-Wide Tree) </if> 
+       &nbsp
+        [<a href="tree-copy-2?source_tree_id=@trees.tree_id@&tree_id=@tree_id@&@url_vars;noquote@">
+        Copy this one</a>] 
+    </li>
+  </multiple>
+</ul>
+
+<if @trees:rowcount@ eq 0>
+<blockquote>
+There are no category trees available
+</blockquote>
+</if>
+</p>
Index: openacs-4/packages/categories/www/cadmin/tree-copy.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/tree-copy.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/tree-copy.tcl	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,49 @@
+ad_page_contract {
+
+    Let the user select a category tree which will be copied into the current category tree
+
+    @author Timo Hentschel (thentschel@sussdorff-roy.com)
+    @cvs-id $Id:
+} {
+    tree_id:integer
+    {locale ""}
+    object_id:integer,optional
+} -properties {
+    page_title:onevalue
+    context_bar:onevalue
+    locale:onevalue
+    trees:multirow
+    tree_id:onevalue
+    url_vars:onevalue
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+permission::require_permission -object_id $tree_id -privilege category_tree_write
+
+set url_vars [export_url_vars locale object_id]
+set page_title "Choose a tree to copy"
+array set tree [category_tree::get_data $tree_id $locale]
+set tree_name $tree(tree_name)
+
+if {[info exists object_id]} {
+    set context_bar [list [category::get_object_context $object_id] [list "one-object?[export_url_vars locale object_id]" "Category Management"]]
+} else {
+    set context_bar [list [list ".?[export_url_vars locale]" "Category Management"]]
+}
+lappend context_bar [list "tree-view?[export_url_vars tree_id locale object_id]" $tree_name] "Copy a tree"
+
+template::multirow create trees tree_id tree_name site_wide_p
+
+db_foreach trees_select {
+    select tree_id as source_tree_id, site_wide_p,
+           acs_permission.permission_p(tree_id, :user_id, 'category_tree_read') as has_read_p
+    from category_trees
+    where tree_id <> :tree_id
+} {
+    if {$site_wide_p == "t" || $has_read_p == "t"} {
+	set source_tree_name [category_tree::get_name $source_tree_id $locale]
+	template::multirow append trees $source_tree_id $source_tree_name $site_wide_p
+    }
+}
+
+ad_return_template
Index: openacs-4/packages/categories/www/cadmin/tree-delete-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/tree-delete-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/tree-delete-2.tcl	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,29 @@
+ad_page_contract {
+
+    This page checks whether the category tree can be deleted and deletes it.
+
+    @author Timo Hentschel (thentschel@sussdorff-roy.com)
+    @cvs-id $Id:
+} {
+    tree_id:integer,notnull
+    {locale ""}
+    object_id:integer,optional
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+permission::require_permission -object_id $tree_id -privilege category_tree_write
+
+set instance_list [category_tree::usage $tree_id]
+
+if {[llength $instance_list] > 0} {
+    ad_return_complaint 1 "This category tree is still in use."
+    return
+}
+
+category_tree::delete $tree_id
+
+if {![info exists object_id]} {
+    ad_returnredirect ".?[export_url_vars locale]"
+} else {
+    ad_returnredirect "one-object?[export_url_vars locale object_id]"
+}
Index: openacs-4/packages/categories/www/cadmin/tree-delete.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/tree-delete.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/tree-delete.adp	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,35 @@
+<master src="master">
+<property name="page_title">@page_title;noquote@</property>
+<property name="context_bar">@context_bar;noquote@</property>
+<property name="locale">@locale@</property>
+
+<p>
+<table>
+  <tr><th>Tree Name</th><td>@tree_name@</td></tr>
+  <tr><th>Description</th><td> @tree_description@</td></tr>
+</table>
+</p>
+
+<if @instances_using_p@ eq t>
+  This tree is still used by some modules. For a complete list, please go
+  <a href="tree-usage?@url_vars;noquote@">here</a>.
+</if>
+
+<if @used_categories:rowcount@ gt 0>
+  <p>The following categories of this tree are still in use:
+  <ul><multiple name=used_categories><li>@used_categories.name@</li></multiple></ul>
+</if>
+
+<if @instances_using_p@ ne t>
+  Are you sure you want to delete the tree "@tree_name@"?
+  <center>
+    <form action="tree-delete-2">
+      @form_vars;noquote@
+      <input type=submit value="Yes">
+    </form>  
+    <form action="tree-view">
+      @form_vars;noquote@
+      <input type=submit value="No">
+    </form>  
+  </center>
+</if>
Index: openacs-4/packages/categories/www/cadmin/tree-delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/tree-delete.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/tree-delete.tcl	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,62 @@
+ad_page_contract {
+
+    This page checks whether the category tree can be deleted and asks for confirmation.
+
+    @author Timo Hentschel (thentschel@sussdorff-roy.com)
+    @cvs-id $Id:
+} {
+    tree_id:integer,notnull
+    {locale ""}
+    object_id:integer,optional
+} -properties {
+    page_title:onevalue
+    context_bar:onevalue
+    locale:onevalue
+    tree_name:onevalue
+    tree_description:onevalue
+    instances_using_p:onevalue
+    form_vars:onevalue
+    url_vars:onevalue
+    used_categories:multirow
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+permission::require_permission -object_id $tree_id -privilege category_tree_write
+
+array set tree [category_tree::get_data $tree_id $locale]
+set tree_name $tree(tree_name)
+set tree_description $tree(description)
+
+set page_title "Delete Category Tree \"$tree_name\""
+if {[info exists object_id]} {
+    set context_bar [list [category::get_object_context $object_id] [list "one-object?[export_url_vars locale object_id]" "Category Management"]]
+} else {
+    set context_bar [list [list ".?[export_url_vars locale]" "Category Management"]]
+}
+lappend context_bar [list "tree-view?[export_url_vars tree_id locale object_id]" $tree_name] Delete
+
+set instance_list [category_tree::usage $tree_id]
+
+if {[llength $instance_list] > 0} {
+    set instances_using_p t
+} else {
+    set instances_using_p f
+}
+
+set form_vars [export_form_vars tree_id locale object_id]
+set url_vars [export_url_vars tree_id locale object_id]
+
+template::multirow create used_categories category_id name
+
+db_foreach get_category_in_use {
+    select category_id
+    from categories c
+    where c.tree_id = :tree_id
+    and exists (select 1 from category_object_map
+                 where category_id = c.category_id)
+} {
+    set category_name [category::get_name $category_id $locale]
+    template::multirow append used_categories $category_id $category_name
+}
+
+ad_return_template
Index: openacs-4/packages/categories/www/cadmin/tree-delete.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/tree-delete.xql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/tree-delete.xql	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,17 @@
+<?xml version="1.0"?>
+<queryset>
+
+<fullquery name="get_category_in_use">      
+      <querytext>
+      
+    select category_id
+    from categories c
+    where c.tree_id = :tree_id
+    and exists (select 1 from category_object_map
+                 where category_id = c.category_id)
+
+      </querytext>
+</fullquery>
+
+ 
+</queryset>
Index: openacs-4/packages/categories/www/cadmin/tree-form.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/tree-form.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/tree-form.adp	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,8 @@
+<master src="master">
+<property name="page_title">@page_title@</property>
+<property name="context_bar">@context_bar;noquote@</property>
+<property name="change_locale">f</property>
+
+<blockquote>
+  <formtemplate id="tree_form"></formtemplate>
+</blockquote>
Index: openacs-4/packages/categories/www/cadmin/tree-form.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/tree-form.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/tree-form.tcl	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,69 @@
+ad_page_contract {
+    Form to add/edit a category tree.
+
+    @author Timo Hentschel (thentschel@sussdorff-roy.com)
+    @cvs-id $Id:
+} {
+    tree_id:integer,optional
+    {locale ""}
+    object_id:integer,optional
+} -properties {
+    context_bar:onevalue
+    page_title:onevalue
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+set package_id [ad_conn package_id]
+
+if {[info exists tree_id]} {
+    set page_title "Edit tree"
+} else {
+    set page_title "Add tree"
+}
+
+if {[info exists object_id]} {
+    set context_bar [list [category::get_object_context $object_id] [list "one-object?[export_url_vars locale object_id]" "Category Management"]]
+} else {
+    set context_bar [list [list ".?[export_url_vars locale]" "Category Management"]]
+}
+lappend context_bar $page_title
+
+set languages [db_list_of_lists get_ad_locales {
+    select label as name, locale as value
+    from ad_locales
+}]
+
+ad_form -name tree_form -action tree-form -export { locale object_id } -form {
+    {tree_id:key}
+    {tree_name:text {label "Name"} {html {size 50 maxlength 50}}}
+    {language:text(select) {label "Language"} {value $locale} {options $languages}}
+    {description:text(textarea),optional {label "Description"} {html {rows 5 cols 80}}}
+} -new_request {
+    permission::require_permission -object_id $package_id -privilege category_admin
+    set tree_name ""
+    set description ""
+} -edit_request {
+    permission::require_permission -object_id $tree_id -privilege category_tree_write
+    set action Edit
+    util_unlist [category_tree::get_translation $tree_id $locale] tree_name description
+} -on_submit {
+    set description [util_close_html_tags $description 4000]
+} -new_data {
+    db_transaction {
+	category_tree::add -tree_id $tree_id -name $tree_name -description $description -locale $language -context_id $package_id
+	if { [info exists object_id] } {
+	    category_tree::map -tree_id $tree_id -object_id $object_id
+	    set return_url "one-object?[export_url_vars locale object_id]"
+	} else {
+	    set return_url ".?[export_url_vars locale]"
+	}
+    }
+} -edit_data {
+    category_tree::update -tree_id $tree_id -name $tree_name -description $description -locale $language
+    set return_url "tree-view?[export_url_vars tree_id locale object_id]"
+} -after_submit {
+    ad_returnredirect $return_url
+    ad_script_abort
+}
+
+ad_return_template
Index: openacs-4/packages/categories/www/cadmin/tree-form.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/Attic/tree-form.xql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/tree-form.xql	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,14 @@
+<?xml version="1.0"?>
+<queryset>
+
+<fullquery name="get_ad_locales">      
+      <querytext>
+      
+    select label as name, locale as value
+    from ad_locales
+
+      </querytext>
+</fullquery>
+
+ 
+</queryset>
Index: openacs-4/packages/categories/www/cadmin/tree-map.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/tree-map.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/tree-map.tcl	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,25 @@
+ad_page_contract {
+    
+    This script assigns one category tree to an object.
+
+    @author Timo Hentschel (thentschel@sussdorff-roy.com)
+    @cvs-id $Id:
+} {
+    tree_id:integer,notnull
+    {locale ""}
+    object_id:integer,notnull
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+permission::require_permission -object_id $object_id -privilege admin
+
+array set tree [category_tree::get_data $tree_id $locale]
+if {$tree(site_wide_p) == "f"} {
+    permission::require_permission -object_id $tree_id -privilege category_tree_read
+}
+
+category_tree::map -tree_id $tree_id -object_id $object_id
+
+set return_url "one-object?[export_url_vars locale object_id]"
+
+ad_returnredirect $return_url
Index: openacs-4/packages/categories/www/cadmin/tree-unmap-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/tree-unmap-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/tree-unmap-2.tcl	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,23 @@
+ad_page_contract {
+
+    Unmapping a category tree from an object.
+
+    @author Timo Hentschel (thentschel@sussdorff-roy.com)
+    @cvs-id $Id:
+} {
+    tree_id:integer,notnull
+    {locale ""}
+    object_id:integer,notnull
+} 
+
+set user_id [ad_maybe_redirect_for_registration]
+permission::require_permission -object_id $object_id -privilege admin
+
+array set tree [category_tree::get_data $tree_id $locale]
+if {$tree(site_wide_p) == "f"} {
+    permission::require_permission -object_id $tree_id -privilege category_tree_read
+}
+
+category_tree::unmap -tree_id $tree_id -object_id $object_id
+
+ad_returnredirect "one-object?[export_url_vars locale object_id]"
Index: openacs-4/packages/categories/www/cadmin/tree-unmap.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/tree-unmap.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/tree-unmap.adp	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,20 @@
+<master src="master">
+<property name="page_title">@page_title;noquote@</property>
+<property name="context_bar">@context_bar;noquote@</property>
+<property name="locale">@locale@</property>
+
+Are you sure you want to unmap the tree "@tree_name@" from "@object_name@"?
+
+<center>
+<form action="tree-unmap-2">
+  @form_vars;noquote@
+  <input type=submit value="Yes">
+</form>  
+
+
+<form action="one-object">
+  @cancel_form_vars;noquote@
+  <input type=submit value="No">
+</form>  
+
+</center>
Index: openacs-4/packages/categories/www/cadmin/tree-unmap.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/tree-unmap.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/tree-unmap.tcl	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,39 @@
+ad_page_contract {
+
+    Unmapping a category tree from an object.
+
+    @author Timo Hentschel (thentschel@sussdorff-roy.com)
+    @cvs-id $Id:
+} {
+    tree_id:integer,notnull
+    {locale ""}
+    object_id:integer,notnull
+} -properties {
+    page_title:onevalue
+    context_bar:onevalue
+    locale:onevalue
+    tree_name:onevalue
+    object_name:onevalue
+    form_vars:onevalue
+    cancel_form_vars:onevalue
+}
+ 
+set user_id [ad_maybe_redirect_for_registration]
+permission::require_permission -object_id $object_id -privilege admin
+
+array set tree [category_tree::get_data $tree_id $locale]
+if {$tree(site_wide_p) == "f"} {
+    permission::require_permission -object_id $tree_id -privilege category_tree_read
+}
+
+set page_title "Unmap tree"
+set form_vars [export_form_vars tree_id locale object_id]
+set cancel_form_vars [export_form_vars locale object_id]
+
+set object_context [category::get_object_context $object_id]
+set object_name [lindex $object_context 1]
+set tree_name $tree(tree_name)
+
+set context_bar [list $object_context [list "one-object?[export_url_vars locale object_id]" "Category Management"] "Unmap \"$tree_name\""]
+
+ad_return_template
Index: openacs-4/packages/categories/www/cadmin/tree-update-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/Attic/tree-update-2.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/tree-update-2.tcl	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,48 @@
+ad_page_contract {
+    Bulk delete of categories.
+
+    @author Timo Hentschel (thentschel@sussdorff-roy.com)
+    @cvs-id $Id:
+} {
+    category_ids:integer,multiple
+    tree_id:integer
+    {locale ""}
+    object_id:integer,optional
+}
+
+permission::require_permission -object_id $tree_id -privilege category_tree_write
+
+set list_of_errors ""
+
+db_transaction {
+    # use temporary table to use only bind vars in queries
+    foreach category_id $category_ids {
+	db_dml insert_tmp_categories {
+	    insert into category_temp
+	    values (:category_id)
+	}
+    }
+
+    # delete first leaf categories, then parent categories
+    set category_list [db_list sort_categories_to_delete {
+	select c.category_id
+	from categories c, category_temp t
+	where c.category_id = t.category_id
+	order by right_ind-left_ind
+    }]
+
+    foreach category_id $category_list {
+	category::delete -batch_mode $category_id
+    }
+    category::reset_translation_cache
+    category_tree::flush_cache $tree_id
+} on_error {
+    append list_of_errors "<li> Node [category::get_name $category_id $locale] contains leaf (child) categories. If you really want to delete those leaf categories, plesae delete them first"	
+}
+    
+if { [llength $list_of_errors] >0 } {
+    ad_return_complaint "Error Deleting Nodes" $list_of_errors
+    return
+}
+
+ad_returnredirect "tree-view?[export_url_vars tree_id locale object_id]"
Index: openacs-4/packages/categories/www/cadmin/tree-update-2.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/Attic/tree-update-2.xql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/tree-update-2.xql	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,26 @@
+<?xml version="1.0"?>
+<queryset>
+
+<fullquery name="insert_tmp_categories">      
+      <querytext>
+      
+	    insert into category_temp
+	    values (:category_id)
+	
+      </querytext>
+</fullquery>
+
+ 
+<fullquery name="sort_categories_to_delete">      
+      <querytext>
+      
+	select c.category_id
+	from categories c, category_temp t
+	where c.category_id = t.category_id
+	order by right_ind-left_ind
+    
+      </querytext>
+</fullquery>
+
+ 
+</queryset>
Index: openacs-4/packages/categories/www/cadmin/tree-update-oracle.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/Attic/tree-update-oracle.xql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/tree-update-oracle.xql	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,20 @@
+<?xml version="1.0"?>
+
+<queryset>
+   <rdbms><type>oracle</type><version>8.1.6</version></rdbms>
+
+<fullquery name="get_used_categories">      
+      <querytext>
+      
+	    select c.category_id,
+	    (select case when count(*) = 0 then 0 else 1 end from dual
+	     where exists (select 1 from category_object_map
+			   where category_id = c.category_id)) as used_p
+	    from categories c, category_temp t
+	    where c.category_id = t.category_id
+	
+      </querytext>
+</fullquery>
+
+ 
+</queryset>
Index: openacs-4/packages/categories/www/cadmin/tree-update-postgresql.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/Attic/tree-update-postgresql.xql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/tree-update-postgresql.xql	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,20 @@
+<?xml version="1.0"?>
+
+<queryset>
+   <rdbms><type>postgresql</type><version>7.1</version></rdbms>
+
+<fullquery name="get_used_categories">      
+      <querytext>
+      
+	    select c.category_id,
+	    (select case when count(*) = 0 then 0 else 1 end 
+	     where exists (select 1 from category_object_map
+			   where category_id = c.category_id)) as used_p
+	    from categories c, category_temp t
+	    where c.category_id = t.category_id
+	
+      </querytext>
+</fullquery>
+
+ 
+</queryset>
Index: openacs-4/packages/categories/www/cadmin/tree-update.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/Attic/tree-update.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/tree-update.adp	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,28 @@
+<master src="master">
+<property name="page_title">@page_title;noquote@</property>
+<property name="context_bar">@context_bar;noquote@</property>
+<property name="locale">@locale@</property>
+
+Are you sure that you want to delete these categories?
+<ul>
+<multiple name=categories>
+<li>@categories.name@<if @categories.used_p@ eq 1> (<font color=red>still used</font>)</if></li>
+</multiple>
+</ul>
+
+<p><table>
+<tr>
+  <td>
+    <form action="tree-update-2" method=post>
+      @form_vars_delete;noquote@
+      <input type=submit name=submit value="Yes, Proceed">
+    </form>
+ </td> 
+ <td>
+    <form action="tree-view" method=get>
+      @form_vars_cancel;noquote@
+      <input type=submit name=submit value="No, Cancel">
+    </form>
+  </td>
+ </tr>
+</table>
Index: openacs-4/packages/categories/www/cadmin/tree-update.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/Attic/tree-update.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/tree-update.tcl	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,182 @@
+ad_page_contract {
+    Bulk operation on a category tree:
+    sort, phase in, phase out, delete
+
+    @author Timo Hentschel (thentschel@sussdorff-roy.com)
+    @cvs-id $Id:
+} {
+    tree_id:integer
+    sort_key:array
+    {check:array ""}
+    {submit_sort ""}
+    {submit_phase_in ""}
+    {submit_phase_out ""}
+    {submit_delete ""}
+    {locale ""}
+    object_id:integer,optional
+} -properties {
+    page_title:onevalue
+    context_bar:onevalue
+    locale:onevalue
+    categories:multirow
+    form_vars_delete:onevalue
+    form_vars_cancel:onevalue
+}
+
+permission::require_permission -object_id $tree_id -privilege category_tree_write
+
+array set tree [category_tree::get_data $tree_id $locale]
+
+if {![empty_string_p $submit_sort]} {
+	
+    db_transaction {
+
+	set count 0
+	db_foreach get_tree {
+	    select category_id, parent_id
+	    from categories
+	    where tree_id = :tree_id
+	    order by left_ind
+	} {
+	    incr count 10
+	    if {[empty_string_p $parent_id]} {
+		# need this as an anchor for toplevel categories
+		set parent_id -1
+	    }
+	    if {[info exists sort_key($category_id)]} {
+		lappend child($parent_id) [list $sort_key($category_id) $category_id 0 0]
+	    } else {
+		lappend child($parent_id) [list $count $category_id 0 0]
+	    }
+	}
+	set last_ind [expr ($count / 5) + 1]
+
+	set count 1
+	set stack [list]
+	set done_list [list]
+	# put toplevel categories on stack
+	if {[info exists child(-1)]} {
+	    set stack [lsort -integer -index 0 $child(-1)]
+	}
+
+	while {[llength $stack] > 0} {
+	    set next [lindex $stack 0]
+	    set act_category [lindex $next 1]
+	    set stack [lrange $stack 1 end]
+	    if {[lindex $next 2]>0} {
+		## the children of this parent are done, so this category is also done
+		lappend done_list [list $act_category [lindex $next 2] $count]
+	    } elseif {[info exists child($act_category)]} {
+		## put category and all children back on stack
+		set next [lreplace $next 2 2 $count]
+		set stack [linsert $stack 0 $next]
+		set stack [concat [lsort -integer -index 0 $child($act_category)] $stack]
+	    } else {
+		## this category has no children, so it is done
+		lappend done_list [list $act_category $count [expr $count + 1]]
+		incr count 1
+	    }
+	    incr count 1
+	}
+
+	if {$count == $last_ind} {
+	    # we do this so that there is no conflict in the old left_inds and the new ones
+	    db_dml reset_category_index {
+		update categories
+		set left_ind = -left_ind,
+		right_ind = -right_ind
+		where tree_id = :tree_id
+	    }
+
+	    foreach category $done_list {
+		util_unlist $category category_id left_ind right_ind
+		db_dml update_category_index {
+		    update categories
+		    set left_ind = :left_ind,
+		    right_ind = :right_ind
+		    where category_id = :category_id
+		}
+	    }
+	}
+	category_tree::flush_cache $tree_id
+    }
+
+    if {$count != $last_ind} {
+	ad_return_complaint 1 "Error during update: $done_list"
+	return
+    }
+    ad_returnredirect "tree-view?[export_url_vars tree_id locale object_id]"
+    return
+
+} elseif {![empty_string_p $submit_phase_in]} {
+	
+    db_transaction {
+	foreach category_id [array names check] {
+	    category::phase_in $category_id
+	}
+	category_tree::flush_cache $tree_id
+    }
+
+    ad_returnredirect "tree-view?[export_url_vars tree_id locale object_id]"
+    return
+   
+} elseif {![empty_string_p $submit_phase_out]} {
+
+    db_transaction {
+	foreach category_id [array names check] {
+	    category::phase_out $category_id
+	}
+	category_tree::flush_cache $tree_id
+    }
+
+    ad_returnredirect "tree-view?[export_url_vars tree_id locale object_id]"
+    return
+
+} elseif {![empty_string_p $submit_delete]} {
+
+    set category_ids [array names check]
+    set page_title "Delete Confirmation Page"
+    set tree_name $tree(tree_name)
+
+    if {[info exists object_id]} {
+	set context_bar [list [category::get_object_context $object_id] [list "one-object?[export_url_vars locale object_id]" "Category Management"]]
+    } else {
+	set context_bar [list [list ".?[export_url_vars locale]" "Category Management"]]
+    }
+    lappend context_bar [list "tree-view?[export_url_vars tree_id locale object_id]" $tree_name] "Delete categories"
+
+    set form_vars_cancel [export_form_vars tree_id locale object_id]
+    set form_vars_delete [export_form_vars category_ids:multiple tree_id locale object_id]
+
+    template::multirow create categories category_id name used_p
+    db_transaction {
+	# use temporary table to use only bind vars in queries
+	foreach category_id $category_ids {
+	    db_dml insert_tmp_categories {
+		insert into category_temp
+		values (:category_id)
+	    }
+	}
+	
+	db_foreach get_used_categories {
+	    select c.category_id,
+	    (select decode(count(*),0,0,1) from dual
+	     where exists (select 1 from category_object_map
+			   where category_id = c.category_id)) as used_p
+	    from categories c, category_temp t
+	    where c.category_id = t.category_id
+	} {
+	    set category_name [category::get_name $category_id $locale]
+	    template::multirow append categories $category_id $category_name $used_p
+	}
+    }
+
+} else {
+
+    ns_log Warning "Unhandled user input in packages/categories/www/tree-update.tcl"
+    ad_returnredirect "tree-view?[export_url_vars tree_id locale object_id pass]"
+    return
+
+}
+
+ad_return_template
Index: openacs-4/packages/categories/www/cadmin/tree-update.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/Attic/tree-update.xql,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/tree-update.xql	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,50 @@
+<?xml version="1.0"?>
+<queryset>
+
+<fullquery name="get_tree">      
+      <querytext>
+      
+	    select category_id, parent_id
+	    from categories
+	    where tree_id = :tree_id
+	    order by left_ind
+	
+      </querytext>
+</fullquery>
+
+ 
+<fullquery name="reset_category_index">      
+      <querytext>
+      
+		update categories
+		set left_ind = -left_ind,
+		right_ind = -right_ind
+		where tree_id = :tree_id
+	    
+      </querytext>
+</fullquery>
+
+ 
+<fullquery name="update_category_index">      
+      <querytext>
+      
+		    update categories
+		    set left_ind = :left_ind,
+		    right_ind = :right_ind
+		    where category_id = :category_id
+		
+      </querytext>
+</fullquery>
+
+ 
+<fullquery name="insert_tmp_categories">      
+      <querytext>
+      
+		insert into category_temp
+		values (:category_id)
+	    
+      </querytext>
+</fullquery>
+
+ 
+</queryset>
Index: openacs-4/packages/categories/www/cadmin/tree-usage.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/tree-usage.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/tree-usage.adp	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,29 @@
+<master src="master">
+<property name="page_title">@page_title;noquote@</property>
+<property name="context_bar">@context_bar;noquote@</property>
+<property name="locale">@locale@</property>
+
+<p>
+<table>
+  <tr><th>Tree Name</th><td>@tree_name@</td></tr>
+  <tr><th>Description</th><td> @tree_description@</td></tr>
+</table>
+</p>
+
+<multiple name=modules>
+  <b>@modules.package@:</b><ul>
+  <group column=package>
+    </ul><if @modules.object_name@ ne @modules.instance_name@>@modules.instance_name@</if><ul>
+    <group column=package_id>
+      <li><a href="/o/@modules.object_id@">@modules.object_name@</a></li>
+    </group>
+  </group>
+  </ul>
+</multiple>
+<if @instances_without_permission@ gt 0>
+  There are @instances_without_permission@ more uses of this tree, but you
+  don't have the permission to see them.
+</if>
+<if @modules:rowcount@ eq 0 and @instances_without_permission@ eq 0>
+  This tree is not used.
+</if>
Index: openacs-4/packages/categories/www/cadmin/tree-usage.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/tree-usage.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/tree-usage.tcl	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,54 @@
+ad_page_contract {
+
+    This page shows all the package instanes mapped to a particular category tree.
+
+    @author Timo Hentschel (thentschel@sussdorff-roy.com)
+    @cvs-id $Id:
+} {
+    tree_id:integer,notnull
+    {locale ""}
+    object_id:integer,optional
+} -properties {
+    page_title:onevalue
+    context_bar:onevalue
+    locale:onevalue
+    tree_name:onevalue
+    tree_description:onevalue
+    modules:multirow
+    instances_without_permission:onevalue
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+
+array set tree [category_tree::get_data $tree_id $locale]
+if {$tree(site_wide_p) == "f"} {
+    permission::require_permission -object_id $tree_id -privilege category_tree_read
+}
+
+set tree_name $tree(tree_name)
+set tree_description $tree(description)
+set page_title "Modules using Category Tree \"$tree_name\""
+
+if {[info exists object_id]} {
+    set context_bar [list [category::get_object_context $object_id] [list "one-object?[export_url_vars locale object_id]" "Category Management"]]
+} else {
+    set context_bar [list [list ".?[export_url_vars locale]" "Category Management"]]
+}
+lappend context_bar [list "tree-view?[export_url_vars tree_id locale object_id]" $tree_name] Usage
+
+
+template::multirow create modules package object_id object_name package_id instance_name read_p
+
+set instance_list [category_tree::usage $tree_id]
+
+set instances_without_permission 0
+foreach instance $instance_list {
+    util_unlist $instance package object_id object_name package_id instance_name read_p
+    if {$read_p == "t"} {
+	template::multirow append modules $package $object_id $object_name $package_id $instance_name $read_p
+    } else {
+	incr instances_without_permission
+    }
+}
+
+ad_return_template
Index: openacs-4/packages/categories/www/cadmin/tree-view-simple.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/Attic/tree-view-simple.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/tree-view-simple.adp	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,15 @@
+<master src="master">
+<property name="page_title">@page_title;noquote@</property>
+<property name="context_bar">@context_bar;noquote@</property>
+<property name="locale">@locale@</property>
+
+<table>
+  <if @tree:rowcount@ ne 0>
+    <tr><th> Category Name</th></tr>
+  </if>
+  <ul>
+  <multiple name="tree">
+    <tr><td><li>@tree.left_indent;noquote@ @tree.category_name@ </tr>
+  </multiple>
+  </ul>
+</table>
Index: openacs-4/packages/categories/www/cadmin/tree-view-simple.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/Attic/tree-view-simple.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/tree-view-simple.tcl	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,46 @@
+ad_page_contract {
+
+    Display a simple view of a category tree.
+
+    @author Timo Hentschel (thentschel@sussdorff-roy.com)
+    @cvs-id $Id:
+} {
+    tree_id:integer
+    target_tree_id:integer
+    {locale ""}
+    object_id:integer,optional
+} -properties {
+    page_title:onevalue
+    context_bar:onevalue
+    locale:onevalue
+    tree:multirow
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+
+array set target_tree [category_tree::get_data $target_tree_id $locale]
+set target_tree_name $target_tree(tree_name)
+if {$target_tree(site_wide_p) == "f"} {
+    permission::require_permission -object_id $tree_id -privilege category_tree_read
+}
+array set one_tree [category_tree::get_data $tree_id $locale]
+set tree_name $one_tree(tree_name)
+
+set page_title "Simplified tree view"
+
+if {[info exists object_id]} {
+    set context_bar [list [category::get_object_context $object_id] [list "one-object?[export_url_vars locale object_id]" "Category Management"]]
+} else {
+    set context_bar [list [list ".?[export_url_vars locale]" "Category Management"]]
+}
+lappend context_bar [list "tree-view?[export_url_vars tree_id locale object_id]" $target_tree_name] [list "tree-copy?tree_id=$target_tree_id&[export_url_vars locale object_id]" "Copy a tree"] "View \"$tree_name\""
+
+template::multirow create tree category_name deprecated_p level left_indent
+
+foreach category [category_tree::get_tree -all $tree_id $locale] {
+    util_unlist $category category_id category_name deprecated_p level
+
+    template::multirow append tree $category_name $deprecated_p $level [category::repeat_string "&nbsp;" [expr ($level-1)*5]]
+}
+
+ad_return_template
Index: openacs-4/packages/categories/www/cadmin/tree-view.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/tree-view.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/tree-view.adp	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,98 @@
+<master src="master">
+<property name="page_title">@page_title;noquote@</property>
+<property name="context_bar">@context_bar;noquote@</property>
+<property name="locale">@locale@</property>
+
+<p>
+<table>
+  <tr><th>Tree Name</th><td>@tree_name@</td></tr>
+  <tr><th>Description</th><td> @tree_description@</td></tr>
+</table>
+</p>
+
+<ul>
+
+<if @can_grant_p@ eq 1>
+    <li><a href="permission-manage?@url_vars;noquote@">Manage permissions</a>
+    <p>
+</if> 
+
+<if @can_write_p@ eq 1 >
+  <li><a href="tree-form?@url_vars;noquote@">Edit tree name and description</a>
+  <p>
+  <li><a href="category-form?@url_vars;noquote@">Add node at top level</a>
+  <p>
+  <li><a href="tree-copy?@url_vars;noquote@">Copy an existing tree</a>
+  <p>
+  <li><a href="tree-delete?@url_vars;noquote@">Delete this tree</a>
+  <p>
+  <li><a href="tree-usage?@url_vars;noquote@">Show modules using this tree</a>
+  <p>
+</if>
+
+</ul>
+
+
+<if @one_tree:rowcount@ gt 0>
+
+
+  <form name="one_tree" action="tree-update">
+  @form_vars;noquote@
+  <table>
+   <tr><th>&nbsp</th><th>Category Name</th><th>Hierarchy Level</th><if @can_write_p@ eq 1><th> Sort Key </th></if></tr>
+    <multiple name="one_tree">
+      <tr>
+        <td> 
+          <if @can_write_p@ eq "1">       
+            <input name=check.@one_tree.category_id@ type=checkbox>
+          </if>
+        </td>
+        <td> 
+          @one_tree.left_indent;noquote@ @one_tree.category_name@ 
+          <if @can_write_p@ eq 1>
+               [ <font size=-1>
+                   <a href="category-set-parent?@url_vars;noquote@&category_id=@one_tree.category_id@">Choose a new parent</a> 
+                 | <a href="category-form?@url_vars;noquote@&parent_id=@one_tree.category_id@">Add child</a> 
+                  
+                 | <a href="category-form?@url_vars;noquote@&category_id=@one_tree.category_id@"> Edit </a> 
+                 | <a href="category-delete?category_id=@one_tree.category_id@&@url_vars;noquote@"> Delete </a>  
+                 | <if @one_tree.deprecated_p@ eq f><a href="category-phase-out?phase_out_p=1&category_id=@one_tree.category_id@&@url_vars;noquote@"> Phase out </a> </if>
+                      <else><a href="category-phase-out?phase_out_p=0&category_id=@one_tree.category_id@&@url_vars;noquote@"> Phase in </a></else>
+                 | <a href="category-usage?category_id=@one_tree.category_id@&@url_vars;noquote@"> Show Usage </a>
+               </font> ] 
+          </if>
+        </td>
+        <td align=center> 
+            @one_tree.level@ 
+        </td>
+        <if @can_write_p@ eq "1">
+           <td>
+             @one_tree.left_indent;noquote@ <input name=sort_key.@one_tree.category_id@ value="@one_tree.sort_key@">
+           </td>
+        </if>
+      </tr>  
+    </multiple>
+    <if @can_write_p@ eq "1"> 
+     
+     <tr><td>    
+          <input type=submit name="submit_delete" value="Delete">
+          </td> 
+      <td>
+	 <input type=submit name="submit_phase_in" value="Phase In">
+          <input type=submit  name="submit_phase_out" value="Phase Out">
+     
+      </td>
+      <td>
+      </td>
+        <td>
+            <input type=submit name="submit_sort" value="Save Sort Keys">
+        </td>
+      </tr>
+      </if>
+      </table>
+  </form>
+
+</if>
+<else>
+ <I> no categories have been created... </i>
+</else>
Index: openacs-4/packages/categories/www/cadmin/tree-view.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/cadmin/tree-view.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/cadmin/tree-view.tcl	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,58 @@
+ad_page_contract {
+
+    Display a category tree
+
+    @author Timo Hentschel (thentschel@sussdorff-roy.com)
+    @cvs-id $Id:
+} {
+    tree_id:integer,notnull
+    {locale ""}
+    object_id:integer,optional
+} -properties {
+    page_title:onevalue
+    tree_name:onevalue
+    tree_description:onevalue
+    context_bar:onevalue
+    locale:onevalue
+    one_tree:multirow
+    form_vars:onevalue
+    url_vars:onevalue
+    can_grant_p:onevalue
+    can_write_p:onevalue
+}
+
+set user_id [ad_maybe_redirect_for_registration]
+
+array set tree [category_tree::get_data $tree_id $locale]
+if {$tree(site_wide_p) == "f"} {
+    permission::require_permission -object_id $tree_id -privilege category_tree_read
+}
+
+set url_vars [export_url_vars tree_id locale object_id]
+set form_vars [export_form_vars tree_id locale object_id]
+
+set tree_name $tree(tree_name)
+set tree_description $tree(description)
+
+set page_title "Category Tree \"$tree_name\""
+if {[info exists object_id]} {
+    set context_bar [list [category::get_object_context $object_id] [list "one-object?[export_url_vars locale object_id]" "Category Management"] $tree_name]
+} else {
+    set context_bar [list [list ".?[export_url_vars locale]" "Category Management"] $tree_name]
+}
+
+set can_write_p [permission::permission_p -object_id $tree_id -privilege category_tree_write]
+set can_grant_p [permission::permission_p -object_id $tree_id -privilege category_tree_grant_permissions]
+
+template::multirow create one_tree category_name sort_key category_id deprecated_p level left_indent
+
+set sort_key 0
+
+foreach category [category_tree::get_tree -all $tree_id $locale] {
+    util_unlist $category category_id category_name deprecated_p level
+    incr sort_key 10
+
+    template::multirow append one_tree $category_name $sort_key $category_id $deprecated_p $level [category::repeat_string "&nbsp;" [expr ($level-1)*5]]
+}
+
+ad_return_template
Index: openacs-4/packages/categories/www/doc/index.html
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/doc/index.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/doc/index.html	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,237 @@
+<html>
+<head>
+   <title>Categories</title>
+</head>
+<body bgcolor="#FFFFFF">
+
+<h2>Categories</h2>
+<hr>
+<a href="o">Object Names and IdHandler Service Contract</a>
+<h3>Functionality overview</h3>
+
+Categories are organized in separate category trees.<br>
+
+When a package admin clicks on an Administer Categories link, they are presented with
+a page that shows the following items: 
+
+<ul>
+<li> list of trees currently mapped to the object (this "object" will be usually a package
+    instance)
+<li> list of trees that can be mapped to the object ,
+    those trees are just the trees that the admin has the 'category_read' permission on
+<li> link to create and map a new category tree
+
+</ul>
+Creating a new tree involves entering tree name and description.
+The name must be unique among all the trees.
+<br>
+Upon creation of a tree, the admin is granted the 'category_read' and 'category_write' permisssions.
+<br>
+Normally, the category_write permission should not be shared with anybody else,
+in the rare cases when granting this permission to another party is needed,
+site-wide admin intervention will be required.
+<p>
+In addition to mapping an entire tree to an object, admins have the option
+of mapping only a subtree of an existing tree. To do that, they have to click on
+a "Map subtree" link, after which they will see a list of tree nodes. 
+<br>The mapped subtree will consist of all subcategories of the category
+the user selected - the category itself will not be included.
+Note that the mapped subtree will not be a new tree. Therefore
+this option should be used only if an admin plans to use the subtree 'as
+is' and has no intention of making changes to it.
+<p>
+An alternative solution is available for admins who want to
+create a tree by copying one of the existing trees and subsequently
+playing around with it (moving/adding/deleting categories).
+To accomplish that, they would have to create a new tree,
+go to the admin page for this tree and click on a "Copy existing
+tree" link. They will see a list of available trees to copy. Clicking on the "Copy this one" link will result
+in creating copies of the categories from the source
+trees and placing them in the new tree.
+<br> This operation
+can be performed several times, each time the copied
+categories will be placed as toplevel categories of the tree.
+<p>
+As far as unmapping is concerned, this operation 
+doesn't delete the mapping between categories and objects.
+
+
+<p>
+<b>Permissions</b>
+<p>The creator of the category tree is granted the category_tree_read, category_tree_write
+and category_tree_grant_permissions privileges. 
+<br> 
+
+
+<p>
+<p> 
+<b>The operations one can perform on categories are:</b>
+<ul>
+<li>(a) changing of a parent
+<li>(b) adding childen
+<li>(c) deleting
+<li>(d) editing
+<li>(e) phasing in/out
+<li>(f) changing sort key
+</ul>
+<p>
+ad (d) You cannot delete a category that has children.
+Also, you cannot delete a category that has objects mapped to it (do we want it or not?)
+<br>
+ad (e) The effect of phasing out a category is that users no longer will be able to associate objects
+with it, but existing associations will still be visible
+<br>
+Deletions and phasing it/out can be performed as bulk operations.
+<br>
+ad (f) sort key is used to order children of the same parent category,
+that is the elements of the tree are sorted first by parent, then 
+by the sort key.
+ 
+<p>
+
+
+<hr>
+<b>Datamodel</b>
+
+<p>This table actually stores the information whether the tree is side-wide or not.
+<pre>
+create table category_trees (
+       tree_id			integer primary key
+                                constraint cat_trees_tree_id_fk
+                                references acs_objects on delete cascade,
+       site_wide_p		char(1) default 't'
+                                constraint cat_trees_site_wide_p_ck
+                                check (site_wide_p in ('t','f'))
+);
+</pre>
+
+<p>
+Here the tree's name and description is stored in different translations.
+<pre>
+create table category_tree_translations (
+       tree_id			integer
+                                constraint cat_tree_trans_tree_id_fk
+                                references category_trees on delete cascade,
+       locale		        varchar2(5) not null
+                                constraint cat_tree_trans_locale_fk
+                                references ad_locales,
+       name			varchar2(50) not null,
+       description		varchar2(1000),
+       primary key (tree_id, locale)
+);
+</pre>
+
+<p>
+This table stores the tree hierarchy by holding the information about
+the parent category. The tree is ordered by a nested index (left_ind, right_ind).
+<pre>
+create table categories (
+       category_id		    integer primary key
+                                    constraint cat_category_id_fk
+                                    references acs_objects on delete cascade,
+       tree_id			    integer
+                                    constraint cat_tree_id_fk
+                                    references category_trees on delete cascade,
+       parent_id		    integer
+                                    constraint cat_parent_id_fk
+                                    references categories,
+       deprecated_p		    char(1) default 'f'
+                                    constraint cat_deprecated_p_ck
+                                    check (deprecated_p in ('t','f')),
+       left_ind			    integer,
+       right_ind		    integer
+);
+</pre>
+
+<p>
+Here the actual categories are stored together with different translations.
+<pre>
+create table category_translations (
+       category_id	    integer
+                            constraint cat_trans_category_id_fk
+                            references categories on delete cascade,
+       locale		    varchar2(5) not null
+                            constraint cat_trans_locale_fk
+                            references ad_locales,
+       name		    varchar2(200),
+       description	    varchar2(4000),
+       primary key (category_id, locale)
+);
+</pre>
+
+<p>
+This table contains mapping between categories and objects
+<pre>
+create table category_object_map (
+       category_id		     integer
+                                     constraint cat_object_map_category_id_fk
+                                     references categories on delete cascade,
+       object_id		     integer
+                                     constraint cat_object_map_object_id_fk
+                                     references acs_objects on delete cascade,
+       primary key (object_id, category_id)
+) organization index;
+</pre>
+
+<p>
+This is the table for the relation of trees and objects.
+subtree_category_id comes to play in situations when you 
+map a subtree of an existing tree to an object.
+<pre>
+create table category_tree_map (
+	tree_id			integer
+                                constraint cat_tree_map_tree_id_fk
+                                references category_trees on delete cascade,
+	object_id		integer
+                                constraint cat_tree_map_object_id_fk
+	                        references acs_objects on delete cascade,
+	subtree_category_id	integer default null
+                                constraint cat_tree_map_subtree_id_fk
+                                references categories,
+	primary key (object_id, tree_id)
+) organization index;
+</pre>
+
+<hr>
+<p><b>Known Limitations</b>
+<ul>
+<li>The tree order is the same for all translations.</li>
+<li>You can map a tree only once to a package (or other object).</li>
+<li>The number of objects mapped to a category is not shown yet.
+These results should be cached.</li>
+<li>When browsing categories all mapped categories should be shown
+for each object.</li>
+<li>There should be browsing widget easily used by other packages
+to let the user browse through all categorized objects.
+</ul>
+
+<hr>
+<p><b>Integration with other packages</b>
+<p>Here are the changes needed to be made to integrate with other packages.
+<p>
+
+<b>index.adp</b>
+<br>Provide an admin-link to
+/categories/cadmin/one-object?object_id=@package_id@ to let admins
+map trees to the package instance.
+<p>
+
+<b>form-page.tcl</b>
+<br>Use this in ad_form to display all mapped category trees and
+selected categories (if editing an object):
+<pre>
+    {category_ids:integer(category),multiple,optional {label "Categories"}
+       {html {size 4}} {value {$object_id $package_id}}}
+</pre>
+Alternatively, you can include the following in your adp:
+<pre>
+  <include src="/packages/categories/www/include/widget" object_id=@object_id@ package_id=@package_id@></pre>
+In the processing part of ad_form use:
+<pre>
+category::map_object -remove_old -object_id $object_id $category_ids
+</pre>
+<p>
+<hr>
+<address><a href="mailto:timo@studio-k4.de">timo@studio-k4.de</a></address>
+</body>
+</html>
Index: openacs-4/packages/categories/www/doc/o.html
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/doc/o.html,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/doc/o.html	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,192 @@
+<html>
+<head>
+   <title>Object Names and IdHandler Service Contract</title>
+</head>
+<body bgcolor="#FFFFFF">
+
+<h2>Object Names and IdHandler Service Contract</h2>
+
+<hr>
+<h3>Object Names</h3>
+
+When presenting a list of objects in a package not native to the
+objects (i.e. permissioning, community-member, category-usage)
+there has to be a fast and easy way to figure out the name of
+objects. Until now, this has been done by using something like
+<pre>
+acs_objects.name(object_id)
+</pre>
+which essential means that for every object to be displayed
+(and since the mentioned pages are in no means scalable and
+therefore are likely to display a huge amount of objects)
+this pl/sql proc will have to figure out which package-specific
+pl/sql proc to call which itself will do at least one query
+to get the object-name.
+<p>
+Obviously, this is highly undesirable since it is not scalable
+at all. Therefore, a new way had to be found to get the name
+of an object:
+<pre>
+-------------------
+-- NAMED OBJECTS --
+-------------------
+
+create table acs_named_objects (
+	object_id	integer not null
+			constraint acs_named_objs_pk primary key
+			constraint acs_named_objs_object_id_fk
+			references acs_objects(object_id) on delete cascade,
+	object_name	varchar2(200),
+	package_id	integer
+			constraint acs_named_objs_package_id_fk
+			references apm_packages(package_id) on delete cascade
+);
+
+create index acs_named_objs_name_ix on acs_named_objects (substr(upper(object_name),1,1));
+create index acs_named_objs_package_ix on acs_named_objects(package_id);
+
+begin
+        acs_object_type.create_type (
+                supertype       =>      'acs_object',
+                object_type     =>      'acs_named_object',
+                pretty_name     =>      'Named Object',
+                pretty_plural   =>      'Named Objects',
+                table_name      =>      'acs_named_objects',
+                id_column       =>      'object_id'
+        );
+end;
+/
+show errors
+</pre>
+
+This means that every displayable object-type should no longer be
+derived from acs_objects, but from acs_named_objects and that
+by using triggers or extending the appropriate pl/sql procs,
+every displayable object (certainly not acs_rels or something the
+like) should have an evtry in that extension of the acs_objects table.
+<p>
+In that way, when having to display a list of objects, one can simply
+join the acs_named_objects table to get the names and package_ids
+in an easy and - more importantly - fast and scalable way.
+<p>
+The only shortcomming of this solution is the disregard of
+internationalization, but in cases where there objects in more
+than one language, it should be the triggers / pl/sql procs task
+to make sure that acs_named_objects contains names in the
+default language if possible.
+
+
+<h3>IdHandler Service Contract</h3>
+
+Besides displaying the names of objects, some pages also want to
+provide links to the objects. Unfortunately, there currently is no
+way to do so.
+<p>
+First, we need to know that package_id of the package
+responsible for the object. This information is currently impossible
+to get since we would need to go up the context hierarchy until we
+finally get hold of an apm_package object. But lets assume we
+get this information by using the new acs_named_objects
+table, then we would need to figure out the url to that
+package instance. This can be done, but again by calling a
+highly unefficient pl/sql proc. But even then we would need the
+local url to the page being able to display a certain object.
+Since a package may have more than one type of objects (i.e. file folders,
+files, file versions), we can not simply store additional
+package information about which page to call to display an object.
+<p>
+The solution to this kind of problem is by not resolving the url
+at all during display-time, but doing so at the time the user
+actually wants to see an object. The links would simply direct
+to /o/$object_id, which is a global virtual-url-handling page
+that will figure out the package instance url (by using
+acs_named_objects and the pl/sql proc) and then relying
+upon a Service Contract to get the local url - that means every
+package holding displayable objects should implement this
+interface for its objects:
+
+<pre>
+declare
+    v_id	integer;
+begin
+    v_id :=  acs_sc_contract.new(
+	    contract_name => 'AcsObject',
+	    contract_desc => 'Acs Object Id Handler'
+    );
+    v_id := acs_sc_msg_type.new(
+	    msg_type_name => 'AcsObject.PageUrl.InputType',
+	    msg_type_spec => 'object_id:integer'
+    );
+    v_id := acs_sc_msg_type.new(
+	    msg_type_name => 'AcsObject.PageUrl.OutputType',
+	    msg_type_spec => 'page_url:string'
+    );
+    v_id := acs_sc_operation.new(
+	    contract_name => 'AcsObject',
+	    operation_name => 'PageUrl',
+	    operation_desc => 'Returns the package specific url to a page
+that displays an object',
+	    operation_iscachable_p => 'f',
+	    operation_nargs => 1,
+	    operation_inputtype => 'AcsObject.PageUrl.InputType',
+	    operation_outputtype => 'AcsObject.PageUrl.OutputType'
+    );
+
+    v_id := acs_sc_impl.new (
+              'AcsObject',
+              'apm_package_idhandler',
+              'acs-kernel'
+    );
+    v_id := acs_sc_impl.new_alias (
+              'AcsObject',
+              'apm_package_idhandler',
+              'PageUrl',
+              'apm_pageurl',
+              'TCL'
+    );
+    acs_sc_binding.new (
+              contract_name => 'AcsObject',
+              impl_name => 'apm_package_idhandler'
+    );                             
+
+    v_id := acs_sc_impl.new (
+              'AcsObject',
+              'user_idhandler',
+              'acs-kernel'
+    );
+    v_id := acs_sc_impl.new_alias (
+              'AcsObject',
+              'user_idhandler',
+              'PageUrl',
+              'acs_user::pageurl',
+              'TCL'
+    );
+    acs_sc_binding.new (
+              contract_name => 'AcsObject',
+              impl_name => 'user_idhandler'
+    );                             
+end;
+</pre>
+The appropriate tcl-procs look like the following:
+<pre>
+ad_proc -public apm_pageurl { object_id } {
+    Service Contract Proc to resolve a url for a package_id
+} {
+    return
+}
+
+namespace eval acs_user {
+    ad_proc -public pageurl { object_id } {
+	Service Contract Proc to resolve a url for a user_id
+    } {
+	return "shared/community-member?user_id=$object_id"
+    }
+}
+</pre>
+Note that the name of the implementation has to be the object-type
+followed by _idhandler.
+<p>
+<hr>
+<address><a href="mailto:timo@studio-k4.de">timo@studio-k4.de</a></address>
+</body>
+</html>
Index: openacs-4/packages/categories/www/include/widget.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/include/widget.adp,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/include/widget.adp	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,10 @@
+<if @trees:rowcount@ gt 0>
+  <multiple name=trees>
+    @trees.tree_name@:
+    <select name="@name@" multiple>
+    <group column=tree_id>
+      <option value="@trees.category_id@"<if @trees.selected_p@ eq 1> selected</if>>@trees.indent;noquote@@trees.category_name@
+    </group>
+    </select>
+  </multiple>
+</if>
Index: openacs-4/packages/categories/www/include/widget.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/categories/www/include/widget.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/categories/www/include/widget.tcl	23 Apr 2003 12:29:27 -0000	1.1
@@ -0,0 +1,31 @@
+#
+# author: Timo Hentschel (thentschel@sussdorff-roy.com)
+#
+
+if {![info exists object_id]} {
+    set object_id 0
+}
+if {![info exists package_id]} {
+    set package_id [ad_conn package_id]
+}
+if {![info exists name]} {
+    set name category_ids
+}
+
+template::multirow create trees tree_id tree_name category_id selected_p category_name indent
+
+template::util::list_to_lookup [category::get_mapped_categories $object_id] mapped
+
+foreach tree [category_tree::get_mapped_trees $package_id] {
+    util_unlist $tree tree_id tree_name subtree_id
+    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 indent ""
+	if {$level>1} {
+	    set indent "[category::repeat_string "&nbsp;" [expr 2*$level -4]].."
+	}
+	set selected_p [info exists mapped($category_id)]
+	template::multirow append trees $tree_id $tree_name $category_id $selected_p $category_name $indent
+    }
+}