proc available_includelets
::818354 proc available_includelets {} {
if {[my array exists html]} {my array unset html}
my describe_includelets [::xowiki::Includelet info subclass]
set result "<UL>"
foreach d [lsort [my array names html]] {
append result "<LI>" [my set html($d)] "</LI>" \n
}
append result "</UL>"
return $result
}
proc describe_includelets
::818354 proc describe_includelets includelet_classes {
#my log "--plc=$includelet_classes "
foreach cl $includelet_classes {
set result ""
append result "{{<b>[namespace tail $cl]</b>"
foreach p [$cl info parameter] {
if {[llength $p] != 2} continue
foreach {name value} $p break
if {$name eq "parameter_declaration"} {
foreach pp $value {
#append result ""
switch [llength $pp] {
1 {append result " $pp"}
2 {
set v [lindex $pp 1]
if {$v eq ""} {set v {""}}
append result " [lindex $pp 0] <em>$v</em>"
}
}
#append result "\n"
}
}
}
append result "}}\n"
my set html([namespace tail $cl]) $result
my describe_includelets [$cl info subclass]
}
}
proc glob_clause
::818354 proc glob_clause {{-base_table ci} {-attribute name} value} {
# Return a clause for name matching.
# value uses * for matching
set glob [string map [list * %] $value]
return " and $base_table.$attribute like '$glob'"
}
proc html_encode
::818354 proc html_encode string {
# ' is not a known entity to some validators, so we use the
# numerical entity here for encoding "'"
return [string map [list & "&" < "<" > ">" \" """ ' "'"] $string]
}
proc html_id
::818354 proc html_id name {
# Construct a valid HTML id or name.
# For details, see http://www.w3.org/TR/html4/types.html
#
# For XOTcl object names, strip first the colons
set name [string trimleft $name :]
# make sure, the ID starts with characters
if {![regexp {^[A-Za-z]} $name]} {
set name id_$name
}
# replace unwanted characters
regsub -all {[^A-Za-z0-9_:.-]} $name _ name
return $name
}
proc html_to_text
::818354 proc html_to_text string {
return [string map [list "&" &] $string]
}
proc js_encode
::818354 proc js_encode string {
string map [list \n \\n \" {\"} ' {\'}] $string
}
proc js_name
::818354 proc js_name name {
return [string map [list : _ # _] $name]
}
proc listing
::818354 proc listing {-package_id {-count:boolean false} -folder_id {-parent_id ""} {-page_size 20} {-page_number ""} {-orderby ""} {-use_package_path true} {-extra_where_clause ""} {-glob ""}} {
if {$count} {
set attribute_selection "count(*)"
set orderby "" ;# no need to order when we count
set page_number "" ;# no pagination when count is used
} else {
set attribute_selection "i.name, r.title, p.page_id, r.publish_date, r.mime_type, i.parent_id, o.package_id, to_char(r.publish_date,'YYYY-MM-DD HH24:MI:SS') as formatted_date"
}
if {$page_number ne ""} {
set limit $page_size
set offset [expr {$page_size*($page_number-1)}]
} else {
set limit ""
set offset ""
}
set parent_id_clause [::xowiki::Includelet parent_id_clause -base_table i -use_package_path $use_package_path -parent_id $parent_id -base_package_id $package_id]
if {$glob ne ""} {
append extra_where_clause [::xowiki::Includelet glob_clause -base_table i $glob]
}
set sql [::xo::db::sql select -vars $attribute_selection -from "cr_items i, cr_revisions r, xowiki_page p, acs_objects o" -where "$parent_id_clause and r.revision_id = i.live_revision and i.item_id = o.object_id and p.page_id = r.revision_id and i.publish_status <> 'production' $extra_where_clause" -orderby $orderby -limit $limit -offset $offset]
if {$count} {
return [::xo::db_string count_listing $sql]
} else {
set s [::xowiki::Page instantiate_objects -sql $sql]
return $s
}
}
proc locale_clause
::818354 proc locale_clause {-revisions -items package_id locale} {
set default_locale [$package_id default_locale]
set system_locale ""
set with_system_locale [regexp {(.*)[+]system} $locale _ locale]
if {$locale eq "default"} {
set locale $default_locale
set include_system_locale 0
}
#my msg "--L with_system_locale=$with_system_locale, locale=$locale, default_locale=$default_locale"
set locale_clause ""
if {$locale ne ""} {
set locale_clause " and $revisions.nls_language = '$locale'"
if {$with_system_locale} {
set system_locale [lang::system::locale -package_id $package_id]
#my msg "system_locale=$system_locale, default_locale=$default_locale"
if {$system_locale ne $default_locale} {
set locale_clause " and ($revisions.nls_language = '$locale'
or $revisions.nls_language = '$system_locale' and not exists
(select 1 from cr_items i where i.name = '[string range $locale 0 1]:' ||
substring($items.name,4) and i.parent_id = $items.parent_id))"
}
}
}
#my msg "--locale $locale, def=$default_locale sys=$system_locale, cl=$locale_clause locale_clause=$locale_clause"
return [list $locale $locale_clause]
}
proc parent_id_clause
::818354 proc parent_id_clause {{-base_table bt} {-use_package_path true} {-parent_id ""} -base_package_id:required} {
#
# Get the package path and from it, the folder_ids. The parent_id
# of the returned pages should be a direct child of the folder.
#
if {$parent_id eq ""} {
set parent_id [$base_package_id folder_id]
}
set packages [$base_package_id package_path]
if {$use_package_path && [llength $packages] > 0} {
set parent_ids [list $parent_id]
foreach p $packages {lappend parent_ids [$p folder_id]}
return "$base_table.parent_id in ([join $parent_ids ,])"
} else {
return "$base_table.parent_id = $parent_id"
}
}
proc publish_status_clause
::818354 proc publish_status_clause {{-base_table ci} value} {
if {$value eq "all"} {
# legacy
set publish_status_clause ""
} else {
array set valid_state [list production 1 ready 1 live 1 expired 1]
set clauses [list]
foreach state [split $value |] {
if {![info exists valid_state($state)]} {
error "no such state: '$state'; valid states are: production, ready, live, expired"
}
lappend clauses "$base_table.publish_status='$state'"
}
set publish_status_clause " and ([join $clauses { or }])"
}
return $publish_status_clause
}
proc require_YUI_CSS
::818354 proc require_YUI_CSS {{-version 2.7.0} {-ajaxhelper true} path} {
if {$ajaxhelper} {
::xo::Page requireCSS "/resources/ajaxhelper/yui/$path"
} else {
::xo::Page requireCSS "http://yui.yahooapis.com/$version/build/$path"
}
}
proc require_YUI_JS
::818354 proc require_YUI_JS {{-version 2.7.0} {-ajaxhelper true} path} {
if {$ajaxhelper} {
::xo::Page requireJS "/resources/ajaxhelper/yui/$path"
} else {
::xo::Page requireJS "http://yui.yahooapis.com/$version/build/$path"
}
}
instproc category_clause
::818354 instproc category_clause {category_spec {item_ref p.item_id}} {
# the category_spec has the syntax "a,b,c|d,e", where the values are category_ids
# pipe symbols are or-operations, commas are and-operations;
# no parenthesis are permitted
set extra_where_clause ""
set or_names [list]
set ors [list]
foreach cid_or [split $category_spec |] {
set ands [list]
set and_names [list]
foreach cid_and [split $cid_or ,] {
lappend and_names [::category::get_name $cid_and]
lappend ands "exists (select 1 from category_object_map where object_id = $item_ref and category_id = $cid_and)"
}
lappend or_names "[join $and_names { and }]"
lappend ors "([join $ands { and }])"
}
set cnames "[join $or_names { or }]"
set extra_where_clause "and ([join $ors { or }])"
#my log "--cnames $category_spec -> $cnames"
return [list $cnames $extra_where_clause]
}
instproc get_page_order
::818354 instproc get_page_order {-source -ordered_pages -pages} {
my instvar page_order ordered_pages
#
# first check, if we can load the page_order from the page
# denoted by source
#
if {[info exists source]} {
set p [my resolve_page_name $source]
if {$p ne ""} {
array set ia [$p set instance_attributes]
if {[info exists ia(pages)]} {
set pages $ia(pages)
} elseif {[info exists ia(ordered_pages)]} {
set ordered_pages $ia(ordered_pages)
}
}
}
# compute a list of ordered_pages from pages, if necessary
if {[info exists ordered_pages]} {
foreach {order page} $ordered_pages {set page_order($page) $order}
} else {
set i 0
foreach page $pages {set page_order($page) [incr i]}
}
}
instproc include_head_entries
::818354 instproc include_head_entries {} {
# The purpose of this method is to contain all calls to include
# CSS files, javascript, etc. in the HTML Head. This kind of
# requirements could as well be included e.g. in render, but this
# won't work, if "render" is cached. This method is called before
# render to be executed even when render is not due to caching.
# It is intended to be overloaded by subclasses.
}
instproc initialize
::818354 instproc initialize {} {
# This method is called at a time after init and before render.
# It can be used to alter specified parameter from the user,
# or to influence the rendering of a decoration (e.g. title etc.)
}
instproc js_name
::818354 instproc js_name {} {
return [[self class] js_name [self]]
}
instproc resolve_page_name
::818354 instproc resolve_page_name page_name {
return [[my set __including_page] resolve_included_page_name $page_name]
}
instproc screen_name
::818354 instproc screen_name user_id {
acs_user::get -user_id $user_id -array user
return [expr {$user(screen_name) ne "" ? $user(screen_name) : $user(name)}]
}
![[i]](/resources/acs-subsite/ZoomIn16.gif)
::xowiki::Includelet