Index: openacs-4/packages/xotcl-core/xotcl-core.info =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/xotcl-core.info,v diff -u -r1.5 -r1.6 --- openacs-4/packages/xotcl-core/xotcl-core.info 31 Dec 2005 16:36:07 -0000 1.5 +++ openacs-4/packages/xotcl-core/xotcl-core.info 19 Jan 2006 22:57:36 -0000 1.6 @@ -8,10 +8,10 @@ t xotcl - + Gustaf Neumann XOTcl library functionality (e.g. thread handling, online documentation, Generic Form and List Classes) - 2005-12-31 + 2006-01-19 This component contains some core functionality for OACS applications using XOTcl. It includes XOTcl thread handling for OACS (supporting persistent and @@ -25,7 +25,7 @@ when components are reloaded. 0.23 contains a major overhaul of the Generic classes. Object preliminary object layer for content repository, oo templating. 0 - + Index: openacs-4/packages/xotcl-core/catalog/xotcl-core.de_DE.ISO-8859-1.xml =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/catalog/xotcl-core.de_DE.ISO-8859-1.xml,v diff -u -r1.1 -r1.2 --- openacs-4/packages/xotcl-core/catalog/xotcl-core.de_DE.ISO-8859-1.xml 14 Dec 2005 15:57:52 -0000 1.1 +++ openacs-4/packages/xotcl-core/catalog/xotcl-core.de_DE.ISO-8859-1.xml 19 Jan 2006 22:57:37 -0000 1.2 @@ -1,6 +1,9 @@ - + + Neu: %type% + Neue Seite vom Type %type% erzeugen + Editieren Aktuelle Version Versionen des Eintrags Verlauf Fisheye: Tag 1.2 refers to a dead (removed) revision in file `openacs-4/packages/xotcl-core/catalog/xotcl-core.de_DE.ISO-8859-1.xml.orig'. Fisheye: No comparison available. Pass `N' to diff? Index: openacs-4/packages/xotcl-core/catalog/xotcl-core.en_US.ISO-8859-1.xml =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/catalog/xotcl-core.en_US.ISO-8859-1.xml,v diff -u -r1.1 -r1.2 --- openacs-4/packages/xotcl-core/catalog/xotcl-core.en_US.ISO-8859-1.xml 14 Dec 2005 15:57:52 -0000 1.1 +++ openacs-4/packages/xotcl-core/catalog/xotcl-core.en_US.ISO-8859-1.xml 19 Jan 2006 22:57:37 -0000 1.2 @@ -1,6 +1,9 @@ - + + Add %type% + Add new item of type %type% + Edit Item Live Revision Revisions of Entry Revisions Index: openacs-4/packages/xotcl-core/tcl/10-recreation-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/10-recreation-procs.tcl,v diff -u -r1.5 -r1.6 --- openacs-4/packages/xotcl-core/tcl/10-recreation-procs.tcl 30 Dec 2005 00:04:44 -0000 1.5 +++ openacs-4/packages/xotcl-core/tcl/10-recreation-procs.tcl 19 Jan 2006 22:57:37 -0000 1.6 @@ -100,74 +100,87 @@ } } -Class ad_proc recreate {obj args} { - The re-definition of recreate makes reloading of class definitions via - apm possible, since the foreign keys of the class relations - to these classes survive these calls. One can define specialized - versions of this for certain classes or use ::xotcl::RecreationClass. +set version [package require XOTcl] +if {[string match "1.3.*" $version]} { + Class ad_proc recreate {obj args} { + The re-definition of recreate makes reloading of class definitions via + apm possible, since the foreign keys of the class relations + to these classes survive these calls. One can define specialized + versions of this for certain classes or use ::xotcl::RecreationClass. - Class proc recreate is called on the class level, while - Class instproc recreate is called on the instance level. + Class proc recreate is called on the class level, while + Class instproc recreate is called on the instance level. - @param obj name of the object to be recreated - @param args arguments passed to recreate (might contain parameters) -} { - # clean on the class level - #my log "proc recreate $obj $args" - foreach p [$obj info instprocs] {$obj instproc $p {} {}} - $obj instmixin set {} - $obj instfilter set {} - next ; # clean next on object level -} -Class ad_instproc recreate {obj args} { - The re-definition of recreate makes reloading of class definitions via - apm possible, since the foreign keys of the class relations - to these classes survive these calls. One can define specialized - versions of this for certain classes or use ::xotcl::RecreationClass. + @param obj name of the object to be recreated + @param args arguments passed to recreate (might contain parameters) + } { + # clean on the class level + #my log "proc recreate $obj $args" + foreach p [$obj info instprocs] {$obj instproc $p {} {}} + $obj instmixin set {} + $obj instfilter set {} + next ; # clean next on object level + } + Class ad_instproc recreate {obj args} { + The re-definition of recreate makes reloading of class definitions via + apm possible, since the foreign keys of the class relations + to these classes survive these calls. One can define specialized + versions of this for certain classes or use ::xotcl::RecreationClass. - Class proc recreate is called on the class level, while - Class instproc recreate is called on the instance level. + Class proc recreate is called on the class level, while + Class instproc recreate is called on the instance level. - @param obj name of the object to be recreated - @param args arguments passed to recreate (might contain parameters) -} { - # clean on the object level - my log "+++ instproc recreate $obj <$args> old class = [$obj info class], new class = [self]" - $obj filter set {} - $obj mixin set {} - set cl [self] - foreach p [$obj info commands] {$obj proc $p {} {}} - foreach c [$obj info children] { - my log "recreate destroy <$c destroy" - $c destroy + @param obj name of the object to be recreated + @param args arguments passed to recreate (might contain parameters) + } { + # clean on the object level + my log "+++ instproc recreate $obj <$args> old class = [$obj info class], new class = [self]" + $obj filter set {} + $obj mixin set {} + set cl [self] + foreach p [$obj info commands] {$obj proc $p {} {}} + foreach c [$obj info children] { + my log "recreate destroy <$c destroy" + $c destroy + } + #my log "+++ $obj recreate unset vars" + #my log "+++ $obj vars = {[$obj info vars]}" + foreach var [$obj info vars] { + #my log "$obj unset $var" + $obj unset $var + } + #my log "+++ $obj recreate unset vars done" + # set p new values + $obj class $cl + set pcl [$cl info parameterclass] + #my log "+++ $obj recreate calling searchDefaults" + $pcl searchDefaults $obj + #my log "+++ $obj recreate calling $obj configure $args" + # we use uplevel to handle -volatile correctly + set pos [my uplevel $obj configure $args] + #my log "+++ recreate instproc configure returns $pos" + if {[lsearch -exact $args -init] == -1} { + incr pos -1 + #my log "+++ $obj init [lrange $args 0 $pos]" + eval $obj init [lrange $args 0 $pos] + } } - #my log "+++ $obj recreate unset vars" - #my log "+++ $obj vars = {[$obj info vars]}" - foreach var [$obj info vars] { - #my log "$obj unset $var" - $obj unset $var + + #::xotcl::Object instforward unset -objscope + # ::xotcl::Object instforward unset + ::Serializer exportMethods { + ::xotcl::Class instproc recreate + ::xotcl::Class proc recreate + ::xotcl::Object instforward unset } - #my log "+++ $obj recreate unset vars done" - # set p new values - $obj class $cl - set pcl [$cl info parameterclass] - #my log "+++ $obj recreate calling searchDefaults" - $pcl searchDefaults $obj - #my log "+++ $obj recreate calling $obj configure $args" - # we use uplevel to handle -volatile correctly - set pos [my uplevel $obj configure $args] - #my log "+++ recreate instproc configure returns $pos" - if {[lsearch -exact $args -init] == -1} { - incr pos -1 - #my log "+++ $obj init [lrange $args 0 $pos]" - eval $obj init [lrange $args 0 $pos] - } -} +} else { + ns_log notice "-- softrecreate" + ::xotcl::configure softrecreate true -#::xotcl::Object instforward unset -objscope -# ::xotcl::Object instforward unset -::Serializer exportMethods { - ::xotcl::Class instproc recreate - ::xotcl::Class proc recreate - ::xotcl::Object instforward unset + Class RR -instproc recreate args { + my log "-- [self args]"; next + } -instproc create args { + my log "-- [self args]"; next + } + #::xotcl::Class instmixin RR } \ No newline at end of file Index: openacs-4/packages/xotcl-core/tcl/20-Ordered-Composite-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/20-Ordered-Composite-procs.tcl,v diff -u -r1.4 -r1.5 --- openacs-4/packages/xotcl-core/tcl/20-Ordered-Composite-procs.tcl 30 Dec 2005 00:04:44 -0000 1.4 +++ openacs-4/packages/xotcl-core/tcl/20-Ordered-Composite-procs.tcl 19 Jan 2006 22:57:37 -0000 1.5 @@ -59,6 +59,8 @@ #my log "-- destroying children [my set __children]" foreach c [my set __children] { $c destroy } } + #show_stack;my log "-- children murdered, now next, chlds=[my info children]" + namespace eval [self] {namespace forget *} ;# for pre 1.4.0 versions next } 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 -r1.4 -r1.5 --- openacs-4/packages/xotcl-core/tcl/30-widget-procs.tcl 30 Dec 2005 00:04:44 -0000 1.4 +++ openacs-4/packages/xotcl-core/tcl/30-widget-procs.tcl 19 Jan 2006 22:57:37 -0000 1.5 @@ -25,19 +25,122 @@ } } + # -# Define Widget classes +# Define Widget classes with localization # -# ::xo::Table, somewhat similar to the classical multirow +# Most importantly, we define ::xo::Table, somewhat similar to the classical multirow namespace eval ::xo { + + # + # Localization + # + + set ::xo::acs_lang_url [apm_package_url_from_key acs-lang]admin + + proc localize text { + if {![my exists __localizer]} { + my set __localizer [list] + } + if {[string first \x002 $text] == -1} { + return $text + } else { + set return_text "" + 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 + } + my lappend __localizer [::xo::Localizer new -type $type -key $key -url $url] + } + append return_text $text + return $return_text + } + } + + Class Localizer -parameter {type key url} + + Localizer instproc render {} { + html::a -title [my key] -href [my url] { + switch [my 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 [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 \ + -instproc _ {attr} { + my set $attr + } \ + -instproc render_localizer {} { + } + + Class TRN-Mode \ + -instproc _ {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] + } \ + -instproc render-data args { + next + my render_localizer + } \ + -instproc render args { + next + my render_localizer + } + + # + # define an abstract table + # + Class Table -superclass OrderedComposite \ -parameter {{no_data "No Data"} {renderer TABLE2}} - + Table instproc destroy {} { - #my log "-- " + my log "-- " foreach c {__actions __columns} { - namespace eval [self]::$c {namespace forget [self class]::*} + #my log "-- namespace eval [self]::$c {namespace forget *}" + namespace eval [self]::$c {namespace forget *} } next } @@ -61,7 +164,7 @@ } } - Table instproc render_with {renderer} { + Table instproc render_with {renderer trn_mixin} { my log "--" set cl [self class] [self] mixin ${cl}::$renderer @@ -71,11 +174,13 @@ set mixinname ${cl}::${renderer}::[namespace tail $child] if {[::xotcl::Object isclass $mixinname]} { $child instmixin $mixinname - #my log "-- using mixin $mixinname" + if {$trn_mixin ne ""} {$child instmixin add $trn_mixin} + #my log "-- $child using instmixin <[$child info instmixin]>" } else { #my log "-- no mixin $mixinname" } } + Table::Line instmixin $trn_mixin my init_renderer } @@ -99,11 +204,14 @@ } 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 [my set $varname]} + if {[my exists $varname]} { + lappend result $att [::xo::localize [my set $varname]] + } } foreach {att val} $extra {lappend result $att $val} return $result @@ -116,7 +224,12 @@ namespace eval ::xo::Table { Class Action \ -superclass ::xo::OrderedComposite::Child \ - -parameter {label url {tooltip {}}} + -parameter {label url {tooltip {}}} + #-proc destroy {} { + # my log "-- DESTROY " + # show_stack + # next + # } Class Field \ -superclass ::xo::OrderedComposite::Child \ @@ -160,6 +273,8 @@ {src /resources/acs-subsite/Edit16.gif} {width 16} {height 16} {border 0} {title "Edit Item"} {alt "edit"} } + + # for xotcl 1.4.0: {title [_ xotcl-core.edit_item]} {alt "edit"} Class ImageField_ViewIcon \ -superclass ImageField -parameter { {src /resources/acs-subsite/Zoom16.gif} {width 16} {height 16} {border 0} @@ -175,6 +290,7 @@ namespace export Field AnchorField Action ImageField \ ImageField_EditIcon ImageField_ViewIcon ImageField_DeleteIcon } + } @@ -183,6 +299,7 @@ # Class for rendering ::xo::Table as the html TABLE # Class TABLE \ + -superclass ::xo::Drawable \ -instproc init_renderer {} { #my log "--" my set __rowcount 0 @@ -240,22 +357,33 @@ # ::xo:Table requires the elements to have the methods render and render-data # - Class create TABLE::Action -instproc render {} { - html::a -class button -title [my tooltip] -href [my url] { html::t [my label] } - } + 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 "-- " + } + #-proc destroy {} { + # my log "-- DESTROY" + # show_stack + # next + #} - Class create TABLE::Field + Class create TABLE::Field -superclass ::xo::Drawable TABLE::Field instproc render-data {line} { html::t [$line set [my name]] } TABLE::Field instproc render {} { html::th [concat [list class list] [my html]] { if {[my set orderby] eq ""} { - html::t [my set label] + html::t [my _ label] } else { my renderSortLabels } + my render_localizer ;# run this before th is closed } } @@ -285,7 +413,7 @@ } set href [export_vars -base [ad_conn url] $query] html::a -href $href -title $title { - html::t [my set label] + html::t [my _ label] html::img -src $img -alt "" } } @@ -309,6 +437,7 @@ html::a -href [$line set [my name].href] -style "border-bottom: none;" { html::img [$line attlist [my name] {src width height border title alt}] {} } + $line render_localizer } Class TABLE2 \ @@ -342,7 +471,8 @@ Class TableWidget \ -superclass ::xo::Table \ -instproc init {} { - my render_with [my renderer] + set trn_mixin [expr {[lang::util::translator_mode_p] ?"::xo::TRN-Mode" : ""}] + my render_with [my renderer] $trn_mixin next } Index: openacs-4/packages/xotcl-core/tcl/generic-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/generic-procs.tcl,v diff -u -r1.6 -r1.7 --- openacs-4/packages/xotcl-core/tcl/generic-procs.tcl 31 Dec 2005 16:36:09 -0000 1.6 +++ openacs-4/packages/xotcl-core/tcl/generic-procs.tcl 19 Jan 2006 22:57:37 -0000 1.7 @@ -507,7 +507,7 @@ } db_transaction { - $__class instvar mime_type storage_type object_type + $__class instvar storage_type object_type $__class folder_type -folder_id $parent_id register set item_id [db_exec_plsql note_insert " select content_item__new(:title,$parent_id,null,null,null,null,null,null, @@ -534,7 +534,7 @@ instance variable. } { # delegate deletion to the class - [my info class] delete [my set instance_id] + [my info class] delete [my set item_id] } # @@ -875,3 +875,4 @@ namespace export CrItem } namespace import -force ::Generic::* +