Index: openacs-4/packages/xotcl-core/tcl/30-widget-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/30-widget-procs.tcl,v diff -u -N -r1.54 -r1.55 --- openacs-4/packages/xotcl-core/tcl/30-widget-procs.tcl 12 Aug 2013 20:01:06 -0000 1.54 +++ openacs-4/packages/xotcl-core/tcl/30-widget-procs.tcl 27 Oct 2014 16:42:01 -0000 1.55 @@ -72,7 +72,7 @@ # Create a new instance of the current class and configure it. # #my log "tdom START $level [self], cmd='$configurecmds'" - set me [eval my new -destroy_on_cleanup $configurecmds] + set me [my new -destroy_on_cleanup {*}$configurecmds] #my log "tdom CREATED $level $me ([$me info class])" # @@ -89,15 +89,15 @@ # # search for autoimports: all commands are executed in the ... currently not needed # -# set class [$me info class] -# foreach cl [concat $class [$class info heritage]] { -# my log "tdom EVAL $level ns=[namespace current] autoimport in $cl?[$cl exists autoimport]" -# if {[$cl exists autoimport]} { -# my log "tdom IMPO [$cl autoimport] into $me" -# namespace eval ::xo::tmp [list namespace import -force [$cl autoimport]] -# } -# } -# #my log "tdom CMDS $level [lsort [info commands ::xo::tmp::*]]" + # set class [$me info class] + # foreach cl [concat $class [$class info heritage]] { + # my log "tdom EVAL $level ns=[namespace current] autoimport in $cl?[$cl exists autoimport]" + # if {[$cl exists autoimport]} { + # my log "tdom IMPO [$cl autoimport] into $me" + # namespace eval ::xo::tmp [list namespace import -force [$cl autoimport]] + # } + # } + # #my log "tdom CMDS $level [lsort [info commands ::xo::tmp::*]]" if {$createcmd ne ""} { # @@ -142,7 +142,7 @@ foreach attribute $args { set l [split $attribute] if {[llength $l] > 1} { - foreach {attribute HTMLattribute} $l break + lassign $l attribute HTMLattribute } else { set HTMLattribute $attribute } @@ -166,7 +166,7 @@ foreach attribute $args { set l [split $attribute] if {[llength $l] > 1} { - foreach {attribute HTMLattribute} $l break + lassign $l attribute HTMLattribute } else { set HTMLattribute $attribute } @@ -231,24 +231,24 @@ while {[regexp {^([^\x002]*)\x002\(\x001([^\x001]*)\x001\)\x002(.*)$} $text _ \ before key text]} { - append return_text $before - foreach {package_key message_key} [split $key .] break - 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 - } + 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 { @@ -265,8 +265,8 @@ set obj [uplevel self] if {[$obj exists __localizer]} { foreach l [$obj set __localizer] { - $l render - $l destroy + $l render + $l destroy } } } @@ -276,56 +276,56 @@ Localizer instproc render {} { html::a -title [my key] -href [my url] { switch -- [my type] { - localized {set char o; set style "color: green"} + 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 [my key] -href [my url] { - set path /resources/acs-templating/xinha-nightly/plugins/ - switch -- [my 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 [my type] -src $path/$img -width 16 -height 16 -border 0 - } - } + html::a -title [my key] -href [my url] { + set path /resources/acs-templating/xinha-nightly/plugins/ + switch -- [my 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 [my type] -src $path/$img -width 16 -height 16 -border 0 + } + } ## todo : make these checks only in trn mode (additional mixin) Class Drawable \ -superclass ::xo::tdom::AttributeManager \ -instproc _ {attr} { - my set $attr + my set $attr } \ -instproc render_localizer {} { } Class TRN-Mode \ -instproc _ {attr} { - return [::xo::localize [my set $attr]] + return [::xo::localize [my set $attr]] } \ -instproc render_localizer {} { - #my log "-- " - if {[my exists __localizer]} { - foreach l [my set __localizer] { - $l render - $l destroy - } - } - my set __localizer [list] + #my log "-- " + if {[my exists __localizer]} { + foreach l [my set __localizer] { + $l render + $l destroy + } + } + my set __localizer [list] } \ -instproc render-data args { - next - my render_localizer + next + my render_localizer } \ -instproc render args { - next - my render_localizer + next + my render_localizer } # @@ -349,9 +349,9 @@ # Class Table -superclass OrderedComposite \ -parameter [expr {[apm_version_names_compare [ad_acs_version] 5.3.0] == 1 ? - {{no_data "#xotcl-core.No_Data#"} {renderer TABLE3} name} : - {{no_data "#xotcl-core.No_Data#"} {renderer TABLE2} name} - }] + {{no_data "#xotcl-core.No_Data#"} {renderer TABLE3} name} : + {{no_data "#xotcl-core.No_Data#"} {renderer TABLE2} name} + }] Table instproc destroy {} { #my log "-- " @@ -395,11 +395,11 @@ 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} - #my log "-- $child using instmixin <[$child info instmixin]>" + $child instmixin $mixinname + if {$trn_mixin ne ""} {$child instmixin add $trn_mixin} + #my log "-- $child using instmixin <[$child info instmixin]>" } else { - #my log "-- no mixin $mixinname" + #my log "-- no mixin $mixinname" } } Table::Line instmixin $trn_mixin @@ -416,166 +416,166 @@ set label [_ $message_key] } set value [string map {\" \\\" \n \r)} $label] + lappend line \"$value\" + } + append output [join $line ,] \n + foreach row [my children] { + set line [list] + foreach column [[self]::__columns children] { + if {[$column exists no_csv]} continue + set value [string map {\" \\\" \n \r} [$row set [$column set name]]] lappend line \"$value\" } append output [join $line ,] \n - foreach row [my children] { - set line [list] - foreach column [[self]::__columns children] { - if {[$column exists no_csv]} continue - set value [string map {\" \\\" \n \r} [$row set [$column set name]]] - lappend line \"$value\" - } - append output [join $line ,] \n - } - #ns_return 200 text/plain $output - my instvar name - if {![my 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 $output } + #ns_return 200 text/plain $output + my instvar name + if {![my 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 $output +} - Class create Table::Line \ - -superclass ::xo::Drawable \ - -instproc attlist {name atts {extra ""}} { - set result [list] - foreach att $atts { - set varname $name.$att - if {[my exists $varname]} { - lappend result $att [::xo::localize [my set $varname]] - } - } - foreach {att val} $extra {lappend result $att $val} - return $result +Class create Table::Line \ + -superclass ::xo::Drawable \ + -instproc attlist {name atts {extra ""}} { + set result [list] + foreach att $atts { + set varname $name.$att + if {[my exists $varname]} { + lappend result $att [::xo::localize [my set $varname]] + } } - + foreach {att val} $extra {lappend result $att $val} + return $result + } - # - # Define elements of a Table - # - namespace eval ::xo::Table { - Class Action \ - -superclass ::xo::OrderedComposite::Child \ - -parameter {label url {tooltip {}}} - #-proc destroy {} { - # my log "-- DESTROY " - # show_stack - # next - # } - Class Field \ - -superclass ::xo::OrderedComposite::Child \ - -parameter {label {html {}} {orderby ""} name {richtext false} no_csv {CSSclass ""} {hide 0}} \ - -instproc init {} { - my set name [namespace tail [self]] - } \ - -instproc get-slots {} { - set slots [list -[my name]] - foreach subfield {richtext CSSclass} { - lappend slots [list -[my name].$subfield ""] - } - return $slots - } +# +# Define elements of a Table +# +namespace eval ::xo::Table { + Class Action \ + -superclass ::xo::OrderedComposite::Child \ + -parameter {label url {tooltip {}}} + #-proc destroy {} { + # my log "-- DESTROY " + # show_stack + # next + # } - Class BulkAction \ - -superclass ::xo::OrderedComposite::Child \ - -parameter {name id {html {}} {hide 0}} \ - -instproc actions {cmd} { - #my init - set grandParent [[my info parent] info parent] - if {![my exists name]} {my 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 [my set name] - } \ - -instproc get-slots {} { - ; + Class Field \ + -superclass ::xo::OrderedComposite::Child \ + -parameter {label {html {}} {orderby ""} name {richtext false} no_csv {CSSclass ""} {hide 0}} \ + -instproc init {} { + my set name [namespace tail [self]] + } \ + -instproc get-slots {} { + set slots [list -[my name]] + foreach subfield {richtext CSSclass} { + lappend slots [list -[my name].$subfield ""] } + return $slots + } - Class AnchorField \ - -superclass ::xo::Table::Field \ - -instproc get-slots {} { - set slots [list -[my name]] - foreach subfield {href title CSSclass} { - lappend slots [list -[my name].$subfield ""] - } - return $slots - } + Class BulkAction \ + -superclass ::xo::OrderedComposite::Child \ + -parameter {name id {html {}} {hide 0}} \ + -instproc actions {cmd} { + #my init + set grandParent [[my info parent] info parent] + if {![my exists name]} {my 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 [my set name] + } \ + -instproc get-slots {} { + ; + } - Class HiddenField \ - -superclass ::xo::Table::Field \ - -instproc get-slots {} { - return [list -[my name]] - } + Class AnchorField \ + -superclass ::xo::Table::Field \ + -instproc get-slots {} { + set slots [list -[my name]] + foreach subfield {href title CSSclass} { + lappend slots [list -[my name].$subfield ""] + } + return $slots + } - Class ImageField \ - -parameter {src width height border title alt} \ - -superclass ::xo::Table::Field \ - -instproc get-slots {} { - set slots [list -[my name]] - lappend slots [list -[my name].src [my src]] - lappend slots [list -[my name].CSSclass [my CSSclass]] - foreach att {width height border title alt} { - if {[my exists $att]} { - lappend slots [list -[my name].$att [my $att]] - } else { - lappend slots [list -[my name].$att] - } - } - return $slots - } + Class HiddenField \ + -superclass ::xo::Table::Field \ + -instproc get-slots {} { + return [list -[my name]] + } - Class ImageAnchorField \ - -superclass ::xo::Table::ImageField \ - -instproc get-slots {} { - return [concat [next] -[my name].href ""] - } + Class ImageField \ + -parameter {src width height border title alt} \ + -superclass ::xo::Table::Field \ + -instproc get-slots {} { + set slots [list -[my name]] + lappend slots [list -[my name].src [my src]] + lappend slots [list -[my name].CSSclass [my CSSclass]] + foreach att {width height border title alt} { + if {[my exists $att]} { + lappend slots [list -[my name].$att [my $att]] + } else { + lappend slots [list -[my name].$att] + } + } + return $slots + } - Class 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 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 ImageAnchorField \ + -superclass ::xo::Table::ImageField \ + -instproc get-slots {} { + return [concat [next] -[my name].href ""] + } - Class 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 ImageField_DeleteIcon \ - -superclass ImageAnchorField -parameter { - {src /resources/acs-subsite/Delete16.gif} {width 16} {height 16} {border 0} - {title "[_ xotcl-core.delete_item]"} {alt "delete"} - } - - # export table elements - namespace export Field AnchorField HiddenField Action ImageField ImageAnchorField \ - ImageField_EditIcon ImageField_ViewIcon ImageField_DeleteIcon ImageField_AddIcon \ - BulkAction - } + Class 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 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 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 ImageField_DeleteIcon \ + -superclass ImageAnchorField -parameter { + {src /resources/acs-subsite/Delete16.gif} {width 16} {height 16} {border 0} + {title "[_ xotcl-core.delete_item]"} {alt "delete"} + } + + # export 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 TABLE \ -superclass ::xo::Drawable \ -instproc init_renderer {} { - #my log "--" - my set __rowcount 0 + #my log "--" + my set __rowcount 0 my set css.table-class list my set css.tr.even-class list-even my set css.tr.odd-class list-odd @@ -585,14 +585,14 @@ 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 "·" - } - } + set children [[self]::__actions children] + set last [lindex $children end] + foreach o $children { + $o render + if {$o ne $last} { + html::t -disableOutputEscaping "·" + } + } } } } @@ -621,7 +621,7 @@ TABLE instproc render-body {} { html::tr -class list-header { foreach o [[self]::__columns children] { - $o render + $o render } } set children [my children] @@ -630,15 +630,15 @@ } else { foreach line [my children] { #my log "--LINE vars=[my info vars] cL: [[self class] info vars] r=[my renderer]" - html::tr -class [expr {[my incr __rowcount]%2 ? + html::tr -class [expr {[my incr __rowcount]%2 ? [my set css.tr.odd-class] : [my set css.tr.even-class] }] { - foreach field [[self]::__columns children] { - html::td [concat [list class list] [$field html]] { - $field render-data $line - } - } - } + foreach field [[self]::__columns children] { + html::td [concat [list class list] [$field html]] { + $field render-data $line + } + } + } } } } @@ -673,10 +673,10 @@ Class create TABLE::Action \ -superclass ::xo::Drawable \ -instproc render {} { - html::a -class button -title [my _ tooltip] -href [my url] { - html::t [my _ label] - } - #my log "-- " + html::a -class button -title [my _ tooltip] -href [my url] { + html::t [my _ label] + } + #my log "-- " } #-proc destroy {} { # my log "-- DESTROY" @@ -700,9 +700,9 @@ TABLE::Field instproc render {} { html::th [concat [list class list] [my html]] { if {[my set orderby] eq ""} { - html::t [my _ label] + html::t [my _ label] } else { - my renderSortLabels + my renderSortLabels } my render_localizer ;# run this before th is closed } @@ -734,7 +734,7 @@ set actual_query "" } foreach pair [split $actual_query &] { - foreach {key value} [split $pair =] break + lassign [split $pair =] key value if {$key eq "orderby"} continue lappend query [list [ns_urldecode $key] [ns_urldecode $value]] } @@ -749,23 +749,23 @@ Class create TABLE::AnchorField \ -superclass TABLE::Field \ -instproc render-data {line} { - if {[$line exists [my name].href] && - [set href [$line set [my name].href]] ne ""} { + if {[$line exists [my name].href] && + [set href [$line set [my name].href]] ne ""} { # use the CSS class rather from the Field than not the line my instvar CSSclass $line instvar [list [my name].title title] html::a [my get_local_attributes href title {CSSclass class}] { - return [next] - } - } - next + return [next] + } + } + next } Class create TABLE::HiddenField \ -instproc render {} {;} \ -instproc render-data {line} {;} - - + + Class create TABLE::ImageField \ -superclass TABLE::Field \ -instproc render-data {line} { @@ -819,14 +819,14 @@ foreach o $actions { html::li -class "button" {$o render} } } } - } + } } \ -instproc render {} { - if {![my isobject [self]::__actions]} {my actions {}} - if {![my isobject [self]::__bulkactions]} {my __bulkactions {}} + if {![my isobject [self]::__actions]} {my actions {}} + if {![my isobject [self]::__bulkactions]} {my __bulkactions {}} set bulkactions [[self]::__bulkactions children] - html::div { - my render-actions + html::div { + my render-actions if {$bulkactions eq ""} { html::div -class table { html::table -class [my set css.table-class] {my render-body} @@ -840,7 +840,7 @@ } } } - } + } } @@ -900,9 +900,9 @@ # Object defaultMaster -proc decorate {node} { - $node appendFromScript { - set slave [tmpl::div] - } + $node appendFromScript { + set slave [tmpl::div] + } return $slave } @@ -922,6 +922,8 @@ # # templating and CSS # + set use_template_head 1 + Class create Page Page proc requireCSS {{-order 1} name} { set ::_xo_need_css($name) [expr {[array size ::_xo_need_css]+1000*$order}] @@ -936,8 +938,12 @@ Page proc requireLink {-rel -type -title -href} { regsub -all ' $title "'" title regsub -all ' $href "'" href - set key "rel='$rel' type='$type' title='$title' href='$href'" - set ::_xo_need_link($key) 1 + if {$::xo::use_template_head} { + template::head::add_link -rel $rel -href $href -type $type -title $title + } else { + set key "rel='$rel' type='$type' title='$title' href='$href'" + set ::_xo_need_link($key) 1 + } } Page proc set_property {name element value} { set ::xo_property_${name}($element) $value @@ -959,32 +965,67 @@ } return $result } + Page proc header_stuff {} { set result "" - foreach link [array names ::_xo_need_link] { - append result "\n" - } - foreach style [my sort_keys_by_value [array get ::_xo_need_style]] { - append result "\n" - } - foreach file [my sort_keys_by_value [array get ::_xo_need_css]] { - append result "\n" - } - if {[info exists ::_xo_js_order]} { - set statements "" - foreach file $::_xo_js_order { - if {[string match "*;*" $file]} { - # it is not a file, but some javascipt statements - append statements $file \n - } else { - append result "\n" + if {$::xo::use_template_head} { + foreach style [my sort_keys_by_value [array get ::_xo_need_style]] { + template::head::add_style -style $style + } + set count 10 + foreach file [my 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 javascipt statements + 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] + } } - if {$statements ne ""} { - append result \n "\n" + + + } else { + foreach link [array names ::_xo_need_link] { + append result "\n" } + foreach style [my sort_keys_by_value [array get ::_xo_need_style]] { + append result "\n" + } + foreach file [my sort_keys_by_value [array get ::_xo_need_css]] { + append result "\n" + } + if {[info exists ::_xo_js_order]} { + set statements "" + foreach file $::_xo_js_order { + if {[string match "*;*" $file]} { + # it is not a file, but some javascipt statements + append statements $file \n + } else { + append result "\n" + } + } + if {$statements ne ""} { + append result \n "\n" + } + } } return $result } } -::xo::library source_dependent \ No newline at end of file +::xo::library source_dependent + +# +# Local variables: +# mode: tcl +# tcl-indent-level: 2 +# indent-tabs-mode: nil +# End: