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.44 -r1.45
--- openacs-4/packages/xotcl-core/xotcl-core.info 17 Dec 2007 12:20:32 -0000 1.44
+++ openacs-4/packages/xotcl-core/xotcl-core.info 26 Jan 2008 00:58:58 -0000 1.45
@@ -8,7 +8,7 @@
<singleton-p>t</singleton-p>
<auto-mount>xotcl</auto-mount>
- <version name="0.80" url="http://media.wu-wien.ac.at/download/xotcl-core-0.80.apm">
+ <version name="0.81" url="http://media.wu-wien.ac.at/download/xotcl-core-0.81.apm">
<owner url="mailto:neumann@wu-wien.ac.at">Gustaf Neumann</owner>
<summary>XOTcl library functionality (e.g. thread handling, online documentation, Generic Form and List Classes)</summary>
<release-date>2007-11-13</release-date>
@@ -41,7 +41,7 @@
<license>BSD-Style</license>
<maturity>0</maturity>
- <provides url="xotcl-core" version="0.80"/>
+ <provides url="xotcl-core" version="0.81"/>
<callbacks>
<callback type="before-install" proc="::xotcl::before_install_callback"/>
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.10 -r1.11
--- openacs-4/packages/xotcl-core/catalog/xotcl-core.en_US.ISO-8859-1.xml 10 Dec 2007 09:12:42 -0000 1.10
+++ openacs-4/packages/xotcl-core/catalog/xotcl-core.en_US.ISO-8859-1.xml 26 Jan 2008 00:58:59 -0000 1.11
@@ -2,8 +2,10 @@
<message_catalog package_key="xotcl-core" locale="en_US" charset="ISO-8859-1">
<msg key="add">Add %type%</msg>
+ <msg key="add_item">Add Item</msg>
<msg key="add_long">Add new item of type %type%</msg>
<msg key="create_new_type">Create New %type%</msg>
+ <msg key="delete_item">Delete Item</msg>
<msg key="edit_item">Edit Item</msg>
<msg key="edit_type">Edit %type%</msg>
<msg key="has_entered_the_room">has entered the room</msg>
@@ -13,4 +15,5 @@
</blockquote></msg>
<msg key="revision_title">Revisions of Entry</msg>
<msg key="revisions">Revisions</msg>
+ <msg key="view_item">View Item</msg>
</message_catalog>
Index: openacs-4/packages/xotcl-core/tcl/00-serializer-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/00-serializer-procs.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/xotcl-core/tcl/00-serializer-procs.tcl 8 Oct 2007 00:06:37 -0000 1.3
+++ openacs-4/packages/xotcl-core/tcl/00-serializer-procs.tcl 26 Jan 2008 00:58:59 -0000 1.4
@@ -1,476 +1,8 @@
# $Id$
-if {$::xotcl::version > 1.4} return
-ns_log notice "we have a version ot XOTcl older than 1.5"
-
-package require XOTcl 1.3
-package provide xotcl::serializer 0.9
-
-namespace eval ::xotcl::serializer {
-
- namespace import -force ::xotcl::*
-
- @ @File {
- description {
- This package provides the class Serializer, which can be used to
- generate a snapshot of the current state of the workspace
- in the form of XOTcl source code.
- }
- authors {
- Gustaf Neumann, Gustaf.Neumann@wu-wien.ac.at
- }
- date { $Date$ }
- }
-
- @ Serializer proc all {
- ?-ignoreVarsRE RE?
- "provide regular expression; matching vars are ignored"
- ?-ignore obj1 obj2 ...?
- "provide a list of objects to be omitted"} {
- Description {
- Serialize all objects and classes that are currently
- defined (except the specified omissions and the current
- Serializer object).
- <p>Examples:<@br>
- <@pre class='code'>Serializer all -ignoreVarsRE {::b$}</@pre>
- Do not serialize any instance variable named b (of any object).<p>
- <@pre class='code'>Serializer all -ignoreVarsRE {^::o1::.*text.*$|^::o2::x$}</@pre>
- Do not serialize any variable of c1 whose name contains
- the string "text" and do not serialze the variable x of o2.<p>
- <@pre class='code'>Serializer all -ignore obj1 obj2 ... </@pre>
- do not serizalze the specified objects
- }
- return "script"
- }
-
- @ Serializer proc deepSerialize {
- objs "Objects to be serialized"
- ?-ignoreVarsRE RE?
- "provide regular expression; matching vars are ignored"
- ?-ignore obj1 obj2 ...?
- "provide a list of objects to be omitted"
- ?-map list? "translate object names in serialized code"
- } {
- Description {
- Serialize object with all child objects (deep operation)
- except the specified omissions. For the description of
- <@tt>ignore</@tt> and <@tt>igonoreVarsRE</@tt> see
- <@tt>Serizalizer all</@tt>. <@tt>map</@tt> can be used
- in addition to provide pairs of old-string and new-string
- (like in the tcl command <@tt>string map</@tt>). This option
- can be used to regenerate the serialized object under a different
- object or under an different name, or to translate relative
- object names in the serialized code.<p>
-
- Examples:
- <@pre class='code'>Serializer deepSerialize ::a::b::c -map {::a::b ::x::y}</@pre>
- Serialize the object <@tt>c</@tt> which is a child of <@tt>a::b</@tt>;
- the object will be reinitialized as object <@tt>::x::y::c</@tt>,
- all references <@tt>::a::b</@tt> will be replaced by <@tt>::x::y</@tt>.<p>
-
- <@pre class='code'>Serializer deepSerialize ::a::b::c -map {::a::b [self]}</@pre>
- The serizalized object can be reinstantiated under some current object,
- under which the script is evaluated.<p>
-
- <@pre class='code'>Serializer deepSerialize ::a::b::c -map {::a::b::c ${var}}</@pre>
- The serizalized object will be reinstantiated under a name specified
- by the variable <@tt>var<@tt> in the recreation context.
- }
- return "script"
- }
-
- @ Serializer proc methodSerialize {
- object "object or class"
- method "name of method"
- prefix "either empty or 'inst' (latter for instprocs)"
- } {
- Description {
- Serialize the specified method. In order to serialize
- an instproc, <@tt>prefix</@tt> should be 'inst'; to serialze
- procs, it should be empty.<p>
-
- Examples:
- <@pre class='code'>Serializer methodSerialize Serializer deepSerialize ""</@pre>
- This command serializes the proc <@tt>deepSerialize</@tt>
- of the Class <@tt>Serializer</@tt>.<p>
-
- <@pre class='code'>Serializer methodSerialize Serializer serialize inst</@pre>
- This command serializes the instproc <@tt>serialize</@tt>
- of the Class <@tt>Serializer</@tt>.<p>
- }
- return {Script, which can be used to recreate the specified method}
- }
- @ Serializer proc exportMethods {
- list "list of methods of the form 'object proc|instproc methodname'"
- } {
- Description {
- This method can be used to specify methods that should be
- exported in every <@tt>Serializer all<@/tt>. The rationale
- behind this is that the serializer does not serialize objects
- from the ::xotcl:: namespace, which is used for XOTcl internals
- and volatile objects. It is however often useful to define
- methods on ::xotcl::Class or ::xotcl::Objects, which should
- be exported. One can export procs, instprocs, forward and instforward<p>
- Example:
- <@pre class='code'> Serializer exportMethods {
- ::xotcl::Object instproc __split_arguments
- ::xotcl::Object instproc __make_doc
- ::xotcl::Object instproc ad_proc
- ::xotcl::Class instproc ad_instproc
- ::xotcl::Object forward expr
- }<@/pre>
- }
- }
-
-
- @ Serializer instproc serialize {entity "Object or Class"} {
- Description {
- Serialize the specified object or class.
- }
- return {Object or Class with all currently defined methods,
- variables, invariants, filters and mixins}
- }
-
- ##################################################################################
- # real clode starts here.....
- # ################################################################################
- Class Serializer -parameter {ignoreVarsRE map}
- namespace export Serializer
-
- Serializer proc ignore args {
- my set skip $args
- }
- Serializer instproc ignore args {
- foreach i $args {
- my set skip($i) 1
- # skip children of ignored objects as well
- foreach j [$i info children] {
- my ignore $j
- }
- }
- }
- Serializer instproc init {} {
- my ignore [self]
- if {[[self class] exists skip]} {
- eval my ignore [[self class] set skip]
- }
- }
- Serializer instproc method-serialize {o m prefix} {
- my pcmd [my unescaped-method-serialize $o $m $prefix]
- }
- Serializer instproc unescaped-method-serialize {o m prefix} {
- set arglist [list]
- foreach v [$o info ${prefix}args $m] {
- if {[$o info ${prefix}default $m $v x]} {
- lappend arglist [list $v $x] } {lappend arglist $v}
- }
- lappend r ${prefix}proc $m \
- [concat [$o info ${prefix}nonposargs $m] $arglist] \
- [$o info ${prefix}body $m]
- foreach p {pre post} {
- if {[$o info ${prefix}$p $m] ne ""} {lappend r [$o info ${prefix}$p $m]}
- }
- return $r
- }
- Serializer instproc pcmd list {
- foreach a $list {
- if {[regexp -- {^-[[:alpha:]]} $a]} {
- set mustEscape 1
- break
- }
- }
- if {[info exists mustEscape]} {
- return "\[list -$list\]"
- } else {
- return -$list
- }
- }
- Serializer instproc Object-serialize o {
- append cmd [list [$o info class] create [$o self] -noinit] " \\\n"
- foreach i [$o info procs] {
- append cmd " " [my method-serialize $o $i ""] " \\\n"
- }
- foreach i [$o info forward] {
- set fwd [concat [list forward $i] [$o info forward -definition $i]]
- append cmd \t [my pcmd $fwd] " \\\n"
- }
- set vset {}
- set nrVars 0
- foreach v [$o info vars] {
- set setcmd [list]
- if {![my exists ignoreVarsRE] ||
- ![regexp [my set ignoreVarsRE] ${o}::$v]} {
- if {[$o array exists $v]} {
- lappend setcmd array set $v [$o array get $v]
- } else {
- lappend setcmd set $v [$o set $v]
- }
- incr nrVars
- append cmd \t [my pcmd $setcmd] " \\\n"
- }
- }
- foreach x {mixin invar} {
- set v [$o info $x]
- if {$v ne ""} {my append postcmd [list $o $x set $v] "\n"}
- }
- set v [$o info filter -guards]
- if {$v ne ""} {append cmd [my pcmd [list filter $v]] " \\\n"}
- return $cmd
- }
- Serializer instproc Class-serialize o {
- set cmd [my Object-serialize $o]
- set p [$o info parameter]
- if {$p ne ""} {
- append cmd " " [my pcmd [list parameter $p]] " \\\n"
- }
- foreach i [$o info instprocs] {
- append cmd " " [my method-serialize $o $i inst] " \\\n"
- }
- foreach i [$o info instforward] {
- set fwd [concat [list instforward $i] [$o info instforward -definition $i]]
- append cmd \t [my pcmd $fwd] " \\\n"
- }
- foreach x {superclass instinvar} {
- set v [$o info $x]
- if {$v ne "" && "::xotcl::Object" ne $v } {
- append cmd " " [my pcmd [list $x $v]] " \\\n"
- }
- }
- foreach x {instmixin} {
- set v [$o info $x]
- if {$v ne "" && "::xotcl::Object" ne $v } {
- my append postcmd [list $o $x set $v] "\n"
- #append cmd " " [my pcmd [list $x $v]] " \\\n"
- }
- }
- set v [$o info instfilter -guards]
- if {$v ne ""} {append cmd [my pcmd [list instfilter $v]] " \\\n"}
- return $cmd\n
- }
-
- Serializer instproc args {o prefix m} {
- foreach v [$o info ${prefix}args $m] {
- if {[$o info ${prefix}default $m $v x]} {
- lappend arglist [list $v $x] } {
- lappend arglist $v }
- }
- return $arglist
- }
- Serializer instproc category c {
- if {[$c istype ::xotcl::Class]} {return Class} {return Object}
- }
- Serializer instproc allChildren o {
- set set $o
- foreach c [$o info children] {
- eval lappend set [my allChildren $c]
- }
- return $set
- }
- Serializer instproc allInstances C {
- set set [$C info instances]
- foreach sc [$C info subclass] {
- eval lappend set [my allInstances $sc]
- }
- return $set
- }
-
- Serializer instproc topoSort {set all} {
- if {[my array exists s]} {my array unset s}
- if {[my array exists level]} {my array unset level}
- foreach c $set {
- if {!$all &&
- [string match "::xotcl::*" $c] &&
- ![[self class] exists exportObjects($c)]} continue
- if {[my exists skip($c)]} continue
- my set s($c) 1
- }
- set stratum 0
- while {1} {
- set set [my array names s]
- if {[llength $set] == 0} break
- incr stratum
- #my warn "$stratum set=$set"
- my set level($stratum) {}
- foreach c $set {
- if {[my [my category $c]-needsNothing $c]} {
- my lappend level($stratum) $c
- }
- }
- if {[my set level($stratum)] eq ""} {
- my set level($stratum) $set
- my warn "Cyclic dependency in $set"
- }
- foreach i [my set level($stratum)] {my unset s($i)}
- }
- }
- Serializer instproc warn msg {
- if {[info command ns_log] ne ""} {
- ns_log Notice $msg
- } else {
- puts stderr "!!! $msg"
- }
- }
-
- Serializer instproc Class-needsNothing x {
- if {![my Object-needsNothing $x]} {return 0}
- if {[my needsOneOf [$x info superclass]]} {return 0}
- #if {[my needsOneOf [$x info instmixin ]]} {return 0}
- return 1
- }
- Serializer instproc Object-needsNothing x {
- set p [$x info parent]
- if {$p ne "::" && [my needsOneOf $p]} {return 0}
- if {[my needsOneOf [$x info class]]} {return 0}
- #if {[my needsOneOf [$x info mixin ]]} {return 0}
- return 1
- }
- Serializer instproc needsOneOf list {
- foreach e $list {if {[my exists s($e)]} {return 1}}
- return 0
- }
- Serializer instproc serialize {objectOrClass} {
- string trimright [my [my category $objectOrClass]-serialize $objectOrClass] "\\\n"
- }
- Serializer instproc serialize-objects {list all} {
- my set postcmd ""
- my topoSort $list $all
- #foreach i [lsort [my array names level]] {my warn "$i: [my set level($i)]"}
- set result ""
- foreach l [lsort [my array names level]] {
- foreach i [my set level($l)] {
- #my warn "serialize $i"
- append result [my serialize $i] \n
- }
- }
- foreach e $list {
- set namespace($e) 1
- set namespace([namespace qualifiers $e]) 1
- }
-
- set exports ""
- set nsdefines ""
- # delete ::xotcl from the namespace list, if it exists...
- catch {unset namespace(::xotcl)}
- foreach ns [array name namespace] {
- if {![namespace exists $ns]} continue
- if {![my isobject $ns]} {
- append nsdefines "namespace eval $ns {}\n"
- } elseif {$ns ne [namespace origin $ns] } {
- append nsdefines "namespace eval $ns {}\n"
- }
- set exp [namespace eval $ns {namespace export}]
- if {$exp ne ""} {
- append exports "namespace eval $ns {namespace export $exp}" \n
- }
- }
- return $nsdefines$result[my set postcmd]$exports
- }
- Serializer instproc deepSerialize o {
- # assumes $o to be fully qualified
- my serialize-objects [my allChildren $o] 1
- }
- Serializer instproc serializeMethod {object kind name} {
- set code ""
- switch $kind {
- proc {
- if {[$object info procs $name] ne ""} {
- set code [my method-serialize $object $name ""]
- }
- }
- instproc {
- if {[$object info instprocs $name] ne ""} {
- set code [my method-serialize $object $name inst]
- }
- }
- forward - instforward {
- if {[$object info $kind $name] ne ""} {
- set fwd [concat [list $kind $name] [$object info $kind -definition $name]]
- set code [my pcmd $fwd]
- }
- }
- }
- return $code
- }
-
-
- Serializer proc exportMethods list {
- foreach {o p m} $list {my set exportMethods($o,$p,$m) 1}
- }
- Serializer proc exportObjects list {
- foreach o $list {my set exportObjects($o) 1}
- }
-
- Serializer proc serializeExportedMethods {s} {
- set r ""
- foreach k [my array names exportMethods] {
- foreach {o p m} [split $k ,] break
- #if {$o ne "::xotcl::Object" && $o ne "::xotcl::Class"} {
- #error "method export only for ::xotcl::Object and\
- # ::xotcl::Class implemented, not for $o"
- #}
- if {![string match "::xotcl::*" $o]} {
- error "method export is only for ::xotcl::* \
- object an classes implemented, not for $o"
- }
- append methods($o) [$s serializeMethod $o $p $m] " \\\n "
- }
- set objects [array names methods]
- foreach o [list ::xotcl::Object ::xotcl::Class] {
- set p [lsearch $o $objects]
- if {$p == -1} continue
- set objects [lreplace $objects $p $p]
- }
- foreach o [concat ::xotcl::Object ::xotcl::Class $objects] {
- if {![info exists methods($o)]} continue
- append r \n "$o configure \\\n " \
- [string trimright $methods($o) "\\\n "]
- }
- #puts stderr "... exportedMethods <$r\n>"
- return "$r\n"
- }
-
- Serializer proc all {args} {
- set filterstate [::xotcl::configure filter off]
- set s [eval my new -childof [self] -volatile $args]
- # always export __exitHandler
- my exportMethods [list ::xotcl::Object proc __exitHandler]
- set r {set ::xotcl::__filterstate [::xotcl::configure filter off]}
- append r \n "::xotcl::configure softrecreate [::xotcl::configure softrecreate]"
- append r \n [my serializeExportedMethods $s]
- # export the objects and classes
- #$s warn "export objects = [my array names exportObjects]"
- #$s warn "export objects = [my array names exportMethods]"
- append r [$s serialize-objects [$s allInstances ::xotcl::Object] 0]
- foreach o [list ::xotcl::Object ::xotcl::Class] {
- foreach x {mixin instmixin invar instinvar} {
- set v [$o info $x]
- if {$v ne "" && $v ne "::xotcl::Object"} {
- append r "$o configure " [$s pcmd [list $x $v]] "\n"
- }
- }
- }
- append r {
- ::xotcl::configure filter $::xotcl::__filterstate
- unset ::xotcl::__filterstate
- }
- ::xotcl::configure filter $filterstate
- return $r
- }
- Serializer proc methodSerialize {object method prefix} {
- set s [my new -childof [self] -volatile]
- concat $object [$s unescaped-method-serialize $object $method $prefix]
- }
- Serializer proc deepSerialize args {
- set s [my new -childof [self] -volatile]
- set nr [eval $s configure $args]
- foreach o [lrange $args 0 [incr nr -1]] {
- append r [$s deepSerialize [$o]]
- }
- if {[$s exists map]} {return [string map [$s map] $r]}
- return $r
- }
-
- Serializer exportObjects [namespace current]::Serializer
- namespace eval :: "namespace import -force [namespace current]::*"
-
- #ns_log notice "???? sourceing.....Serializer"
+if {$::xotcl::version < 1.5} {
+ ns_log notice "**********************************************************"
+ ns_log notice "This version of xotcl-core requires at least XOTcl 1.5.0."
+ ns_log notice "The installed version ($::xotcl::version$::xotcl::patchlevel appears to be older."
+ ns_log notice "Please updgrade to a new version (see http://openacs.org/xowiki/xotcl-core)"
+ ns_log notice "**********************************************************"
}
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.11 -r1.12
--- openacs-4/packages/xotcl-core/tcl/20-Ordered-Composite-procs.tcl 31 May 2007 20:17:34 -0000 1.11
+++ openacs-4/packages/xotcl-core/tcl/20-Ordered-Composite-procs.tcl 26 Jan 2008 00:58:59 -0000 1.12
@@ -66,7 +66,7 @@
}
}
#show_stack;my log "--W children murdered, now next, chlds=[my info children]"
- namespace eval [self] {namespace forget *} ;# for pre 1.4.0 versions
+ #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.28 -r1.29
--- openacs-4/packages/xotcl-core/tcl/30-widget-procs.tcl 1 Jan 2008 23:31:00 -0000 1.28
+++ openacs-4/packages/xotcl-core/tcl/30-widget-procs.tcl 26 Jan 2008 00:58:59 -0000 1.29
@@ -469,23 +469,22 @@
{src /resources/acs-subsite/Edit16.gif} {width 16} {height 16} {border 0}
{title "[_ xotcl-core.edit_item]"} {alt "edit"}
}
- # for xotcl 1.4.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 "Add Item"} {alt "add"}
+ {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 "View Item"} {alt "view"}
+ {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 "Delete Item"} {alt "delete"}
+ {title "[_ xotcl-core.delete_item]"} {alt "delete"}
}
# export table elements
Index: openacs-4/packages/xotcl-core/tcl/test/xotcl-avail-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/test/xotcl-avail-procs.tcl,v
diff -u -r1.2 -r1.3
--- openacs-4/packages/xotcl-core/tcl/test/xotcl-avail-procs.tcl 8 Oct 2007 17:37:03 -0000 1.2
+++ openacs-4/packages/xotcl-core/tcl/test/xotcl-avail-procs.tcl 26 Jan 2008 00:58:59 -0000 1.3
@@ -17,7 +17,7 @@
#}
}
- ? {expr {$::xotcl::version < 1.4}} 0 "XOTcl Version $::xotcl::version >= 1.4"
+ ? {expr {$::xotcl::version < 1.5}} 0 "XOTcl Version $::xotcl::version >= 1.5"
set ns_cache_version_old [catch {ns_cache names xowiki_cache xxx}]
if {$ns_cache_version_old} {