- Publicity: Public Only All
30-widget-procs.tcl
XOTcl HTML Widget Classes based on tDOM
- Location:
- packages/xotcl-core/tcl/30-widget-procs.tcl
- Created:
- 2005-11-26
- Authors:
- Gustaf Neumann <neumann@wu-wien.ac.at>
- Neophytos Demetriou <k2pts@phigita.net>
- CVS Identification:
$Id: 30-widget-procs.tcl,v 1.72 2024/09/11 06:15:56 gustafn Exp $
Procedures in this file
Detailed information
[ hide source ] | [ make this the default ]Content File Source
::xo::library doc { XOTcl HTML Widget Classes based on tDOM @author Gustaf Neumann (neumann@wu-wien.ac.at) @author Neophytos Demetriou (k2pts@phigita.net) @creation-date 2005-11-26 @cvs-id $Id: 30-widget-procs.tcl,v 1.72 2024/09/11 06:15:56 gustafn Exp $ } ::Serializer exportMethods { ::xotcl::Object instproc asHTML } Object instproc asHTML {{-master defaultMaster} -page:switch} { ::xo::require_html_procs dom createDocument html doc set root [$doc documentElement] if {!$page} { $root appendFromScript {:render} set nodes [$root childNode] return [join [lmap n $nodes {$n asHTML}] \n] } else { set slave [$master decorate $root] $slave appendFromScript {:render} ns_return 200 text/html [$root asHTML] } } # # Define Widget classes with localization # # Most importantly, we define ::xo::Table, somewhat similar to the classical multirow namespace eval ::xo {} namespace eval ::xo::tdom { ::xotcl::Class create ::xo::tdom::Class \ -superclass ::xotcl::Class \ -parameter {autoimport} ::xo::tdom::Class instproc incr_level {{amount 1}} { # # Keep the nesting level of TdomClass instances during creation. # Use a global variable to assure cleanup in case of exceptions. # set var __tdom_level global $var if {[info exists $var]} { incr $var $amount } else { set $var 1 } } ::xo::tdom::Class instproc unknown args { set configurecmds [lrange $args 0 end-1] set createcmd [lindex $args end] # # Keep a stack of nesting levels of ::xo::tdom Objects. # The stack is used for building automatically an ordered # composite of objects, used e.g. in recursive renderings. # [self class] instvar stack set level [:incr_level] # # Create a new instance of the current class and configure it. # #:log "tdom START $level [self], cmd='$configurecmds'" set me [:new -destroy_on_cleanup {*}$configurecmds] #:log "tdom CREATED $level $me ([$me info class])" # # If we are not on the topmost level, add the created object # to the parent ordered composite. # set stack($level) $me if {$level > 1} { set parent $stack([expr {$level - 1}]) #:log "tdom ADD $level $me to $parent ([$parent info class])" $parent add $me } # # search for autoimports: all commands are executed in the ... currently not needed # # set class [$me info class] # foreach cl [concat $class [$class info heritage]] { # :log "tdom EVAL $level ns=[namespace current] autoimport in $cl?[$cl exists autoimport]" # if {[$cl exists autoimport]} { # :log "tdom IMPO [$cl autoimport] into $me" # namespace eval ::xo::tmp [list namespace import -force [$cl autoimport]] # } # } # #:log "tdom CMDS $level [lsort [info commands ::xo::tmp::*]]" if {$createcmd ne ""} { # # perform the subcommand on the caller level to expand (like in tdom) # all specified variables in the caller's context # uplevel $createcmd } # # autorendering means that after creating an ordered composite, # the topmost element is automatically rendered. This makes # the ::xo::tdom classes behave more like plain tDOM commands. # #:log "tdom AUTO $level [$me autorender]" if {$level == 1 && [$me autorender]} { #:log "tdom RNDR $level $me render" $me render } #:log "tdom END $level [self] me=$me" set level [:incr_level -1] return $me } # # The tDOM attribute manager makes it syntactically easier to # specify a list of attributes for rendering via tDOM. # ::xotcl::Class create ::xo::tdom::AttributeManager ::xo::tdom::AttributeManager ad_instproc get_attributes { args } { Get a list of attribute value pairs of instance attributes. It returns only those pairs for which a value exists. @return flattened list of attribute value pairs } { set pairs [list] foreach attribute $args { set l [split $attribute] if {[llength $l] > 1} { lassign $l attribute HTMLattribute } else { set HTMLattribute $attribute } #:msg "${:name} check for $attribute => [info exists :$attribute]" if {[info exists :$attribute]} { lappend pairs $HTMLattribute [set :$attribute] } } return $pairs } ::xo::tdom::AttributeManager ad_instproc get_local_attributes { args } { Get a list of attribute value pairs of instance attributes. It returns only those pairs for which a value exists. @return flattened list of attribute value pairs } { set pairs [list] foreach attribute $args { set l [split $attribute] if {[llength $l] > 1} { lassign $l attribute HTMLattribute } else { set HTMLattribute $attribute } #:msg "${:name} check for $attribute => [info exists :$attribute]" if {[:uplevel [list info exists $attribute]]} { lappend pairs $HTMLattribute [:uplevel [list set $attribute]] } } return $pairs } # # ::xo::tdom::Object # is the top of the class hierarchies for tDOM objects # ::xotcl::Class create ::xo::tdom::Object \ -superclass {::xo::tdom::AttributeManager ::xo::OrderedComposite} \ -parameter {{autorender true}} ::xo::tdom::Object instproc render {} { foreach o [:children] { $o render } } # # General of HTML markup CSRF tokens in tDOM contexts # namespace eval ::html {} proc ::html::CSRFToken {} { ::if {[::info exists ::__csrf_token]} { ::html::input -type hidden -name __csrf_token -value $::__csrf_token {} } } } namespace eval ::xo { # # Escape provided char in provided string with backslash # proc backslash_escape {char string} { return [string map [list $char \\$char] $string] } # # Localization # # # The following pair of functions implement a crude method for # avoiding i16n substitutions. These are necessary, since xowiki # provides all its markup finally as "content" that is currently # internationalized without distinctions. However, sometimes # (e.g. values in forms) should be presented without i18n # processing. In such cases, the two functions below can be used to # prevent such substitutions. # proc remove_escapes {text} { regsub -all \x01# $text "#" text return $text } proc escape_message_keys {text} { regsub -all -- {(\#[a-zA-Z0-9_:-]+\.[a-zA-Z0-9_:-]+)\#} $text "\\1\x01#" text return $text } # # xo::localize function # set ::xo::acs_lang_url [apm_package_url_from_key acs-lang]admin proc localize {text {inline 0}} { #ns_log notice "--local $text $inline" set obj [uplevel self] if {![$obj exists __localizer]} { $obj set __localizer [list] } if {[string first \x02 $text] == -1} { return $text } else { set return_text "" if {$inline} { # Attempt to move all message keys outside of tags while { [regsub -all -- {(<[^>]*)(\x02\(\x01[^\x01]*\x01\)\x02)([^>]*>)} $text {\2\1\3} text] } {} # Attempt to move all message keys outside of <select>...</select> statements regsub -all -nocase -- {(<option\s[^>]*>[^<]*)(\x02\(\x01[^\x01]*\x01\)\x02)([^<]*</option[^>]*>)} $text {\2\1\3} text while { [regsub -all -nocase -- {(<select[^>]*>[^<]*)(\x02\(\x01[^\x01]*\x01\)\x02)} $text {\2\1} text] } {} } while {[regexp {^([^\x02]*)\x02\(\x01([^\x01]*)\x01\)\x02(.*)$} $text _ \ before key text]} { append return_text $before lassign [split $key .] package_key message_key set url [export_vars -base $::xo::acs_lang_url/edit-localized-message { {locale {[ad_conn locale]} } package_key message_key {return_url [ad_return_url]} }] if {[lang::message::message_exists_p [ad_conn locale] $key]} { set type localized } elseif { [lang::message::message_exists_p "en_US" $key] } { set type us_only } else { # message key is missing set url [export_vars -base $::xo::acs_lang_url/localized-message-new { {locale en_US } package_key message_key {return_url [ad_return_url]} }] set type missing } if {!$inline} { $obj lappend __localizer [::xo::Localizer new -type $type -key $key -url $url] } else { set l [::xo::Localizer new -type $type -key $key -url $url] append return_text [$l asHTML] } } append return_text $text return $return_text } } proc render_localizer {} { set obj [uplevel self] if {[$obj exists __localizer]} { foreach l [$obj set __localizer] { $l render $l destroy } } } Class create Localizer -parameter {type key url} #Localizer instproc render {} { # html::a -title [:key] -href [:url] { # switch -- [:type] { # localized {set char o; set style "color: green"} # us_only {set char *; set style "background-color: yellow; color: red;"} # missing {set char @; set style "background-color: red; color: white;"} # } # html::span -style $style {html::t $char} # } #} #Localizer instproc render {} { # html::a -title [:key] -href [:url] { # set path /resources/acs-templating/xinha-nightly/plugins/ # switch -- [:type] { # localized {set img ImageManager/img/btn_ok.gif} # us_only {set img Filter/img/ed_filter.gif} # missing {set img LangMarks/img/en.gif} # } # html::img -alt [:type] -src $path/$img -width 16 -height 16 -border 0 # } #} Localizer instproc render {} { switch -- ${:type} { localized {set img ImageManager/img/btn_ok.gif} us_only {set img Filter/img/ed_filter.gif} missing {set img LangMarks/img/en.gif} } html::a -class "acs-lang-${:type}" -title ${:key} -href ${:url} {} } ## todo : make these checks only in trn mode (additional mixin) Class create Drawable \ -superclass ::xo::tdom::AttributeManager \ -instproc _ {attr} { set :$attr } \ -instproc render_localizer {} { } Class create TRN-Mode \ -instproc _ {attr} { return [::xo::localize [set :$attr]] } \ -instproc render_localizer {} { #:log "-- " if {[info exists :__localizer]} { foreach l ${:__localizer} { $l render $l destroy } } set :__localizer [list] } \ -instproc render-data args { next :render_localizer } \ -instproc render args { next :render_localizer } # # for the time being, just a proc # proc get_user_name {uid} { set name [expr {[string is integer -strict $uid] ? [person::name -person_id $uid] : ""}] if {$name eq ""} { set name [_ xotcl-core.nobody] } return $name } } namespace eval ::xo { # # Define an abstract ::xo::Table # Class create ::xo::Table -superclass OrderedComposite \ -parameter { {no_data "#xotcl-core.No_Data#"} {renderer TABLE3} name } Table instproc destroy {} { #:log "-- " foreach c {__bulkactions __actions __columns} { #:log "-- namespace eval [self]::$c {namespace forget *}" namespace eval [self]::$c {namespace forget *} } next } Table instproc actions {cmd} { set M [OrderedComposite create [self]::__actions] namespace eval $M [list namespace import -force [self class]::*] $M contains $cmd } Table instproc __bulkactions {cmd} { set M [OrderedComposite create [self]::__bulkactions] namespace eval $M [list namespace import -force [self class]::*] $M contains $cmd } Table instproc columns {cmd} { set M [OrderedComposite create [self]::__columns] namespace eval $M [list namespace import -force [self class]::*] $M contains $cmd set slots [list] foreach c [$M children] { lappend slots {*}[$c get-slots] } :proc add $slots { set __self [::xo::Table::Line new] foreach __v [info vars] {$__self set $__v [set $__v]} next $__self } } Table ad_instproc column_names {} { Return a list of names of the columns of the current table. These names are used to refer to the columns, e.g. in sorting or when values are set. @return list of names } { set names {} foreach c [[[self]::__columns] children] { lappend names [$c name] } return $names } Table instproc render_with {renderer trn_mixin} { #:log "-- renderer=$renderer" set cl [self class] :mixin ${cl}::$renderer foreach child [$cl info classchildren] { #:log "-- $child class [$child info class] " set mixinname ${cl}::${renderer}::[namespace tail $child] if {[::xotcl::Object isclass $mixinname]} { #if {![$child istype ::xo::OrderedComposite::Child]} continue $child instmixin $mixinname if {$trn_mixin ne ""} {$child instmixin add $trn_mixin} #:log "-- $child using instmixin <[$child info instmixin]>" } else { #:log "-- no mixin $mixinname" } } Table::Line instmixin $trn_mixin :init_renderer } Table instproc format_csv { {-delimiter ","} } { set output "" set line [list] set displayColumns [lmap column [[self]::__columns children] { if {[$column exists no_csv]} continue if {[$column istype ::xo::Table::BulkAction]} continue if {[$column istype ::xo::Table::HiddenField]} continue set column }] foreach column $displayColumns { set label [$column label] if {[regexp {^#([a-zA-Z0-9_:-]+\.[a-zA-Z0-9_:-]+)#$} $label _ message_key]} { set label [_ $message_key] } set value [string map {\" \\\" \n \r} $label] lappend line \"$value\" } append output [join $line $delimiter] \n foreach row [:children] { set line [list] foreach column $displayColumns { set value [string map {\" \\\" \n \r} [$row set [$column set name]]] lappend line \"$value\" } append output [join $line $delimiter] \n } return $output } Table instproc write_csv { {-delimiter ","} } { if {![info exists :name]} { set :name "table" } set fn [xo::backslash_escape \" ${:name}.csv] ns_set put [ns_conn outputheaders] Content-Disposition "attachment;filename=\"$fn\"" ns_return 200 "text/csv; charset=utf-8" [:format_csv -delimiter $delimiter] ad_script_abort } } namespace eval ::xo::Table { # # Define elements of a ::xo::Table # Class create ::xo::Table::Line \ -superclass ::xo::Drawable \ -instproc attlist {name atts {extra ""}} { set result [list] foreach att $atts { set varname $name.$att if {[info exists :$varname]} { lappend result $att [::xo::localize [set :$varname]] } } foreach {att val} $extra {lappend result $att $val} return $result } Class create ::xo::Table::Action \ -superclass ::xo::OrderedComposite::Child \ -parameter {{CSSclass ""} label url {tooltip {}} {confirm_message {}}} #-proc destroy {} { # :log "-- DESTROY " # show_stack # next # } Class create ::xo::Table::Field \ -superclass ::xo::OrderedComposite::Child \ -parameter { label {html {}} {orderby ""} name {richtext false} no_csv {CSSclass ""} {hide 0} } \ -instproc init {} { set :name [namespace tail [self]] } \ -instproc get-slots {} { set slots [list -${:name}] foreach subfield {richtext CSSclass} { lappend slots [list -${:name}.$subfield ""] } return $slots } Class create ::xo::Table::BulkAction \ -superclass ::xo::OrderedComposite::Child \ -parameter {{CSSclass ""} name id {html {}} {hide 0}} \ -instproc actions {cmd} { #:init set grandParent [[:info parent] info parent] if {![info exists :name]} {set :name [namespace tail [self]]} #set M [::xo::OrderedComposite create ${grandParent}::__bulkactions] set M [::xo::OrderedComposite create ${grandParent}::__bulkactions -noinit] namespace eval $M {namespace import -force ::xo::Table::*} $M contains $cmd $M set __belongs_to [self] $M set __identifier ${:name} } \ -instproc get-slots {} { ; } Class create ::xo::Table::AnchorField \ -superclass ::xo::Table::Field \ -instproc get-slots {} { set slots [list -${:name}] foreach subfield {href title CSSclass} { lappend slots [list -${:name}.$subfield ""] } return $slots } Class create ::xo::Table::HiddenField \ -superclass ::xo::Table::Field \ -instproc get-slots {} { return [list -${:name}] } Class create ::xo::Table::ImageField \ -parameter {src width height border title alt} \ -superclass ::xo::Table::Field \ -instproc get-slots {} { set slots [list -${:name}] lappend slots [list -${:name}.src ${:src}] lappend slots [list -${:name}.CSSclass ${:CSSclass}] foreach att {width height border title alt} { if {[info exists :$att]} { lappend slots [list -${:name}.$att [:$att]] } else { lappend slots [list -${:name}.$att] } } return $slots } Class create ::xo::Table::ImageAnchorField \ -superclass ::xo::Table::ImageField \ -instproc get-slots {} { return [concat [next] -${:name}.href ""] } Class create ::xo::Table::ImageField_EditIcon \ -superclass ImageAnchorField -parameter { {src /resources/acs-subsite/Edit16.gif} {width 16} {height 16} {border 0} {title "[_ xotcl-core.edit_item]"} {alt "edit"} } Class create ::xo::Table::ImageField_AddIcon \ -superclass ImageAnchorField -parameter { {src /resources/acs-subsite/Add16.gif} {width 16} {height 16} {border 0} {title "[_ xotcl-core.add_item]"} {alt "add"} } Class create ::xo::Table::ImageField_ViewIcon \ -superclass ImageAnchorField -parameter { {src /resources/acs-subsite/Zoom16.gif} {width 16} {height 16} {border 0} {title "[_ xotcl-core.view_item]"} {alt "view"} } Class create ::xo::Table::ImageField_DeleteIcon \ -superclass ImageAnchorField -parameter { {src /resources/acs-subsite/Delete16.gif} {width 16} {height 16} {border 0} {title "[_ xotcl-core.delete_item]"} {alt "delete"} } } namespace eval ::xo::Table { # # Export ::xo::Table elements # namespace export Field AnchorField HiddenField Action ImageField ImageAnchorField \ ImageField_EditIcon ImageField_ViewIcon ImageField_DeleteIcon ImageField_AddIcon \ BulkAction } namespace eval ::xo::Table { # # Class for rendering ::xo::Table as the html TABLE # Class create TABLE \ -superclass ::xo::Drawable \ -instproc init_renderer {} { #:log "--" set :__rowcount 0 set :css.table-class list set :css.tr.even-class list-even set :css.tr.odd-class list-odd } TABLE instproc render-actions {} { html::tr -class list-button-bar { set cols [llength [[self]::__columns children]] html::td -colspan $cols -class list-button-bar { set children [[self]::__actions children] set last [lindex $children end] foreach o $children { $o render if {$o ne $last} { html::t -disableOutputEscaping "·" } } } } } TABLE instproc render-bulkactions {} { set bulkactions [[self]::__bulkactions children] html::div -class "list-button-bar-bottom" { html::t "#xotcl-core.Bulk_actions#:" set bulkaction_container [[lindex $bulkactions 0] set __parent] set name [$bulkaction_container set __identifier] html::ul -class compact { foreach ba $bulkactions { set id [::xowiki::Includelet html_id $ba] html::li { html::a -title [$ba tooltip] -id $id -class button -href # \ { html::t [$ba label] } } set script [subst { acs_ListBulkActionClick("$name","[$ba url]"); }] if {[$ba confirm_message] ne ""} { set script [subst { if (confirm('[$ba confirm_message]')) { $script } }] } template::add_event_listener \ -id $id \ -preventdefault=false \ -script $script } } } } TABLE instproc render-body {} { html::thead { html::tr -class list-header { foreach o [[self]::__columns children] { $o render } } } set children [:children] if {[llength $children] == 0} { html::tr {html::td { html::t ${:no_data}}} } else { html::tbody { foreach line [:children] { #:log "--LINE vars=[:info vars] cL: [[self class] info vars] r=[:renderer]" html::tr -class [expr {[incr :__rowcount]%2 ? ${:css.tr.odd-class} : ${:css.tr.even-class}}] { foreach field [[self]::__columns children] { if {[$field istype HiddenField]} continue if {![$field exists CSSclass]} { # TODO: remove me when message does not show up ns_log warning "CSSclass missing $field\n[$field serialize]" $field set CSSclass "" } set CSSclass [list "list" {*}[$field CSSclass]] html::td [concat [list class $CSSclass] [$field html]] { $field render-data $line } } } } } } } TABLE instproc render {} { if {![nsf::is object [self]::__actions]} {:actions {}} if {![nsf::is object [self]::__bulkactions]} {:bulkactions {}} set bulkactions [[self]::__bulkactions children] if {[llength $bulkactions] == 0} { html::table -class ${:css.table-class} { :render-actions :render-body } } else { set name [[self]::__bulkactions set __identifier] html::form -name $name -method POST { html::table -class ${:css.table-class} { :render-actions :render-body } :render-bulkactions } } } # # Define renderer for elements of a Table # # ::xo:Table requires the elements to have the methods render and render-data # Class create TABLE::Action \ -superclass ::xo::Drawable \ -instproc render {} { html::a -class "button ${:CSSclass}" -title [:_ tooltip] -href ${:url} { html::t [:_ label] } #:log "-- " } #-proc destroy {} { # :log "-- DESTROY" # show_stack # next #} Class create TABLE::Field -superclass ::xo::Drawable TABLE::Field instproc render-data {line} { $line instvar [list ${:name}.richtext richtext] if {![info exists richtext] || $richtext eq ""} { set richtext [:richtext] } if {$richtext} { html::t -disableOutputEscaping [$line set ${:name}] } else { html::t [$line set ${:name}] } } TABLE::Field instproc render {} { set CSSclass [list "list" {*}${:CSSclass}] #ns_log notice "FIELD: ${:name}: orderby '${:orderby}' '[:get_orderby]'" html::th [concat [list class $CSSclass] ${:html}] { if {${:orderby} eq ""} { html::t [:_ label] } else { :renderSortLabels } :render_localizer ;# run this before th is closed } } TABLE::Field instproc get_orderby {} { # # First, try to get the sort-order from the including ordered # composite, which is supposed to be always the data source. # Only, when this fails, fall back to the old style based on the # adp-level, which is less robust and warn about this usage. # set ordered_composite [${:__parent} info parent] if {[::nsf::is object $ordered_composite] && [$ordered_composite hasclass ::xo::OrderedComposite]} { if {![$ordered_composite exists __orderby] || ![$ordered_composite exists __order]} { # # Tables must always have a defined ordering to ensure stable # appearance and correct setup of sorting arrows. # ad_log warning "downstream application issue: invalid usage of ordered composite:" \ "definition of ordering is missing (call method 'orderby' on the ordered composite)." set orderby "" } else { set ordered_composite_orderby [$ordered_composite set __orderby] set ordered_composite_order [$ordered_composite set __order] if {$ordered_composite_order eq "increasing"} { set orderby $ordered_composite_orderby,asc } else { set orderby $ordered_composite_orderby,desc } } } else { ad_log warning "renderSortLabels is still relying on addressing variables on the template::adp_level" set lvl [template::adp_level] if {$lvl ne ""} { upvar #$lvl $orderby_name orderby } if {![info exists orderby]} { set orderby "" } } return $orderby } TABLE::Field instproc renderSortLabels {} { set field ${:orderby} set orderby_name orderby set orderby [:get_orderby] set sort_up "sort-inactive" set sort_down "sort-inactive" if {$orderby eq "$field,desc"} { set new_orderby $field,asc set title [_ xotcl-core.Sort_by_this_column_ascending] #set img /resources/acs-templating/sort-ascending.png set sort_up "sort-active" } elseif {$orderby eq "$field,asc"} { set new_orderby $field,desc set title [_ xotcl-core.Sort_by_this_column_descending] #set img /resources/acs-templating/sort-descending.png set sort_down "sort-active" } else { set new_orderby $field,asc set title [_ xotcl-core.Sort_by_this_column] #set img /resources/acs-templating/sort-neither.png } set query [list [list $orderby_name $new_orderby]] if {[ns_conn isconnected]} { # # Called interactively # set base [ad_conn url] set query [ns_conn query] } else { # # Called in the background (e.g. from search renderer) # set base . set query "" } set href $base?[::xo::update_query $query $orderby_name $new_orderby] html::a -href $href -title $title { html::t [:_ label] html::span -class "sort-up $sort_up" {html::t "↑"} html::span -class "sort-down $sort_down" {html::t "↓"} #html::img -src $img -alt "" } } # TODO: title for anchors Class create TABLE::AnchorField \ -superclass TABLE::Field \ -instproc render-data {line} { if {[$line exists ${:name}.href] && [set href [$line set ${:name}.href]] ne "" } { # Default class is from the field definition. To it we # append the class coming from the line. set CSSclass ${:CSSclass} if {[$line exists ${:name}.CSSclass]} { set lineCSSclass [$line set ${:name}.CSSclass] if {$lineCSSclass ne ""} { append CSSclass " " $lineCSSclass } } $line instvar [list ${:name}.title title] html::a [:get_local_attributes href title {CSSclass class}] { return [next] } } next } Class create TABLE::HiddenField \ -instproc render {} {;} \ -instproc render-data {line} {;} Class create TABLE::ImageField \ -superclass TABLE::Field \ -instproc render-data {line} { $line instvar [list ${:name}.CSSclass CSSclass] html::a [:get_local_attributes href {style "border-bottom: none;"} {CSSclass class}] { html::img [$line attlist ${:name} {src width height border title alt}] {} } $line render_localizer } Class create TABLE::ImageAnchorField \ -superclass TABLE::Field \ -instproc render-data {line} { if {[$line exists ${:name}.href] && [set href [$line set ${:name}.href]] ne "" } { #if {$line exists ${:name}.CSSclass} {set CSSclass [$line set ${:name}.CSSclass]} $line instvar [list ${:name}.CSSclass CSSclass] html::a [:get_local_attributes href {style "border-bottom: none;"} {CSSclass class}] { html::img [$line attlist ${:name} {src width height border title alt}] {} } $line render_localizer } } Class create TABLE::BulkAction -superclass ::xo::Drawable -parameter {{CSSclass ""}} TABLE::BulkAction instproc render {} { #:msg [:serialize] html::th -class list { html::input -type checkbox -name __bulkaction -id __bulkaction \ -title "Mark/Unmark all rows" ::html::CSRFToken } template::add_body_script -script [subst { document.getElementById('__bulkaction').addEventListener('click', function (event) { acs_ListCheckAll('${:name}', this.checked); }, false); }] } TABLE::BulkAction instproc render-data {line} { #:msg [:serialize] set name ${:name} set value [$line set [:id]] html::input -type checkbox -name $name -value $value \ -id "$name---[string map {/ _} $value]" \ -title "Mark/Unmark this row" } Class create TABLE2 \ -superclass TABLE \ -instproc render-actions {} { set actions [[self]::__actions children] if {[llength $actions] > 0} { html::div -class "actions" -style "float: left;" { html::ul -style "list-style:none; padding: 10px;" { foreach o $actions { html::li -class "button" {$o render} } } } } } \ -instproc render {} { if {![nsf::is object [self]::__actions]} {:actions {}} if {![nsf::is object [self]::__bulkactions]} {:__bulkactions {}} set bulkactions [[self]::__bulkactions children] html::div { :render-actions if {![[self]::__bulkactions exists __identifier]} { html::div -class table { html::table -class ${:css.table-class} {:render-body} } } else { set name [[self]::__bulkactions set __identifier] html::form -name $name -action "" { html::div -class table { html::table -class ${:css.table-class} {:render-body} :render-bulkactions } } } } } Class create TABLE2::Action -superclass TABLE::Action Class create TABLE2::Field -superclass TABLE::Field Class create TABLE2::AnchorField -superclass TABLE::AnchorField Class create TABLE2::HiddenField -superclass TABLE::HiddenField Class create TABLE2::ImageField -superclass TABLE::ImageField Class create TABLE2::ImageAnchorField -superclass TABLE::ImageAnchorField Class create TABLE2::BulkAction -superclass TABLE::BulkAction Class create TABLE3 \ -superclass TABLE2 \ -instproc init_renderer {} { next set :css.table-class list-table set :css.tr.even-class even set :css.tr.odd-class odd } Class create TABLE3::Action -superclass TABLE::Action Class create TABLE3::Field -superclass TABLE::Field Class create TABLE3::AnchorField -superclass TABLE::AnchorField Class create TABLE3::HiddenField -superclass TABLE::HiddenField Class create TABLE3::ImageField -superclass TABLE::ImageField Class create TABLE3::ImageAnchorField -superclass TABLE::ImageAnchorField Class create TABLE3::BulkAction -superclass TABLE::BulkAction } Class create TableWidget \ -superclass ::xo::Table \ -instproc init {} { set trn_mixin [expr {[lang::util::translator_mode_p] ?"::xo::TRN-Mode" : ""}] :render_with [:renderer] $trn_mixin next } # # Pure List widget # Class create ListWidget -superclass ::xo::OrderedComposite -instproc render {} { html::ul -class plainlist { foreach o [:children] { html::li { $o render } } } } # # Define two Master templates, an empty one and one page master # Object create defaultMaster -proc decorate {node} { $node appendFromScript { set slave [tmpl::div] } return $slave } Object create pageMaster -proc decorate {node} { $node appendFromScript { html::div -class defaultMasterClass { #html::t "hello header" set slave [tmpl::body] #html::t "hello footer" } } return $slave } namespace eval ::xo { # # xo::Page: Templating and CSS # Class create Page Page proc requireCSS {{-order 1} name} { set ::_xo_need_css($name) [expr {[array size ::_xo_need_css] + 1000 * $order}] } Page proc requireStyle {{-order 1} s} { set ::_xo_need_style($s) [expr {[array size ::_xo_need_style] + 1000 * $order}] } Page proc requireJS name { if {![info exists ::_xo_need_js($name)]} {lappend ::_xo_js_order $name} set ::_xo_need_js($name) 1 } Page proc requireLink {-rel -type -title -href} { template::head::add_link -rel $rel -href $href -type $type -title $title } Page proc set_property {name element value} { set ::xo_property_${name}($element) $value } Page proc get_property {name} { if {[array exists ::xo_property_${name}]} { return [array get ::xo_property_${name}] } return [list] } Page proc sort_keys_by_value {{-comparison integer} {-direction increasing} pairs} { set result [list] set a [list] foreach {key value} $pairs { lappend a [list $key $value] } foreach pair [lsort -index 1 -$comparison -$direction $a] { lappend result [lindex $pair 0] } return $result } Page proc header_stuff {} { foreach style [:sort_keys_by_value [array get ::_xo_need_style]] { template::head::add_style -style $style } set count 10 foreach file [:sort_keys_by_value [array get ::_xo_need_css]] { template::head::add_css -href $file -media all -order [incr count] } if {[info exists ::_xo_js_order]} { set statements "" set order 10 foreach file $::_xo_js_order { if {[string match "*;*" $file]} { # it is not a file, but some JavaScript statements #append statements [string map {< "<" > ">"} $file] \n append statements $file \n } else { template::head::add_script -src $file -type text/javascript -order [incr order] } } if {$statements ne ""} { template::head::add_script -script $statements -type text/javascript -order [incr order] } } return "" } } ::xo::library source_dependent # # Local variables: # mode: tcl # tcl-indent-level: 2 # indent-tabs-mode: nil # End:
