# -*- tcl-*- # $Id: categories-portlet.page,v 1.13 2018/04/25 19:47:48 hectorr 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 "mktree"} {-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 { lassign $tree tree_id my_tree_name if {!$no_tree_name} { append content "

$my_tree_name

" } set categories {} 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] { lassign $category_info cid category_label deprecated_p level set c [::xowiki::TreeNode new -orderby pos \ -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 } # skip trees without categories, as nothing will be mapped to them if {[llength $categories] == 0} continue 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 -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]} $itemobj set href [::$package_id pretty_link -parent_id $folder_id $name] $cattree(0) add_item \ -category $category($category_id) \ -itemobj $itemobj \ -orderby title \ -open_item [expr {$item_id == $open_item_id}] } append content [$cattree(0) render -style $tree_style] } } return $content } }