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.89.2.7 -r1.89.2.8
--- openacs-4/packages/xotcl-core/xotcl-core.info 11 Feb 2014 11:53:08 -0000 1.89.2.7
+++ openacs-4/packages/xotcl-core/xotcl-core.info 26 Mar 2014 18:10:36 -0000 1.89.2.8
@@ -10,10 +10,10 @@
t
xotcl
-
+
Gustaf Neumann
XOTcl library functionality (e.g. thread handling, online documentation, Generic Form and List Classes)
- 2013-09-08
+ 2014-03-24
Gustaf Neumann, WU Wien
<pre>
This component contains some core functionality for OpenACS
@@ -48,7 +48,7 @@
BSD-Style
2
-
+
Index: openacs-4/packages/xotcl-core/tcl/01-debug-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/01-debug-procs.tcl,v
diff -u -r1.72.2.12 -r1.72.2.13
--- openacs-4/packages/xotcl-core/tcl/01-debug-procs.tcl 14 Feb 2014 18:20:43 -0000 1.72.2.12
+++ openacs-4/packages/xotcl-core/tcl/01-debug-procs.tcl 26 Mar 2014 18:10:36 -0000 1.72.2.13
@@ -21,6 +21,7 @@
::xotcl::Object instproc show-object
::xotcl::Object instproc destroy_on_cleanup
::xotcl::Object instproc set_instance_vars_defaults
+ ::xotcl::Class instproc extend_slot
::xotcl::nonposArgs proc integer
::xotcl::nonposArgs proc optional
}
@@ -946,7 +947,36 @@
}
}
+#
+# Helper method to copy a slot and configure it
+#
+::xotcl::Class instproc extend_slot {arg} {
+ # The argument list is e.g. "foo -name x -title y"
+ #
+ # It is placed into one arguemnt to avoid interference with the "-"
+ # argument parsing since it will always start with a non-dashed
+ # value.
+ #
+ set name [lindex $arg 0]
+ set config [lrange $arg 1 end]
+
+ # search for slot
+ foreach c [my info heritage] {
+ if {[info command ${c}::slot::$name] ne ""} {
+ set slot ${c}::slot::$name
+ break
+ }
+ }
+ if {![info exists slot]} {error "can't find slot $name"}
+
+ # copy slot and configure it
+ set newSlot [self]::slot::$name
+ $slot copy $newSlot
+ $newSlot configure {*}$config
+}
+
+
#ns_log notice "*** FREECONN? [ns_ictl gettraces freeconn]"
#ns_ictl trace freeconn {ns_log notice "*** FREECONN isconnected=[ns_conn isconnected]"}
#ns_ictl oncleanup {ns_log notice "*** ONCLEANUP isconnected=[ns_conn isconnected]"}