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]"}