- Malte

catalog/categories.de_DE.ISO-8859-1.xml

+<?xml version="1.0" encoding="ISO-8859-1"?>
+<message_catalog package_key="categories" package_version="1.1" locale="de_DE" charset="ISO-8859-1">
+
+  <msg key="cadmin">Management der Kategorien</msg>
+  <msg key="code_export">Code zum Erstellen der Kategoriebume exportieren</msg>
+  <msg key="code_necessary">TCL Code um ausgewhlte Kategoriebume zu importieren</msg>
+  <msg key="export">Export</msg>
+</message_catalog>

catalog/categories.en_US.ISO-8859-1.xml

+<?xml version="1.0" encoding="ISO-8859-1"?>
+<message_catalog package_key="categories" package_version="1.1" locale="en_US" charset="ISO-8859-1">
+
+  <msg key="cadmin">Category Management</msg>
+  <msg key="code_export">Export code to recreate category trees</msg>
+  <msg key="code_necessary">Tcl code to recreate selected category trees</msg>
+  <msg key="export">Export</msg>
+</message_catalog>

catalog/categories.es_ES.ISO-8859-1.xml

+<?xml version="1.0" encoding="ISO-8859-1"?>
+<message_catalog package_key="categories" package_version="1.1" locale="es_ES" charset="ISO-8859-1">
+
+  <msg key="cadmin">Administración de Categorías</msg>
+  <msg key="code_export">Exportar código para recrear los árboles de categorías</msg>
+  <msg key="code_necessary">Código Tcl para recrear los árboles de categorías seleccionados</msg>
+  <msg key="export">Exportar</msg>
+</message_catalog>

catalog/categories.nl_NL.ISO-8859-1.xml

+<?xml version="1.0" encoding="ISO-8859-1"?>
+<message_catalog package_key="categories" package_version="1.1" locale="nl_NL" charset="ISO-8859-1">
+
+  <msg key="cadmin">Categorienbeheer</msg>
+  <msg key="code_export">Exporteer code om categoriebomen opnieuw aan te maken</msg>
+  <msg key="code_necessary">Tcl-code om betreffende categoriebomen opnieuw aan te maken</msg>
+  <msg key="export">Exporteren</msg>
+</message_catalog>

catalog/categories.nl_ZA.ISO-8859-1.xml

+<?xml version="1.0" encoding="ISO-8859-1"?>
+<message_catalog package_key="categories" package_version="1.1" locale="nl_ZA" charset="ISO-8859-1">
+
+  <msg key="cadmin">Kategoriebeheer</msg>
+  <msg key="code_export">Eksporteer kode om kategoriebome opnuut aan te maak</msg>
+  <msg key="code_necessary">Tcl-kode om betreffende kategoriebome opnuut aan te maak</msg>
+  <msg key="export">Eksporteer</msg>
+</message_catalog>

catalog/categories.pl_PL.utf-8.xml

+<?xml version="1.0" encoding="utf-8"?>
+<message_catalog package_key="categories" package_version="1.1" locale="pl_PL" charset="utf-8">
+
+  <msg key="cadmin">Zarządzanie Kategoriami</msg>
+  <msg key="code_export">Eksportuj kod do odtworzenia drzew kategorii</msg>
+  <msg key="code_necessary">Kod Tcl do odtworzenia wybranych kategorii</msg>
+  <msg key="export">Eksportuj</msg>
+</message_catalog>

catalog/categories.pt_BR.ISO-8859-1.xml

+<?xml version="1.0" encoding="ISO-8859-1"?>
+<message_catalog package_key="categories" package_version="1.1" locale="pt_BR" charset="ISO-8859-1">
+
+  <msg key="cadmin">Gerenciamento de Categorias</msg>
+  <msg key="code_export">Exportar cdigo para recriar rvores de categoria</msg>
+  <msg key="code_necessary">Cdigo Tcl para recriar as rvores de categoria selecionadas</msg>
+  <msg key="export">Exportar</msg>
+</message_catalog>

categories.info

@@ -8,13 +8,16 @@
     <singleton-p>f</singleton-p>
     <auto-mount>categories</auto-mount>
 
-    <version name="1.0d7" url="http://openacs.org/repository/apm/packages/categories-1.0d7">
-        <owner>timo@timohentschel.de</owner>
+    <version name="1.1" url="http://openacs.org/repository/apm/packages/categories-1.1">
+        <owner url="mailto:timo@timohentschel.de">timo@timohentschel.de</owner>
         <summary>Manage categories in category trees and let users map objects to categories.</summary>
-        <release-date>2003-04-16</release-date>
-        <description format="text/html">Datamodel for category trees with supporting API and management pages.  Provides a widget for 
+        <release-date>2006-02-12</release-date>
+        <description format="text/html">Datamodel for category trees with supporting API and management pages.  Provides a widget for 
         general categorization of arbitrary objects and tracks which package instances use which category trees.  Also supports localization.</description>
-        <provides url="categories" version="1.0d7"/>
+        <maturity>0</maturity>
+
+        <provides url="categories" version="1.1"/>
+        <requires url="acs-kernel" version="5.3.1a1"/>
 
         <callbacks>
             <callback type="after-install"  proc="category::after_install"/>

lib/categorize.adp

+  <h1>Categorize @name@</h1>
+  <if @catass_list@ not nil>
+    <h2> Current categories</h2>
+    <p>@catass_list;noquote@</p>
+  </if>
+  <formtemplate id="catass"></formtemplate>

lib/categorize.tcl

+if {![exists_and_not_null object_id]} {
+    ad_complain "You must specify an object to categorize"
+}
+
+if {![exists_and_not_null container_id]} {
+    set container_id [ad_conn subsite_id]
+}
+
+set name [db_string title {select title from acs_objects where object_id = :object_id} -default $object_id]
+
+# Category mapping stuff
+# add category form
+ad_form -action map -method GET -name catass -form {
+    {object_id:integer(hidden)
+        {value $object_id}
+    }
+    {container_id:integer(hidden)
+        {value $container_id}
+    }
+}
+
+category::ad_form::add_widgets -container_object_id $container_id -form_name catass
+
+# mapped categories:
+set catass_list [category::list::get_pretty_list \
+                     -category_link_eval "list-categories?cat=\$__category_id" \
+                     -remove_link_eval "remove?cat=\$__category_id&object_id=$object_id" \
+                     -remove_link_text "<b style=\"color: red\">X</b>" \
+                     [category::get_mapped_categories $object_id]]

lib/contributions.adp

+<listtemplate name="content"></listtemplate>
\ No newline at end of file

lib/contributions.tcl

+# Display the site contributions
+# If user_id set it will be limited by that user otherwise all users.
+# if limit set then only limit items will be displayed.
+# if root_node_id exists then only return things under root node.
+set root_node_id [ad_conn node_id]
+
+if {![info exists user_id]} {
+    set user_id {}
+}
+if {![info exists category]} {
+    set category {}
+}
+if {[info exists supress]} {
+    foreach key $supress { 
+        set hide($key) 1
+    }
+}
+
+if {[info exists limit]
+    && [regexp {^[0-9]+$} $limit]} { 
+    set limit " limit $limit"
+} else { 
+    set limit {}
+}
+
+if {![info exists format]} {
+    set format table
+}
+
+if {[info exists root_node_id]} {
+    set packages [subsite::util::packages -node_id $root_node_id]
+} else {
+    set packages {}
+}
+
+lappend elements object_title {
+    label {Title}
+    display_template {<a href="/o/@content.object_id@">@content.title@</a>}
+}
+
+if {![info exists hide(pretty_name)]} { 
+    lappend elements pretty_name {
+        label {Type}
+        display_template {<a href="/o/@content.object_id@">@content.object_type@</a>}
+    }
+}
+
+lappend elements last_modified {
+    label {Last update}
+    display_template "@content.last_modified;noquote@"
+    html {align right}
+}
+
+# lappend elements new {
+#    label {New}
+#    display_template "@content.new;noquote@"
+#    html {align right}
+#}
+
+if {[empty_string_p $user_id]} {
+    lappend elements name {
+        label {Created by}
+        display_template {<a href="@content.user_url@" title="Member page">@content.name@</a>}
+    }
+}
+
+template::list::create \
+    -name content \
+    -multirow content \
+    -key object_id \
+    -elements $elements \
+    -selected_format $format \
+    -filters {
+        user_id {}
+    } \
+    -formats {
+        table { 
+            label Table
+            layout table
+        }
+        list { 
+            label List
+            layout list
+            template {
+                <div style="padding: 0 0 1em 0;"><listelement name="object_title"> \[<listelement name="pretty_name">\] - <listelement name="new"><br>
+                <span style="color: \#ccc;">by <listelement name="name">, <listelement name="last_modified"></span></div>
+            }
+        } 
+    } \
+    -orderby {
+        object_title {
+            orderby lower(o.title)
+        }
+        pretty_name {
+            orderby lower(t.pretty_name)
+        }
+        last_modified {
+            orderby_asc {o.last_modified desc}
+            orderby_desc {o.last_modified asc}
+        }
+        name {
+            orderby_asc "lower(u.last_name),lower(u.first_names)"
+            orderby_desc "lower(u.last_name) desc,lower(u.first_names) desc"
+        }
+    }
+
+set now [clock_to_ansi [clock seconds]]
+
+set restrict {}
+
+if {![empty_string_p $user_id]} {
+    append restrict "\nand o.creation_user = :user_id"
+}
+
+if {![empty_string_p $category]} {
+    append restrict "\nand exists (select 1 from category_object_map c where c.object_id = o.object_id and c.category_id = :category)"
+}
+
+if {![empty_string_p $packages]} {
+    append restrict "\nand o.package_id in ([join $packages ,])"
+}
+
+# JCDXXX: TODO: need to get the dimension to display, need to find the right CoP, permissions
+db_multirow -extend {url_one user_url new} content content "
+    SELECT o.title, o.object_id, o.title, t.pretty_name as object_type, to_char(o.last_modified,'YYYY-MM-DD HH24:MI:SS') as last_modified, u.user_id, u.first_names || ' ' || u.last_name as name
+      FROM acs_object_types t, acs_objects o
+           left outer join cr_items i on (o.object_id = i.item_id)
+           left outer join acs_users_all u on (u.user_id = o.creation_user)
+     WHERE t.object_type = case when o.object_type = 'content_item' then i.content_type else o.object_type end
+       and o.object_type in ('content_item','pinds_blog_entry','forums_forum','forums_message',
+           'cal_item','bt_bug','bt_patch', 'news', 'faq', 'faq_q_and_a', 'bookshelf_book', 'job_posting','survey')
+       and (o.object_type != 'content_item' or i.content_type in ('content_extlink','file_storage_object','pa_album','pa_photo','static_page','news','job', 'content_revision'))
+       $restrict
+   [template::list::orderby_clause -orderby -name "content"]$limit" {
+
+       # TODO: JCDXXX - make this work in general.
+       if {($object_id % 3) == 0} {
+           set new {<span class="new" style="color: red">NEW</span>}
+       } else { 
+           set new {}
+       }
+
+       # TODO: JCDXXX - make this work in general.
+       regsub {/www/cop1/static} $title {} title
+
+       set last_modified [regsub -all { } [util::age_pretty -hours_limit 0 -mode_2_fmt "%X %a" -mode_3_fmt "%x" -timestamp_ansi $last_modified -sysdate_ansi $now] {\&nbsp;}]
+       set user_url [acs_community_member_url -user_id $user_id]
+       if {[catch {set url_one [acs_sc_call -error FtsContentProvider url [list $object_id] $object_type]} errMsg]} {
+           global errorCode
+           set url_one $errorCode
+       }
+   }
\ No newline at end of file

lib/list-categories.adp

+  <div style="float: left;">
+    <div>
+      <multiple name="categories">
+        <h2>@categories.tree_name@</h2>
+        <ul>
+          <group column="tree_id">
+            <if @categories.category_id@ eq @cat@><li><b>@categories.pad;noquote@@categories.category_name@ <if @categories.count@ gt 0>(@categories.count@)</if></b></li></if>
+            <else>
+              <if @categories.count@ gt 0 or @categories.child_sum@ gt 0>
+                <li>@categories.pad;noquote@<if @categories.count@ gt 0><a href="?cat=@categories.category_id@" rel="nofollow">@categories.category_name@</a> (@categories.count@)</if><else>@categories.category_name@</else>
+                </li>
+              </if>
+            </else>
+          </group>
+        </ul>
+      </multiple>
+    </div>
+    <div>
+      <if @cat@ not nil><include src="/packages/categories/lib/contributions" orderby="@orderby@" category="@cat@" root_node_id="@node_id@"></if>
+    </div>
+  </div>

lib/list-categories.tcl

+if {![exists_and_not_null cat]} {
+    set cat {}
+}
+
+if {![exists_and_not_null orderby]} {
+    set orderby "object_title"
+}
+set user_id [ad_conn user_id]
+
+# Get category data.
+set counts {}
+set node_id [ad_conn node_id]
+set packages [subsite::util::packages -node_id $node_id]
+db_foreach category_count "
+    SELECT c.category_id as catid, count(*) as count
+    FROM category_object_map c, acs_objects o
+    where c.object_id = o.object_id
+    and o.package_id in ([join $packages ,])
+    and exists (select 1 
+                  from acs_object_party_privilege_map pm
+                 where pm.object_id = c.object_id
+                   and pm.party_id = :user_id
+                   and pm.privilege = 'read')
+    group by c.category_id
+" { 
+    lappend counts $catid $count
+}
+
+category_tree::get_multirow -datasource categories -container_id [ad_conn subsite_id] -category_counts $counts

lib/map.adp

+OK
\ No newline at end of file

lib/map.tcl

+if {![exists_and_not_null object_id]} {
+    ad_complain "You must specify an item to map"
+}
+
+if {![exists_and_not_null container_id]} {
+    ad_complain "You must specify a container to map the object to"
+}
+
+ad_form -name catass -form {
+    {object_id:integer(hidden)
+        {value $object_id}
+    }
+    {container_id:integer(hidden)
+        {value $container_id}
+    }
+} 
+category::ad_form::add_widgets -container_object_id $container_id -form_name catass
+ad_form -extend -name catass -on_submit { 
+    ns_log Notice "JCD: trees [category_tree::get_mapped_trees $container_id]"
+    set category_ids [category::ad_form::get_categories -container_object_id $container_id]
+    ns_log Notice "JCD: mapping $category_ids" 
+    category::map_object \
+        -object_id $object_id \
+        $category_ids
+}
+
+ad_returnredirect [get_referrer]

lib/tree-code.adp

+
+############
+# Category Tree "@tree.tree_name@"
+############
+category_tree::import \
+       -name {@tree.tree_name@} \
+       -description {@tree.description@} \
+       -locale $default_locale \
+       -categories {<multiple name="categories">
+           @categories.pad;noquote@@categories.level@   {@categories.name@}</multiple>
+       }

lib/tree-code.tcl

+set default_locale [lang::system::site_wide_locale]
+
+array set tree [category_tree::get_data $tree_id $default_locale]
+
+multirow create categories name level pad
+foreach category [category_tree::get_tree -all $tree_id $default_locale] {
+    util_unlist $category category_id category_name deprecated_p level
+    multirow append categories $category_name $level [string repeat " " [expr {2 * $level - 2}]]
+}

sql/oracle/category-link-package.sql

@@ -28,7 +28,7 @@ CREATE OR REPLACE PACKAGE BODY category_link AS
     IS
         v_link_id	integer; 
     BEGIN
-	select category_links_id_seq.nextval() into v_link_id from dual;
+	select category_links_id_seq.nextval into v_link_id from dual;
 
 	insert into category_links (link_id, from_category_id, to_category_id)
 	values (v_link_id, new.from_category_id, new.to_category_id);

sql/oracle/category-package.sql

@@ -91,7 +91,8 @@ CREATE OR REPLACE PACKAGE BODY CATEGORY AS
 		creation_date => creation_date,
 		creation_user => creation_user,
 		creation_ip   => creation_ip,
-		context_id    => tree_id
+		context_id    => tree_id,
+                title         => name
 	);
 
 	if (new.parent_id is null) then

sql/oracle/category-synonym-package.sql

@@ -62,7 +62,7 @@ CREATE OR REPLACE PACKAGE BODY category_synonym AS
     BEGIN
 	-- get new synonym_id
 	if (new.synonym_id is null) then
-		select category_synonyms_id_seq.nextval() into v_synonym_id from dual;
+		select category_synonyms_id_seq.nextval into v_synonym_id from dual;
 	else 
 		v_synonym_id := new.synonym_id;
 	end if;
@@ -141,7 +141,7 @@ CREATE OR REPLACE PACKAGE BODY category_synonym AS
 	end if;
 
 	-- get new search query id
-	select category_search_id_seq.nextval() into v_query_id from dual;
+	select category_search_id_seq.nextval into v_query_id from dual;
 
 	-- convert string to uppercase and substitute special chars
 	v_search_text := category_synonym.convert_string (search.search_text);

sql/oracle/category-tree-package.sql

@@ -98,7 +98,8 @@ as
 		creation_date => creation_date,
 		creation_user => creation_user,
 		creation_ip   => creation_ip,
-		context_id    => context_id 
+		context_id    => context_id,
+                title         => tree_name
 	);
 
 	insert into category_trees

sql/oracle/upgrade/upgrade-1.1d2-1.1d3.sql

+-- Populate the title field of acs_objects with the category 
+-- name or tree name
+--
+-- @author Jeff Davis <davis@xarg.net>
+-- @creation-date 2005-02-06
+
+@@ ../category-package.sql
+@@ ../category-tree-package.sql

sql/postgresql/categories-create.sql

@@ -447,7 +447,9 @@ comment on column category_search_results.similarity is '
 \i category-package.sql
 \i category-link-package.sql
 \i category-synonym-package.sql
+\i categories-relation.sql
 
 \i categories-permissions.sql
 
 \i categories-init.sql
+

sql/postgresql/categories-drop.sql

@@ -109,3 +109,12 @@ select acs_sc_operation__delete(acs_sc_operation__get_id('AcsObject','PageUrl'))
 -- this should be being handled at the tcl callback level but isn't?
 select acs_sc_impl__delete('AcsObject','category_idhandler');
 select acs_sc_impl__delete('AcsObject','category_tree_idhandler');
+
+
+-- from categories-relation
+select acs_rel_type__drop_type('meta_category_rel','t');
+select acs_rel_type__drop_type('user_meta_category_rel','t');
+select acs_rel_type__drop_role('meta-category');
+select acs_rel_type__drop_role('category');
+
+

sql/postgresql/categories-relation.sql

+--
+-- Categories Relation 
+--
+-- @author Miguel Marin (miguelmarin@viaro.net)
+-- @author Viaro Networks www.viaro.net
+-- @creation-date 2005-07-26
+--
+
+create function inline_0 ()
+returns integer as '
+begin
+
+  -- We create the roles to use them on the rel_type create
+  PERFORM acs_rel_type__create_role(''party'', ''Party'', ''Parties'');
+  PERFORM acs_rel_type__create_role(''category'', ''Category'', ''Categories'');
+  PERFORM acs_rel_type__create_role(''meta_category'', ''Meta Category'', ''Meta Categories'');
+
+  -- Creating two new rel_types
+  PERFORM acs_rel_type__create_type (
+      ''meta_category_rel'',		-- rel_type 
+      ''Meta Category Relation'',       -- pretty_name
+      ''Meta Category Relation'',       -- pretty_plural
+      ''relationship'',			-- supertype
+      ''meta_categories'',		-- table_name
+      ''meta_category_id'',		-- id_column 
+      null,				-- package_name
+      ''category'',		        -- object_type_one 
+      ''category'',		        -- role_one
+      1,				-- min_n_rels_one
+      1,				-- max_n_rels_one 
+      ''category'',           		-- object_type_two
+      ''category'',		        -- role_two
+      1,				-- min_n_rels_two
+      1					-- max_n_rels_two
+  );
+
+  PERFORM acs_rel_type__create_type (
+      ''user_meta_category_rel'',	-- rel_type
+      ''User Meta Category Relation'',  -- pretty_name
+      ''User Meta Category Relation'',  -- pretty_plural
+      ''relationship'',			-- supertype
+      ''user_meta_categories'',		-- table_name
+      ''user_meta_category_id'',	-- id_column
+      null,				-- package_name
+      ''meta_category_rel'',		-- object_type_one
+      ''meta_category'',		-- role_one
+      1,				-- min_n_rels_one
+      1,				-- max_n_rels_one
+      ''party'',			-- object_type_two
+      ''party'',			-- role_two
+      1,				-- min_n_rels_two
+      1					-- max_n_rels_two
+  );
+
+  return 0;
+end;' language 'plpgsql';
+
+select inline_0 ();
+
+drop function inline_0 ();

sql/postgresql/category-package.sql

@@ -41,7 +41,9 @@ begin
 		p_creation_user,        -- creation_user
 		p_creation_ip,          -- creation_ip
 		p_tree_id,              -- context_id
-                ''t''                   -- security_inherit_p
+                ''t'',                  -- security_inherit_p
+                p_name,                 -- title
+                null                    -- package_id
 	);
 
 	if (p_parent_id is null) then

sql/postgresql/category-tree-package.sql

@@ -37,7 +37,9 @@ begin
 		p_creation_date,   -- creation_date
 		p_creation_user,   -- creation_user
 		p_creation_ip,     -- creation_ip
-		p_context_id       -- context_id
+		p_context_id,      -- context_id
+                p_tree_name,       -- title
+                null               -- package_id
 	);
 
 	insert into category_trees
@@ -186,9 +188,9 @@ declare
     p_creation_user         alias for $3;
     p_creation_ip           alias for $4;
 
-    source		    RECORD;
     v_new_left_ind          integer;
     v_category_id	    integer;
+    source record;
 begin
 	select coalesce(max(right_ind),0) into v_new_left_ind 
 	from categories
@@ -211,7 +213,7 @@ begin
 	end loop;
 
 	-- correct parent_ids
-	update categories c
+	update categories
 	set parent_id = (select t.category_id
 			from categories s, categories t
 			where s.category_id = c.parent_id

sql/postgresql/upgrade/upgrade-1.1d1-1.1d2.sql

+-- source was undeclared.
+
+create or replace function category_tree__copy (
+    integer,   -- source_tree
+    integer,   -- dest_tree
+    integer,   -- creation_user
+    varchar    -- creation_ip
+)
+returns integer as '
+declare
+    p_source_tree           alias for $1;
+    p_dest_tree             alias for $2;
+    p_creation_user         alias for $3;
+    p_creation_ip           alias for $4;
+
+    v_new_left_ind          integer;
+    v_category_id	    integer;
+    source record;
+begin
+	select coalesce(max(right_ind),0) into v_new_left_ind 
+	from categories
+	where tree_id = p_dest_tree;
+
+	for source in (select category_id, parent_id, left_ind, right_ind from categories where tree_id = p_source_tree) loop
+
+	   v_category_id := acs_object__new ( 
+		''category'',     -- object_type
+		now(),            -- creation_date
+		p_creation_user,  -- creation_user
+		p_creation_ip,    -- creation_ip
+	  	p_dest_tree       -- context_id
+	   );
+
+	   insert into categories
+	   (category_id, tree_id, parent_id, left_ind, right_ind)
+	   values
+	   (v_category_id, p_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 = p_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 = p_dest_tree
+	and cs.tree_id = p_source_tree
+	and cs.left_ind + v_new_left_ind = ct.left_ind
+	and t.category_id = cs.category_id);
+
+	-- for debugging reasons
+	perform category_tree__check_nested_ind(p_dest_tree);
+
+       return 0;
+end;
+' language 'plpgsql';
+

sql/postgresql/upgrade/upgrade-1.1d2-1.1d3.sql

+-- Populate the title field of acs_objects with the category 
+-- name or tree name
+--
+-- @author Jeff Davis <davis@xarg.net>
+-- @creation-date 2005-02-06
+
+create or replace function category__new (
+    integer,   -- category_id
+    integer,   -- tree_id
+    varchar,   -- locale
+    varchar,   -- name
+    varchar,   -- description
+    integer,   -- parent_id
+    char,      -- deprecated_p
+    timestamp with time zone, -- creation_date
+    integer,   -- creation_user
+    varchar    -- creation_ip
+)
+returns integer as '
+declare
+    p_category_id       alias for $1;
+    p_tree_id           alias for $2;
+    p_locale            alias for $3;
+    p_name              alias for $4;
+    p_description       alias for $5;
+    p_parent_id         alias for $6;
+    p_deprecated_p      alias for $7;
+    p_creation_date     alias for $8;
+    p_creation_user     alias for $9;
+    p_creation_ip       alias for $10;
+
+    v_category_id       integer; 
+    v_left_ind          integer;
+    v_right_ind         integer;
+begin
+	v_category_id := acs_object__new ( 
+		p_category_id,          -- object_id
+		''category'',           -- object_type
+		p_creation_date,        -- creation_date
+		p_creation_user,        -- creation_user
+		p_creation_ip,          -- creation_ip
+		p_tree_id,              -- context_id
+                ''t'',                  -- security_inherit_p
+                p_name,                 -- title
+                null                    -- package_id
+	);
+
+	if (p_parent_id is null) then
+		select 1, coalesce(max(right_ind)+1,1) into v_left_ind, v_right_ind
+		from categories
+		where tree_id = p_tree_id;
+	else
+		select left_ind, right_ind into v_left_ind, v_right_ind
+		from categories
+		where category_id = p_parent_id;
+	end if;
+
+ 	insert into categories
+        (category_id, tree_id, deprecated_p, parent_id, left_ind, right_ind)
+	values
+	(v_category_id, p_tree_id, p_deprecated_p, p_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 = p_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 = p_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, p_locale, p_name, p_description);
+
+	return v_category_id;
+end;
+' language 'plpgsql';
+
+
+create or replace function category_tree__new (
+    integer, -- tree_id
+    varchar, -- locale
+    varchar, -- tree_name
+    varchar, -- description
+    char,    -- site_wide_p
+    timestamp with time zone, -- creation_date
+    integer, -- creation_user
+    varchar, -- creation_ip
+    integer  -- context_id
+)
+returns integer as '
+declare
+    p_tree_id               alias for $1;
+    p_locale                alias for $2;
+    p_tree_name             alias for $3;
+    p_description           alias for $4;
+    p_site_wide_p           alias for $5;
+    p_creation_date         alias for $6;
+    p_creation_user         alias for $7;
+    p_creation_ip           alias for $8;
+    p_context_id            alias for $9;
+  
+    v_tree_id               integer;
+begin
+	v_tree_id := acs_object__new (
+		p_tree_id,         -- object_id
+		''category_tree'', -- object_type
+		p_creation_date,   -- creation_date
+		p_creation_user,   -- creation_user
+		p_creation_ip,     -- creation_ip
+		p_context_id,      -- context_id
+                p_tree_name,       -- title
+                null               -- package_id
+	);
+
+	insert into category_trees
+	   (tree_id, site_wide_p)
+	values
+	   (v_tree_id, p_site_wide_p);
+
+	perform acs_permission__grant_permission (
+		v_tree_id,             -- object_id
+		p_creation_user,       -- grantee_id
+		''category_tree_read'' -- privilege
+	);
+	perform acs_permission__grant_permission (
+		v_tree_id,                -- object_id
+		p_creation_user,          -- grantee_id
+		''category_tree_write''   -- privilege
+	);
+	perform acs_permission__grant_permission (
+		v_tree_id,                          -- object_id
+		p_creation_user,                    -- grantee_id
+		''category_tree_grant_permissions'' -- privilege
+	);
+
+	insert into category_tree_translations
+	    (tree_id, locale, name, description)
+	values
+	    (v_tree_id, p_locale, p_tree_name, p_description);
+
+	return v_tree_id;
+end;
+' language 'plpgsql';
+

sql/postgresql/upgrade/upgrade-1.1d3-1.1d4.sql

+--
+-- Add Categories Relation Roles and Types
+--
+-- @author Miguel Marin (miguelmarin@viaro.net)
+-- @author Viaro Networks www.viaro.net
+-- @creation-date 2005-07-26
+--
+
+create function inline_0 ()
+returns integer as '
+begin
+
+  -- We create two roles to use them on the rel_type create
+  PERFORM acs_rel_type__create_role(''party'', ''Party'', ''Parties'');
+  PERFORM acs_rel_type__create_role(''category'', ''Category'', ''Categories'');
+  PERFORM acs_rel_type__create_role(''meta_category'', ''Meta Category'', ''Meta Categories'');
+
+  -- Creating two new rel_types
+  PERFORM acs_rel_type__create_type (
+      ''meta_category_rel'',            -- rel_type 
+      ''Meta Category Relation'',       -- pretty_name
+      ''Meta Category Relation'',       -- pretty_plural
+      ''relationship'',                 -- supertype
+      ''meta_categories'',              -- table_name
+      ''meta_category_id'',             -- id_column 
+      null,                             -- package_name
+      ''category'',                     -- object_type_one 
+      ''category'',                     -- role_one
+      1,                                -- min_n_rels_one
+      1,                                -- max_n_rels_one 
+      ''category'',                     -- object_type_two
+      ''category'',                     -- role_two
+      1,                                -- min_n_rels_two
+      1                                 -- max_n_rels_two
+  );
+
+  PERFORM acs_rel_type__create_type (
+      ''user_meta_category_rel'',       -- rel_type
+      ''User Meta Category Relation'',  -- pretty_name
+      ''User Meta Category Relation'',  -- pretty_plural
+      ''relationship'',                 -- supertype
+      ''user_meta_categories'',         -- table_name
+      ''user_meta_category_id'',        -- id_column
+      null,                             -- package_name
+      ''meta_category_rel'',            -- object_type_one
+      ''meta_category'',                -- role_one
+      1,                                -- min_n_rels_one
+      1,                                -- max_n_rels_one
+      ''party'',                        -- object_type_two
+      ''party'',                        -- role_two
+      1,                                -- min_n_rels_two
+      1                                 -- max_n_rels_two
+  );
+
+  return 0;
+end;' language 'plpgsql';
+
+select inline_0 ();
+
+drop function inline_0 ();

tcl/categories-procs-oracle.xql

@@ -131,5 +131,16 @@
       </querytext>
 </fullquery>
 
+<fullquery name="category::map_object.insert_mapped_categories">      
+      <querytext>
+      
+			insert into category_object_map (category_id, object_id)
+			select :category_id, :object_id from dual
+                        where not exists (select 1
+                                          from category_object_map
+                                          where category_id = :category_id
+                                            and object_id = :object_id)
+      </querytext>
+</fullquery>
  
 </queryset>

tcl/categories-procs.tcl

@@ -20,6 +20,7 @@ ad_proc -public category::add {
     {-deprecated_p "f"}
     {-user_id ""}
     {-creation_ip ""}
+    -noflush:boolean
 } {
     Insert a new category. The same translation will be added in the default
     language if it's in a different language.
@@ -33,6 +34,9 @@ ad_proc -public category::add {
     @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.
+    @option noflush defer calling category_tree::flush_cache (which if adding multiple categories to 
+                    a large tree can be very expensive).  note that if you set this flag you must
+                    call category_tree::flush_cache once the adds are complete.
     @return category_id
     @author Timo Hentschel (timo@timohentschel.de)
 } {
@@ -47,13 +51,18 @@ ad_proc -public category::add {
     }
     db_transaction {
         set category_id [db_exec_plsql insert_category ""]
-
+        set translations [list $locale $name]
         set default_locale [ad_parameter DefaultLocale acs-lang "en_US"]
         if {$locale != $default_locale} {
-    	db_exec_plsql insert_default_category ""
+            lappend translations $default_locale $name
+            db_exec_plsql insert_default_category ""
         }
-        category_tree::flush_cache $tree_id
-        flush_translation_cache $category_id
+        if {!$noflush_p} {
+            category_tree::flush_cache $tree_id
+        }
+        # JCD: avoid doing a query and set the translation cache directly
+        # flush_translation_cache $category_id
+        nsv_set categories $category_id [list $tree_id $translations]
     }
     return $category_id
 }
@@ -100,7 +109,7 @@ ad_proc -public category::delete {
     category_id
 } {
     Deletes a category.
-    category_tree:flush_cache should be used afterwards.
+    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
@@ -189,18 +198,40 @@ ad_proc -public category::map_object {
     }
 }
 
-ad_proc -public category::get_mapped_categories { object_id } {
-    Gets the list of categories mapped to an object.
+ad_proc -public category::get_mapped_categories { 
+    {-tree_id {}}
+    object_id 
+} {
+    Gets the list of categories mapped to an object. If tree_id is provided 
+    return only the categories mapped from the given tree.
 
     @param object_id object of which we want to know the mapped categories.
     @return tcl-list of category_ids
     @author Timo Hentschel (timo@timohentschel.de)
 } {
-    set result [db_list get_mapped_categories ""]
+    if { ![empty_string_p $tree_id] } {
+        set result [db_list get_filtered ""]
+    } else {
+        set result [db_list get_mapped_categories ""]
+    }
 
     return $result
 }
 
+ad_proc -public category::get_id { 
+    name
+    {locale en_US}
+} {
+    Gets the id of a category given a name.
+
+    @param name the name of the category to retrieve
+    @param locale the locale in which the name is supplied
+    @return the category id or empty string it no category was found
+    @author Lee Denison (lee@xarg.co.uk)
+} {
+    return [db_list get_category_id {}]
+}
+
 ad_proc -public category::reset_translation_cache { } {
     Reloads all category translations in the cache.
     @author Timo Hentschel (timo@timohentschel.de)
@@ -260,10 +291,32 @@ ad_proc -public category::get_name {
         # exact match: found name for this locale
         return $name
     }
+
+    # try default locale for this language
+    set language [lindex [split $locale "_"] 0]
+    set locale [lang::util::default_locale_from_lang $language]
+    if { ![catch { set name $cat_lang($locale) }] } {
+        # exact match: found name for this default language locale
+        return $name
+    }
+    
+    # Trying system locale for package (or site-wide)
+    set locale [lang::system::locale]
+    if { ![catch { set name $cat_lang($locale) }] } {
+        return $name
+    }
+
+    # Trying site-wide system locale
+    set locale [lang::system::locale -site_wide]
+    if { ![catch { set name $cat_lang($locale) }] } {
+        return $name
+    }
+
+    # Resort to en_US
     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 {}
 }

tcl/categories-procs.xql

 <?xml version="1.0"?>
 <queryset>
 
+<fullquery name="category::get_id.get_category_id">      
+      <querytext>
+      
+		select category_id
+		from category_translations
+		where name = :name
+		and locale = :locale
+	    
+      </querytext>
+</fullquery>
+
 <fullquery name="category::update.check_category_existence">      
       <querytext>
       
@@ -27,8 +38,11 @@
       <querytext>
       
 			insert into category_object_map (category_id, object_id)
-			values (:category_id, :object_id)
-		    
+			select :category_id, :object_id
+                        where not exists (select 1
+                                          from category_object_map
+                                          where category_id = :category_id
+                                            and object_id = :object_id);
       </querytext>
 </fullquery>
 
@@ -60,7 +74,16 @@
       </querytext>
 </fullquery>
 
- 
+<fullquery name="category::get_mapped_categories.get_filtered">
+        <querytext>
+                SELECT category_object_map.category_id
+                FROM category_object_map, categories
+                WHERE object_id = :object_id 
+                  AND tree_id = :tree_id
+                  AND category_object_map.category_id = categories.category_id
+        </querytext>
+</fullquery>
+
 <fullquery name="category::reset_translation_cache.reset_translation_cache">      
       <querytext>
       
@@ -80,8 +103,7 @@
 	    from category_translations t, categories c
 	    where t.category_id = :category_id
 	    and t.category_id = c.category_id
-	    order by t.locale
-	
+
       </querytext>
 </fullquery>
 

tcl/category-form-procs.tcl

@@ -14,6 +14,8 @@ ad_proc -public category::ad_form::add_widgets {
     {-categorized_object_id}
     {-form_name:required}
     {-element_name "category_id"}
+    {-excluded_trees {}}
+    {-help_text {}}
 } {
     For each category tree associated with this container_object_id (usually
     package_id) put a category widget into the ad_form.  On form submission the
@@ -26,6 +28,9 @@ ad_proc -public category::ad_form::add_widgets {
     
     foreach tree $category_trees {
 	util_unlist $tree tree_id name subtree_id assign_single_p require_category_p
+        if {[lsearch -exact $excluded_trees $tree_id] > -1} { 
+            continue
+        } 
 	set options ""
 	if {$assign_single_p == "f"} {
 	    set options ",multiple"
@@ -40,7 +45,10 @@ ad_proc -public category::ad_form::add_widgets {
                        {category_subtree_id $subtree_id} \
                        {category_object_id {[value_if_exists categorized_object_id]}} \
 		       {category_assign_single_p $assign_single_p} \
-		       {category_require_category_p $require_category_p}]]
+		       {category_require_category_p $require_category_p} \
+                       {help_text $help_text} \
+                      ]]
+        
     }
 }
 
@@ -61,7 +69,11 @@ ad_proc -public category::ad_form::get_categories {
 	util_unlist $tree tree_id name subtree_id assign_single_p require_category_p
         upvar #[template::adp_level] \
           __category__ad_form__$element_name\_${tree_id} my_category_ids
-        eval lappend category_ids $my_category_ids
+        if {[info exists my_category_ids]} { 
+            eval lappend category_ids $my_category_ids
+        } else { 
+            ns_log Warning "category::ad_form::get_categories: __category__ad_form__$element_name\_${tree_id} for tree $tree_id not found"
+        }
     }
     return $category_ids
 }

tcl/category-list-procs.tcl

@@ -77,6 +77,9 @@ ad_proc -public category::list::get_pretty_list {
     {-category_link ""}
     {-category_link_eval ""}
     {-category_link_html ""}
+    {-remove_link ""}
+    {-remove_link_eval ""}
+    {-remove_link_text ""}
     {-tree_delimiter "; "}
     {-tree_colon ": "}
     {-tree_link ""}
@@ -149,9 +152,16 @@ ad_proc -public category::list::get_pretty_list {
 	if {![empty_string_p $category_link_eval]} {
 	    set category_link [uplevel $uplevel concat $category_link_eval]
 	}
+
+	if {![empty_string_p $remove_link_eval]} {
+	    set remove_link [uplevel $uplevel concat $remove_link_eval]
+	}
 	if {![empty_string_p $category_link]} {
 	    set category_name "<a href=\"$category_link\"$cat_link_html>$category_name</a>"
 	}
+        if {![empty_string_p $remove_link]} { 
+            append category_name "&nbsp;<a href=\"$remove_link\" title=\"Remove this category\">$remove_link_text</a>"
+        }
 
 	if {$tree_id != $old_tree_id} {
 	    if {![empty_string_p $result]} {

tcl/category-relation-procs-postgresql.xql

+<?xml version="1.0"?>
+<queryset>
+
+<rdbms><type>postgresql</type><version>7.1</version></rdbms>
+
+<fullquery name="category::relation::add_meta_category.add_meta_relation">
+    <querytext>
+	 select acs_rel__new ( null, 'meta_category_rel', :category_id_one, :category_id_two, null, null, null )
+    </querytext>
+</fullquery>
+
+<fullquery name="category::relation::add_meta_category.add_user_meta_relation">
+    <querytext>
+	 select acs_rel__new ( null, 'user_meta_category_rel', :meta_category_id, :user_id, null, null, null )
+    </querytext>
+</fullquery>
+
+</queryset>

tcl/category-relation-procs.tcl

+ad_library {
+    Procedures to relate to categories trees (meta category) to one user_id
+
+    @author Miguel Marin (miguelmarin@viaro.net)
+    @author Viaro Networks www.viaro.net
+    @creation-date  2005-07-26
+}
+
+namespace eval category::relation {}
+
+
+ad_proc -public category::relation::add_meta_category {
+    -category_id_one:required
+    -category_id_two:required
+    {-user_id ""}
+} {
+    Creates a new meta category by creating a realtion between category_id_one 
+    and category_id_two. This relation is also related to the user_id.
+
+    @option user_id user that will be related to the meta category.
+    @option category_id_one one of the two category_id's to be related.
+    @option category_id_two the other category_id to be related.
+    @author Miguel Marin (miguelmarin@viaro.net)
+    @author Viaro Networks www.viaro.net
+} {
+    if { [empty_string_p $user_id] } {
+	set user_id [ad_conn user_id]
+    }
+ 
+    # First we check if the relation exist, if it does, we don't create a new one
+    set meta_category_id [db_string get_meta_relation_id {} -default ""]
+    if { [empty_string_p $meta_category_id] } { 
+	set meta_category_id [db_exec_plsql add_meta_relation {}]
+    }
+    
+    # Now we check if the user already has the meta category associated,
+    # if it does, we don't create a new one
+    set user_meta_category_id [db_string get_user_meta_relation_id {} -default ""]
+    if { [empty_string_p $user_meta_category_id] } { 
+	return [db_exec_plsql add_user_meta_relation {}]
+    } else {
+	return $user_meta_category_id
+    }
+}
+
+ad_proc -public category::relation::get_widget {
+    -tree_id_one:required
+    -tree_id_two:required
+} {
+    Returns two select menus of the categories on each tree to be used in ad_form. The name of the elements
+    are meta_category_one and meta_category_two.
+    
+
+    @option tree_id_one 
+    @option tree_id_two
+    @author Miguel Marin (miguelmarin@viaro.net)
+    @author Viaro Networks www.viaro.net
+} {
+    set label_one [category_tree::get_name $tree_id_one]
+    set label_two [category_tree::get_name $tree_id_two]
+    set element_one  "\{meta_category_one:integer(select) \{label $label_one\} \{options \{ "
+    set element_two  "\{meta_category_two:integer(select) \{label $label_two\} \{options \{ "
+   
+    foreach category_one [category_tree::get_tree $tree_id_one] {
+	set value_one [lindex $category_one 0]
+	set label_one [lindex $category_one 1]
+	append element_one "\{$label_one $value_one\} "
+    }
+    foreach category_two [category_tree::get_tree $tree_id_two] {
+	set value_two [lindex $category_two 0]
+	set label_two [lindex $category_two 1]
+	append element_two "\{$label_two $value_two\} "
+    }
+    append element_one "\} \} \}"
+    append element_two "\} \} \}"
+
+    return "$element_one  $element_two"
+}
+
+ad_proc -public category::relation::get_meta_categories {
+    -rel_id:required
+} {
+    return cached list of category_one and category_two of the meta-category
+} {
+    return [util_memoize [list category::relation::get_meta_category_internal -rel_id $rel_id]]
+}
+
+ad_proc -private category::relation::get_meta_category_internal {
+    -rel_id:required
+} {
+    get list of category_one and category_two of the meta-category
+} {
+    db_1row get_categories {}
+    return [list $object_id_one $object_id_two]
+}

tcl/category-relation-procs.xql

+<?xml version="1.0"?>
+<queryset>
+
+<fullquery name="category::relation::add_meta_category.get_meta_relation_id">
+    <querytext>
+        select 
+		rel_id
+        from   
+		acs_rels 
+        where  
+		rel_type = 'meta_category_rel'
+        	and object_id_one = :category_id_one
+        	and object_id_two = :category_id_two
+    </querytext>
+</fullquery>
+
+<fullquery name="category::relation::add_meta_category.get_user_meta_relation_id">
+    <querytext>
+        select 
+		rel_id
+        from   
+		acs_rels 
+        where  
+		rel_type = 'user_meta_category_rel'
+        	and object_id_one = :meta_category_id
+        	and object_id_two = :user_id
+    </querytext>
+</fullquery>
+
+<fullquery name="category::relation::get_meta_category_internal.get_categories">
+    <querytext>
+ 	select object_id_one, object_id_two
+	from acs_rels
+	where rel_id = :rel_id
+	and rel_type = 'meta_category_rel'
+    </querytext>
+</fullquery>
+
+
+</queryset>
\ No newline at end of file

tcl/category-synonyms-procs-postgresql.xql

@@ -44,7 +44,7 @@
 <fullquery name="category_synonym::search_sweeper.delete_old_searches">
       <querytext>
 		delete from category_search
-		where last_queried < current_timestamp - '1 day'::interval
+		where last_queried < current_timestamp - cast('1 days' as interval)
       </querytext>
 </fullquery>
 

tcl/category-trees-procs-oracle.xql

@@ -133,10 +133,10 @@
 <fullquery name="category_tree::usage.category_tree_usage">      
       <querytext>
       
-	    select t.pretty_plural, n.object_id, n.object_name, p.package_id,
+	    select t.pretty_plural, n.object_id, n.title, 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,
+	    from category_tree_map m, acs_objects n,
 	         apm_packages p, apm_package_types t
 	    where m.tree_id = :tree_id
 	    and n.object_id = m.object_id

tcl/category-trees-procs-postgresql.xql

@@ -100,10 +100,10 @@
  
 <fullquery name="category_tree::usage.category_tree_usage">      
       <querytext>
-	    select t.pretty_plural, n.object_id, n.object_name, p.package_id,
+	    select t.pretty_plural, n.object_id, n.title, 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,
+	    from category_tree_map m, acs_objects n,
 	         apm_packages p, apm_package_types t
 	    where m.tree_id = :tree_id
 	    and n.object_id = m.object_id

tcl/category-trees-procs.xql

@@ -24,6 +24,17 @@
       </querytext>
 </fullquery>
 
+<fullquery name="category_tree::get_id.get_category_tree_id">
+      <querytext>
+      
+		select tree_id
+		from category_tree_translations
+		where name = :name
+		and locale = :locale
+	    
+      </querytext>
+</fullquery>
+
  
 <fullquery name="category_tree::update.check_tree_existence">      
       <querytext>
@@ -109,4 +120,16 @@
 </fullquery>
 
  
+<fullquery name="category_tree::get_id.get_category_tree_id">
+      <querytext>
+      
+		select tree_id
+		from category_tree_translations
+		where name = :name
+		and locale = :locale
+	    
+      </querytext>
+</fullquery>
+
+
 </queryset>

tcl/category-xml-procs.tcl

+ad_library {
+    Procedures for importing/exporting category trees from/to XML documents.
+
+    @author Tom Ayles (tom@beatniq.net)
+    @creation-date 2003-12-02
+    @cvs-id $Id$
+}
+
+namespace eval ::category_tree::xml {}
+
+ad_proc -public ::category_tree::xml::import_from_file {
+    {-site_wide:boolean}
+    file
+} {
+    Imports a category tree from a given file.
+} {
+    if {![file exists $file] || ![file readable $file]} {
+        error {Cannot open file for reading}
+    }
+
+    return [import -site_wide=$site_wide_p [::tDOM::xmlReadFile $file]]
+}
+
+ad_proc -public ::category_tree::xml::import {
+    {-site_wide:boolean}
+    xml
+} {
+    Imports a category tree from an XML representation.
+
+    @param xml A string containing the source XML to import from
+    @return The category tree identifier
+    @author Tom Ayles (tom@beatniq.net)
+} {
+    # recode site_wide_p to DB-style boolean
+    if $site_wide_p { set site_wide_p t } else { set site_wide_p f }
+
+    set doc [dom parse $xml]
+    if [catch {set root [$doc documentElement]} err] {
+        error "Error parsing XML: $err"
+    }
+
+    set tree_id 0
+
+    db_transaction {
+        foreach translation [$root selectNodes {translation}] {
+            if [catch {set locale [$translation getAttribute locale]}] {
+                error "Required attribute 'locale' not found"
+            }
+            if [catch {set name [[$translation selectNodes {name}] text]}] {
+                error "Required element 'name' not found"
+            }
+            if [catch {set description \
+                           [[$translation selectNodes {description}] text]}] {
+                set description {}
+            }
+            if $tree_id {
+                # tree initialised, add translation
+                category_tree::update \
+                    -tree_id $tree_id \
+                    -name $name \
+                    -description $description \
+                    -locale $locale
+            } else {
+                # initialise tree
+                set tree_id [category_tree::add \
+                                 -site_wide_p $site_wide_p \
+                                 -name $name \
+                                 -description $description \
+                                 -locale $locale]
+            }
+        }
+
+        foreach category [$root selectNodes {category}] {
+            add_category -tree_id $tree_id -parent_id {} $category
+        }
+    }
+    
+    $doc delete
+
+    return $tree_id
+}
+
+ad_proc -private ::category_tree::xml::add_category {
+    {-tree_id:required}
+    {-parent_id:required}
+    node
+} {
+    Imports one category.
+} {
+    set category_id 0
+    
+    # do translations
+    foreach translation [$node selectNodes {translation}] {
+        if [catch {set locale [$translation getAttribute locale]}] {
+            error "Required attribute 'locale' not found"
+        }
+        if [catch {set name [[$translation selectNodes {name}] text]}] {
+            error "Required element 'name' not found"
+        }
+        if [catch {set description \
+                       [[$translation selectNodes {description}] text]}] {
+            set description {}
+        }
+
+        if $category_id {
+            # category exists, add translation
+            category::update \
+                -category_id $category_id \
+                -locale $locale \
+                -name $name \
+                -description $description
+        } else {
+            # create category
+            set category_id [category::add \
+                                 -tree_id $tree_id \
+                                 -parent_id $parent_id \
+                                 -locale $locale \
+                                 -name $name \
+                                 -description $description]
+        }
+    }
+    
+    # do children
+    foreach child [$node selectNodes {category}] {
+        add_category -tree_id $tree_id -parent_id $category_id $child
+    }
+}

tcl/install-procs.tcl

+ad_library {
+
+    Procs which may be invoked using similarly named elements in an
+    install.xml file.
+
+    @creation-date 2005-02-10
+    @author Lee Denison (lee@thaum.net)
+    @cvs-id $Id$
+}
+
+namespace eval install {}
+namespace eval install::xml {}
+namespace eval install::xml::action {}
+
+ad_proc -public install::xml::action::load-categories { node } {
+    Load categories from a file.
+} {
+    set src [apm_required_attribute_value $node src]
+    set site_wide_p [apm_attribute_value -default 0 $node site-wide-p]
+    set format [apm_attribute_value -default "simple" $node format]
+    set id [apm_attribute_value -default "" $node id]
+
+    switch -exact $format {
+        simple {
+            set tree_id [category_tree::xml::import_from_file \
+                -site_wide=[template::util::is_true $site_wide_p] \
+                [acs_root_dir]$src]
+        }
+        default {
+            error "Unsupported format."
+        }
+    }
+
+    if {![string equal $id ""]} {
+        set ::install::xml::ids($id) $tree_id
+    }
+}
+
+ad_proc -public install::xml::action::map-category-tree { node } {
+    Maps a category tree to a specified object.
+} {
+    set tree_id [apm_attribute_value -default "" $node tree-id]
+    set object_id [apm_attribute_value -default "" $node object-id]
+
+    set tree_ids [list]
+    if {[string equal $tree_id ""]} {
+        set trees_node [lindex [xml_node_get_children_by_name $node trees] 0]
+        set trees [xml_node_get_children $trees_node]
+
+        foreach tree_node $trees {
+            lappend tree_ids [apm_invoke_install_proc \
+                -type object_id \
+                -node $tree_node]
+        }
+    } else {
+        lappend tree_ids [install::xml::util::get_id $tree_id]
+    }
+
+    set object_ids [list]
+    if {[string equal $object_id ""]} {
+        set objects_node [lindex [xml_node_get_children_by_name $node objects] 0]
+        set objects [xml_node_get_children $objects_node]
+
+        foreach object_node $objects {
+            lappend object_ids [apm_invoke_install_proc \
+                -type object_id \
+                -node $object_node]
+        }
+    } else {
+        lappend object_ids [install::xml::util::get_id $object_id]
+    }
+
+    foreach tree_id $tree_ids {
+        if {[string equal [acs_object_type $tree_id] category]} {
+            set subtree_category_id $tree_id
+            set tree_id [category::get_tree $subtree_category_id]
+        } else {
+            set subtree_category_id {}
+        }
+
+        foreach object_id $object_ids {
+            category_tree::map -tree_id $tree_id \
+                -object_id $object_id \
+                -subtree_category_id $subtree_category_id
+        }
+    }
+}

tcl/tagcloud-procs.tcl

+# /Users/matthewburke/development/web/bitdojo/packages/categories/tcl/tagcloud-procs.tcl
+ad_library {
+     
+     Procs to generate a tag cloud for a given category tree.
+
+     @author Matthew Burke (matt-oacs@bluedino.net)
+     @creation-date Sun Oct  2 16:58:34 2005
+     @cvs-id
+}
+
+
+namespace eval category::tagcloud {}
+
+
+ad_proc -private category::tagcloud::get_minmax_tagweights {
+    -tag_list:required
+} {
+    Returns a list with the minimum and maximum weight values in the given list.
+
+    @author Matthew Burke (matt-oacs@bluedino.net)
+} {
+    set max_weight 0
+    set min_weight [lindex [lindex $tag_list 0] 1]
+    foreach tag $tag_list {
+        set tag_weight [lindex $tag 1]
+        if {$tag_weight < $min_weight} {
+            set min_weight $tag_weight
+        }
+        if {$tag_weight > $max_weight} {
+            set max_weight $tag_weight
+        }
+    }
+    return [list $min_weight $max_weight]
+}
+
+
+ad_proc -private category::tagcloud::scale_weight {
+    -weight:required
+    -extremes:required
+} {
+    Returns the weight as a font-size between 10px and 36px scaled between
+    the min and max weights passed in.
+
+    @author Matthew Burke (matt-oacs@bluedino.net)
+} {
+    set denominator [expr [lindex $extremes 1] - [lindex $extremes 0]]
+    if {$denominator != 0} {
+        set multiplier [expr ($weight * 1.0)/$denominator]
+    } else {
+        set multiplier 0
+    }
+    set result [expr 10 + round($multiplier*(36-10))]
+    return $result
+}
+
+
+ad_proc -public category::tagcloud::tagcloud {
+    -tree_id:required
+} {
+    Generate a tag cloud for the categories in the given category
+    tree.
+
+    @option tree_id tree_id of the tree fro which to generate the cloud.
+    @return HTML fragment for the tag cloud.
+    @author Matthew Burke (matt-oacs@bluedino.net)
+} {
+    set html_fragment "<div class=\"tagcloud\">\n"
+    set tag_list [category::tagcloud::get_tags -tree_id $tree_id]
+
+    # now build the frag
+    set weights [category::tagcloud::get_minmax_tagweights -tag_list $tag_list]
+
+    # and what if category package isn't mounted at /category?
+
+    foreach tag $tag_list {
+        append html_fragment "<a href=\"/categories/categories-browse?tree_ids=$tree_id&category_ids=[lindex $tag 0]\" style=\"font-size: [category::tagcloud::scale_weight -weight [lindex $tag 1] -extremes $weights]px;\" class=\"tag\">[lindex $tag 2]</a>\n"
+    }
+    append html_fragment "</div>"
+
+    return $html_fragment
+}
+
+
+ad_proc -private category::tagcloud::get_tags_no_mem {
+    -tree_id:required
+} {
+    Returns a list of categories and their weights (number of objects mapped
+    to each category) for a give category tree.
+
+    @author Matthew Burke (matt-oacs@bluedino.net)
+    @creation-date  Oct 1, 2005
+
+} {
+
+    set user_locale [ad_conn locale]
+    set user_id [ad_conn user_id]
+    set default_locale [ad_parameter DefaultLocale acs-lang "en_US"]
+    ns_log Warning "def loc $default_locale"
+
+    # this whole locale thing isn't handled well.
+    # categories get inserted in the site's default_locale and
+    # the category creator's locale (?)
+
+    # so we should check for the reader's locale and use that
+    # or the default_locale, but ...
+
+    set tag_list [db_list_of_lists tagcloud_get_keys {
+        select category_id, count(com.object_id), min(trans.name)
+        from categories natural left join category_object_map com natural join category_trees
+        natural join category_translations trans
+        where tree_id = :tree_id and trans.locale = :default_locale
+	and exists (select 1 from acs_object_party_privilege_map ppm
+                    where ppm.object_id = com.object_id
+                    and ppm.privilege = 'read'
+                    and ppm.party_id = :user_id)
+        group by category_id
+    }]
+}
+
+
+
+ad_proc -public category::tagcloud::get_tags {
+    -tree_id:required
+} {
+    Returns a list of categories and their weights (number of objects mapped
+    to each category) for a give category tree.
+
+    This is a memoized function which caches for two hours.
+
+    @author Matthew Burke (matt-oacs@bluedino.net)
+    @creation-date  Oct 1, 2005
+    @see category::tagcloud::get_tags_no_mem
+
+} {
+    return [util_memoize [list category::tagcloud::get_tags_no_mem -tree_id $tree_id] 7200]
+}
+
+
+

tcl/widget-procs.tcl

@@ -20,12 +20,20 @@ ad_proc -public template::widget::category { element_reference tag_attributes }
     upvar $element_reference element
 
     if { [info exists element(html)] } {
-	array set attributes $element(html)
+      	array set attributes $element(html)
+      	array set ms_attributes $element(html)
     }
+
     array set attributes $tag_attributes
     array set ms_attributes $tag_attributes
+
+    if { ![info exists element(display_widget)] } {
+        set display_widget select
+    } else {
+        set display_widget $element(display_widget)
+    }
     set ms_attributes(multiple) {}
-    
+
     set all_single_p [info exists attributes(single)]
 
     # Determine the size automatically for a multiselect
@@ -71,6 +79,8 @@ ad_proc -public template::widget::category { element_reference tag_attributes }
 
     if { ![empty_string_p $object_id] && ![info exists element(submit)] } {
         set mapped_categories [category::get_mapped_categories $object_id]
+    } elseif { ![empty_string_p $element(values)] && ![info exists element(submit)] } {
+	set mapped_categories $element(values)
     } else {
 	set mapped_categories [ns_querygetall $element(id)]
 	# QUIRK: ns_querygetall returns a single-element list {{}} for no values
@@ -83,17 +93,32 @@ ad_proc -public template::widget::category { element_reference tag_attributes }
     if { [empty_string_p $tree_id] } {
         set mapped_trees [category_tree::get_mapped_trees $package_id]
     } else {
-        set mapped_trees [list [list $tree_id [category_tree::get_name $tree_id] $subtree_id $assign_single_p $require_category_p]]
+        set mapped_trees {}
+        foreach one_tree $tree_id one_subtree $subtree_id assign_single $assign_single_p require_category $require_category_p {
+            if {[empty_string_p $assign_single]} {
+                set assign_single f
+            }
+            if {[empty_string_p $require_category]} {
+                set require_category f
+            }
+            lappend mapped_trees [list $one_tree [category_tree::get_name $one_tree] $one_subtree $assign_single $require_category]
+        }
     }
 
     foreach mapped_tree $mapped_trees {
 	util_unlist $mapped_tree tree_id tree_name subtree_id assign_single_p require_category_p
-	set tree_name [ad_quotehtml $tree_name]
+	set tree_name [ad_quotehtml [lang::util::localize $tree_name]]
 	set one_tree [list]
 
+        if { $require_category_p == "t" } { 
+            set required_mark "<span class=\"form-required-mark\">*</span>"
+        } else {
+            set required_mark {}
+        }
+
 	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]
+	    set category_name [ad_quotehtml [lang::util::localize $category_name]]
 	    if { $level>1 } {
 		set category_name "[string repeat "&nbsp;" [expr 2*$level -4]]..$category_name"
 	    }
@@ -101,7 +126,7 @@ ad_proc -public template::widget::category { element_reference tag_attributes }
 	}
 
         if { [llength $mapped_trees] > 1 } {
-            append output " $tree_name\: "
+            append output "<div class=\"categorySelect\"><div class=\"categoryTreeName\">$tree_name$required_mark</div>"
 	}
 
 	if {$assign_single_p == "t" || $all_single_p} {
@@ -109,14 +134,17 @@ ad_proc -public template::widget::category { element_reference tag_attributes }
             if { $require_category_p == "f" } {
                 set one_tree [concat [list [list "" ""]] $one_tree]
             }
-	    append output [template::widget::menu $element(name) $one_tree $mapped_categories attributes $element(mode)]
+	    append output [template::widget::menu $element(name) $one_tree $mapped_categories attributes $element(mode) $display_widget]
 	} else {
 	    # multiselect widget (if user didn't override with single option)
-	    append output [template::widget::menu $element(name) $one_tree $mapped_categories ms_attributes $element(mode)]
+	    append output [template::widget::menu $element(name) $one_tree $mapped_categories ms_attributes $element(mode) $display_widget]
 	}
+	if { [llength $mapped_trees] > 1 } {
+            append output "</div>"
+        }
     }
 
-    return $output
+    return [lang::util::localize $output]
 }
 
 ad_proc -public template::data::validate::category { value_ref message_ref } {

www/cadmin/category-delete-2.tcl

@@ -11,7 +11,7 @@ ad_page_contract {
     object_id:integer,optional
 }
 
-set user_id [ad_maybe_redirect_for_registration]
+set user_id [auth::require_login]
 permission::require_permission -object_id $tree_id -privilege category_tree_write
 
 db_transaction {

www/cadmin/category-delete.tcl

@@ -18,7 +18,7 @@ ad_page_contract {
     mapped_objects_p:onevalue
 }
 
-set user_id [ad_maybe_redirect_for_registration]
+set user_id [auth::require_login]
 permission::require_permission -object_id $tree_id -privilege category_tree_write
 
 multirow create categories category_id category_name objects_p view_url

www/cadmin/category-form.tcl

@@ -14,7 +14,7 @@ ad_page_contract {
     page_title:onevalue
 }
 
-set user_id [ad_maybe_redirect_for_registration]
+set user_id [auth::require_login]
 set package_id [ad_conn package_id]
 permission::require_permission -object_id $tree_id -privilege category_tree_write
 

www/cadmin/category-link-add-2.tcl

@@ -17,7 +17,7 @@ ad_page_contract {
     trees:multirow
 }
 
-set user_id [ad_maybe_redirect_for_registration]
+set user_id [auth::require_login]
 
 permission::require_permission -object_id $tree_id -privilege category_tree_write
 permission::require_permission -object_id $link_tree_id -privilege category_tree_write

www/cadmin/category-link-add-3.tcl

@@ -12,7 +12,7 @@ ad_page_contract {
     object_id:integer,optional
 }
 
-set user_id [ad_maybe_redirect_for_registration]
+set user_id [auth::require_login]
 permission::require_permission -object_id $tree_id -privilege category_tree_write
 
 db_transaction {

www/cadmin/category-link-add-4.tcl

@@ -12,7 +12,7 @@ ad_page_contract {
     object_id:integer,optional
 }
 
-set user_id [ad_maybe_redirect_for_registration]
+set user_id [auth::require_login]
 permission::require_permission -object_id $tree_id -privilege category_tree_write
 
 db_transaction {

www/cadmin/category-link-add.tcl

@@ -16,7 +16,7 @@ ad_page_contract {
     trees:multirow
 }
 
-set user_id [ad_maybe_redirect_for_registration]
+set user_id [auth::require_login]
 permission::require_permission -object_id $tree_id -privilege category_tree_write
 
 set tree_name [category_tree::get_name $tree_id $locale]

www/cadmin/category-link-delete-2.tcl

@@ -12,7 +12,7 @@ ad_page_contract {
     object_id:integer,optional
 }
 
-set user_id [ad_maybe_redirect_for_registration]
+set user_id [auth::require_login]
 permission::require_permission -object_id $tree_id -privilege category_tree_write
 
 db_transaction {

www/cadmin/category-link-delete.tcl

@@ -18,7 +18,7 @@ ad_page_contract {
     cancel_url:onevalue
 }
 
-set user_id [ad_maybe_redirect_for_registration]
+set user_id [auth::require_login]
 permission::require_permission -object_id $tree_id -privilege category_tree_write
 
 set tree_name [category_tree::get_name $tree_id $locale]

www/cadmin/category-links-view.tcl

@@ -16,7 +16,7 @@ ad_page_contract {
     category_links:multirow
 }
 
-set user_id [ad_maybe_redirect_for_registration]
+set user_id [auth::require_login]
 permission::require_permission -object_id $tree_id -privilege category_tree_write
 
 set tree_name [category_tree::get_name $tree_id $locale]

www/cadmin/category-parent-change.tcl

@@ -16,7 +16,7 @@ ad_page_contract {
     tree:multirow
 }
 
-set user_id [ad_maybe_redirect_for_registration]
+set user_id [auth::require_login]
 permission::require_permission -object_id $tree_id -privilege category_tree_write
 
 set category_name [category::get_name $category_id $locale]

www/cadmin/category-usage.tcl

@@ -25,7 +25,7 @@ ad_page_contract {
     pages:onerow
 }
 
-set user_id [ad_maybe_redirect_for_registration]
+set user_id [auth::require_login]
 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

www/cadmin/index.tcl

@@ -15,10 +15,10 @@ ad_page_contract {
     trees_with_read_permission:multirow
 }
 
-set page_title "Category Management"
+set page_title "[_ categories.cadmin]"
 set context_bar [list $page_title]
 
-set user_id [ad_maybe_redirect_for_registration]
+set user_id [auth::require_login]
 set package_id [ad_conn package_id]
 
 permission::require_permission -object_id $package_id -privilege category_admin
@@ -61,12 +61,15 @@ set elements {
     }
 }
 
-template::list::create \
+list::create \
     -name trees_with_write_permission \
     -no_data "None" \
-    -elements $elements
+    -elements $elements \
+    -key tree_id \
+    -bulk_action_export_vars {locale} \
+    -bulk_actions [list "[_ categories.export]" trees-code "[_ categories.code_export]"] \
 
-template::list::create \
+list::create \
     -name trees_with_read_permission \
     -no_data "None" \
     -elements $elements

www/cadmin/object-map.tcl

@@ -18,7 +18,7 @@ ad_page_contract {
     object_name:onevalue
 }
 
-set user_id [ad_maybe_redirect_for_registration]
+set user_id [auth::require_login]
 permission::require_permission -object_id $object_id -privilege admin
 
 set context_bar [category::get_object_context $object_id]

www/cadmin/permission-manage.tcl

@@ -15,7 +15,7 @@ ad_page_contract {
     url_vars:onevalue
 }
 
-set user_id [ad_maybe_redirect_for_registration]
+set user_id [auth::require_login]
 permission::require_permission -object_id $tree_id -privilege category_tree_grant_permissions
 
 array set tree [category_tree::get_data $tree_id $locale]

www/cadmin/site-wide-status-change.tcl

@@ -10,7 +10,7 @@ ad_page_contract {
     object_id:integer,optional
 }
 
-set user_id [ad_maybe_redirect_for_registration]
+set user_id [auth::require_login]
 set package_id [ad_conn package_id]
 permission::require_permission -object_id $package_id -privilege category_admin
 

www/cadmin/synonym-delete-2.tcl

@@ -12,7 +12,7 @@ ad_page_contract {
     object_id:integer,optional
 }
 
-set user_id [ad_maybe_redirect_for_registration]
+set user_id [auth::require_login]
 permission::require_permission -object_id $tree_id -privilege category_tree_write
 
 db_transaction {

www/cadmin/synonym-delete.tcl

@@ -18,7 +18,7 @@ ad_page_contract {
     cancel_url:onevalue
 }
 
-set user_id [ad_maybe_redirect_for_registration]
+set user_id [auth::require_login]
 permission::require_permission -object_id $tree_id -privilege category_tree_write
 
 set tree_name [category_tree::get_name $tree_id $locale]

www/cadmin/synonym-form.tcl

@@ -15,7 +15,7 @@ ad_page_contract {
     page_title:onevalue
 }
 
-set user_id [ad_maybe_redirect_for_registration]
+set user_id [auth::require_login]
 permission::require_permission -object_id $tree_id -privilege category_tree_write
 
 set tree_name [category_tree::get_name $tree_id $locale]

www/cadmin/synonyms-view.tcl

@@ -16,7 +16,7 @@ ad_page_contract {
     synonyms:multirow
 }
 
-set user_id [ad_maybe_redirect_for_registration]
+set user_id [auth::require_login]
 permission::require_permission -object_id $tree_id -privilege category_tree_write
 
 set tree_name [category_tree::get_name $tree_id $locale]

www/cadmin/tree-copy-2.tcl

@@ -11,7 +11,7 @@ ad_page_contract {
     object_id:integer,optional
 }
 
-set user_id [ad_maybe_redirect_for_registration]
+set user_id [auth::require_login]
 set tree_id $target_tree_id
 permission::require_permission -object_id $tree_id -privilege category_tree_write
 

www/cadmin/tree-copy-view.tcl

@@ -16,7 +16,7 @@ ad_page_contract {
     tree:multirow
 }
 
-set user_id [ad_maybe_redirect_for_registration]
+set user_id [auth::require_login]
 set tree_id $source_tree_id
 
 array set target_tree [category_tree::get_data $target_tree_id $locale]

www/cadmin/tree-copy.tcl

@@ -16,7 +16,7 @@ ad_page_contract {
     tree_id:onevalue
 }
 
-set user_id [ad_maybe_redirect_for_registration]
+set user_id [auth::require_login]
 permission::require_permission -object_id $tree_id -privilege category_tree_write
 
 set tree_name [category_tree::get_name $tree_id $locale]

www/cadmin/tree-delete-2.tcl

@@ -10,7 +10,7 @@ ad_page_contract {
     object_id:integer,optional
 }
 
-set user_id [ad_maybe_redirect_for_registration]
+set user_id [auth::require_login]
 permission::require_permission -object_id $tree_id -privilege category_tree_write
 
 set instance_list [category_tree::usage $tree_id]

www/cadmin/tree-delete.adp

@@ -6,13 +6,13 @@
 <p>
 <table>
   <tr><th>Tree Name</th><td>@tree_name@</td></tr>
-  <tr><th>Description</th><td> @tree_description@</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>.
+  <a href="@usage_url@">here</a>.
 </if>
 
 <if @used_categories:rowcount@ gt 0>

www/cadmin/tree-delete.tcl

@@ -20,7 +20,7 @@ ad_page_contract {
     used_categories:multirow
 }
 
-set user_id [ad_maybe_redirect_for_registration]
+set user_id [auth::require_login]
 permission::require_permission -object_id $tree_id -privilege category_tree_write
 
 array set tree [category_tree::get_data $tree_id $locale]
@@ -41,6 +41,7 @@ if {[llength $instance_list] > 0} {
 
 set delete_url [export_vars -no_empty -base tree-delete-2 {tree_id locale object_id}]
 set cancel_url [export_vars -no_empty -base tree-view {tree_id locale object_id}]
+set usage_url [export_vars -no_empty -base tree-usage {tree_id}]
 
 template::multirow create used_categories category_id category_name view_url
 

www/cadmin/tree-map-2.tcl

@@ -16,7 +16,7 @@ ad_page_contract {
     {edit_p 0}
 }
 
-set user_id [ad_maybe_redirect_for_registration]
+set user_id [auth::require_login]
 permission::require_permission -object_id $object_id -privilege admin
 
 array set tree [category_tree::get_data $tree_id $locale]

www/cadmin/tree-map.tcl

@@ -15,7 +15,7 @@ ad_page_contract {
     tree:multirow
 }
 
-set user_id [ad_maybe_redirect_for_registration]
+set user_id [auth::require_login]
 permission::require_permission -object_id $object_id -privilege admin
 
 array set tree_data [category_tree::get_data $tree_id $locale]

www/cadmin/tree-unmap-2.tcl

@@ -10,7 +10,7 @@ ad_page_contract {
     object_id:integer,notnull
 } 
 
-set user_id [ad_maybe_redirect_for_registration]
+set user_id [auth::require_login]
 permission::require_permission -object_id $object_id -privilege admin
 
 array set tree [category_tree::get_data $tree_id $locale]

www/cadmin/tree-unmap.tcl

@@ -18,7 +18,7 @@ ad_page_contract {
     cancel_form_vars:onevalue
 }
  
-set user_id [ad_maybe_redirect_for_registration]
+set user_id [auth::require_login]
 permission::require_permission -object_id $object_id -privilege admin
 
 array set tree [category_tree::get_data $tree_id $locale]

www/cadmin/tree-usage.adp

@@ -15,7 +15,8 @@
   <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>
+      <li><a href="/o/@modules.object_id@">@modules.object_name@</a>
+          <a href="@unmap_url@" class="button">unmap</a></li>
     </group>
   </group>
   </ul>

www/cadmin/tree-usage.tcl

@@ -18,7 +18,7 @@ ad_page_contract {
     instances_without_permission:onevalue
 }
 
-set user_id [ad_maybe_redirect_for_registration]
+set user_id [auth::require_login]
 
 array set tree [category_tree::get_data $tree_id $locale]
 if {$tree(site_wide_p) == "f"} {
@@ -33,15 +33,17 @@ set context_bar [category::context_bar $tree_id $locale [value_if_exists object_
 lappend context_bar "Usage"
 
 
-template::multirow create modules package object_id object_name package_id instance_name read_p
+template::multirow create modules package object_id object_name package_id instance_name read_p unmap_url
 
 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
+    set unmap_url [export_vars -no_empty -base tree-unmap {tree_id object_id}]
+
     if {$read_p == "t"} {
-	template::multirow append modules $package $object_id $object_name $package_id $instance_name $read_p
+	template::multirow append modules $package $object_id $object_name $package_id $instance_name $read_p $unmap_url
     } else {
 	incr instances_without_permission
     }

www/cadmin/tree-view.tcl

@@ -19,7 +19,7 @@ ad_page_contract {
     can_write_p:onevalue
 }
 
-set user_id [ad_maybe_redirect_for_registration]
+set user_id [auth::require_login]
 
 array set tree [category_tree::get_data $tree_id $locale]
 if {$tree(site_wide_p) == "f"} {
@@ -31,9 +31,9 @@ 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 [export_vars -no_empty -base object-map {locale object_id}] "Category Management"] $tree_name]
+    set context_bar [list [category::get_object_context $object_id] [list [export_vars -no_empty -base object-map {locale object_id}] "[_ categories.cadmin]"] $tree_name]
 } else {
-    set context_bar [list [list ".?[export_vars -no_empty {locale}]" "Category Management"] $tree_name]
+    set context_bar [list [list ".?[export_vars -no_empty {locale}]" "[_ categories.cadmin]"] $tree_name]
 }
 
 set can_write_p [permission::permission_p -object_id $tree_id -privilege category_tree_write]

www/cadmin/trees-code.adp

+<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>#categories.code_necessary#</p>
+<pre style="border: 1px solid #CCC; background-color: #EEE; padding: 10px;">
+set default_locale [lang::system::site_wide_locale]
+<multiple name=trees>
+<include src="/packages/categories/lib/tree-code" tree_id="@trees.tree_id@">
+</multiple>
+</pre>

www/cadmin/trees-code.tcl

+ad_page_contract {
+
+    @author Timo Hentschel (timo@timohentschel.de)
+    @creation-date 2005-06-05
+    @cvs-id $Id$
+
+} {
+    {locale ""}
+    tree_id:multiple
+}
+
+set user_id [auth::require_login]
+permission::require_permission -object_id [ad_conn package_id] -privilege admin
+
+set page_title "[_ categories.code_export]"
+set context_bar [list [list ".?[export_vars -no_empty {locale}]" "[_ categories.cadmin]"] $page_title]
+
+multirow create trees tree_id
+foreach tid $tree_id {
+    multirow append trees $tid
+}
+
+ad_return_template

www/categories-browse.tcl

@@ -31,7 +31,7 @@ ad_page_contract {
     pages:onerow
 }
 
-set user_id [ad_maybe_redirect_for_registration]
+set user_id [auth::require_login]
 
 set page_title "Browse categories"
 

www/index.tcl

@@ -15,7 +15,7 @@ ad_page_contract {
 set page_title "Categories"
 set context_bar ""
 
-set user_id [ad_maybe_redirect_for_registration]
+set user_id [auth::require_login]
 set package_id [ad_conn package_id]
 set locale [ad_conn locale]
 

www/search-result.tcl

@@ -11,7 +11,7 @@ ad_page_contract {
     context_bar:onevalue
 }
 
-set user_id [ad_maybe_redirect_for_registration]
+set user_id [auth::require_login]
 set package_id [ad_conn package_id]
 set locale [ad_conn locale]