Index: openacs-4/packages/xowiki/www/prototypes/categories-portlet.page
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/prototypes/categories-portlet.page,v
diff -u -N
--- openacs-4/packages/xowiki/www/prototypes/categories-portlet.page 29 May 2009 13:38:08 -0000 1.5
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,114 +0,0 @@
-# -*- tcl-*-
-# $Id: categories-portlet.page,v 1.5 2009/05/29 13:38:08 gustafn Exp $
-::xowiki::Object new -title "Categories" -text {
-
- # display the category tree with associated pages
- # -gustaf neumann
- #
- # valid parameters from the adp include are
- # tree_name: match pattern, if specified displays only the trees
- # with matching names
- # no_tree_name: if specified, tree names are not displayed
- # open_page: name (e.g. en:iMacs) of the page to be opened initially
- # tree_style: boolean, default: true, display based on mktree
-
- my initialize -parameter {
- {-tree_name ""}
- {-tree_style:boolean 1}
- {-no_tree_name:boolean 0}
- {-count:boolean 0}
- {-summary:boolean 0}
- {-open_page ""}
- {-category_ids ""}
- {-except_category_ids ""}
- }
-
- #if {![info exists name]} {set name "Categories"}
-
- my proc content {} {
- my get_parameters
- set folder_id [$package_id folder_id]
-
- set open_item_id [expr {$open_page ne "" ?
- [::xo::db::CrClass lookup -name $open_page -parent_id $folder_id] : 0}]
-
- set content ""
-
- set tree_ids [::xowiki::Category get_mapped_trees -object_id $package_id \
- -names $tree_name -output {tree_id tree_name}]
-
- foreach tree $tree_ids {
- foreach {tree_id my_tree_name ...} $tree {break}
- if {!$no_tree_name} {
- append content "
$my_tree_name
"
- }
- set categories [list]
- set pos 0
- set cattree(0) [::xowiki::Tree new -volatile -orderby pos -name $my_tree_name]
- foreach category_info [::xowiki::Category get_category_infos -tree_id $tree_id] {
- foreach {cid category_label deprecated_p level} $category_info {break}
- set c [::xowiki::TreeNode new -orderby pos -category_id $cid -package_id $package_id \
- -level $level -label $category_label -pos [incr pos]]
- set cattree($level) $c
- set plevel [expr {$level -1}]
- $cattree($plevel) add $c
- set category($cid) $c
- lappend categories $cid
- #set itemobj [Object new -set name en:index -set title MyTitle -set prefix "" -set suffix ""]
- #$cattree(0) add_to_category -category $c -itemobj $itemobj -orderby title
- }
-
- set sql "category_object_map c, cr_items ci, cr_revisions r, xowiki_page p \
- where c.object_id = ci.item_id and ci.parent_id = $folder_id \
- and ci.content_type not in ('::xowiki::PageTemplate') \
- and category_id in ([join $categories ,]) \
- and r.revision_id = ci.live_revision \
- and p.page_id = r.revision_id"
-
- if {$except_category_ids ne ""} {
- append sql \
- " and not exists (select * from category_object_map c2 \
- where ci.item_id = c2.object_id \
- and c2.category_id in ($except_category_ids))"
- }
- #my log "--c category_ids=$category_ids"
- if {$category_ids ne ""} {
- foreach cid [split $category_ids ,] {
- append sql " and exists (select * from category_object_map \
- where object_id = ci.item_id and category_id = $cid)"
- }
- }
-
- if {$count} {
- db_foreach get_counts \
- "select count(*) as nr,category_id from $sql group by category_id" {
- $category($category_id) set count $nr
- set s [expr {$summary ? "&summary=$summary" : ""}]
- $category($category_id) href [ad_conn url]?category_id=$category_id$s
- $category($category_id) open_tree
- }
- append content [$cattree(0) render -tree_style $tree_style]
- } else {
- db_foreach get_pages \
- "select ci.item_id, ci.name, ci.content_type, r.title, category_id from $sql" {
- if {$title eq ""} {set title $name}
- set itemobj [Object new]
- set prefix ""
- set suffix ""
- foreach var {name title prefix suffix} {$itemobj set $var [set $var]}
- $cattree(0) add_to_category \
- -category $category($category_id) \
- -itemobj $itemobj \
- -orderby title \
- -open_item [expr {$item_id == $open_item_id}]
- }
- append content [$cattree(0) render -tree_style $tree_style]
- }
- }
- return $content
- }
-
-}
-
-
-