# -*- tcl-*-
# $Id: categories-portlet.page,v 1.7.2.1 2014/02/11 11:58:20 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} {
xo::dc 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 {
xo::dc 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
}
}