Index: generic/predefined.xotcl
===================================================================
diff -u -rc72f9f638677608fab1502cd696c8f2d6b2952f9 -r46f02e4868e118466d888b35d6b281b3f2ba31ac
--- generic/predefined.xotcl	(.../predefined.xotcl)	(revision c72f9f638677608fab1502cd696c8f2d6b2952f9)
+++ generic/predefined.xotcl	(.../predefined.xotcl)	(revision 46f02e4868e118466d888b35d6b281b3f2ba31ac)
@@ -1,880 +1,995 @@
-# $Id: predefined.xotcl,v 1.16 2007/09/05 19:09:22 neumann Exp $
-# provide the standard command set for ::xotcl::Object
-foreach cmd [info command ::xotcl::Object::instcmd::*] {
-  ::xotcl::alias ::xotcl::Object [namespace tail $cmd] $cmd 
-}
-# provide some Tcl-commands as methods for Objects
-foreach cmd {array append eval incr lappend trace subst unset} {
-  ::xotcl::alias ::xotcl::Object $cmd -objscope ::$cmd
-}
-# provide the standard command set for ::xotcl::Class
-foreach cmd [info command ::xotcl::Class::instcmd::*] {
-  ::xotcl::alias ::xotcl::Class [namespace tail $cmd] $cmd 
-}
-unset cmd
+# $Id: predefined.xotcl,v 1.12 2006/10/04 20:40:23 neumann Exp $
+namespace eval ::xotcl {
+  proc ::xotcl::setrelation args {
+    puts stderr "::xotcl::setrelation is deprecated, use '::xotcl::relation $args' instead"
+    uplevel ::xotcl::relation $args
+  }
+  if {[info command ::oo::object] ne ""} {
+    ::xotcl::alias ::oo::class alloc ::xotcl::cmd::Class::alloc
+    ::oo::class alloc ::xotcl::Object
+    ::oo::class alloc ::xotcl::Class
+    ::xotcl::relation ::xotcl::Class superclass {::oo::class ::xotcl::Object}
+    ::xotcl::relation ::xotcl::Object class ::xotcl::Class
+    ::xotcl::relation ::xotcl::Class class ::xotcl::Class
+  }
+  set bootstrap 1
 
-# init must exist on Object. per default it is empty.
-::xotcl::Object instproc init args {}
+  # provide the standard command set for ::xotcl::Object
+  foreach cmd [info command ::xotcl::cmd::Object::*] {
+    ::xotcl::alias ::xotcl::Object [namespace tail $cmd] $cmd 
+  }
 
-# documentation stub object -> just ignore 
-# all documentations if xoDoc is not loaded
-::xotcl::Object create ::xotcl::@
-::xotcl::@ proc unknown args {}
-proc ::xotcl::myproc {args} {linsert $args 0 [::xotcl::self]} 
-proc ::xotcl::myvar  {var}  {::xotcl::my requireNamespace; return [::xotcl::self]::$var} 
-namespace eval ::xotcl { namespace export @ myproc myvar Attribute}
-########################
-# Parameter definitions
-########################
-::xotcl::setrelation ::xotcl::Class::Parameter superclass ::xotcl::Class
-::xotcl::Class::Parameter instproc mkParameter {obj name args} {
-  #puts "[::xotcl::self proc] $obj $name <$args>"
-  if {[$obj exists $name]} {
-    eval [$obj set $name] configure $args
-  } else {
-    $obj set $name [eval ::xotcl::my new -childof $obj $args]
+  # provide some Tcl-commands as methods for ::xotcl::Object
+  foreach cmd {array append eval incr lappend trace subst unset} {
+    ::xotcl::alias ::xotcl::Object $cmd -objscope ::$cmd
   }
-}
-::xotcl::Class::Parameter instproc getParameter {obj name args} {
-  #puts "[::xotcl::self proc] $obj $name <$args>"
-  [$obj set $name]
-}
-::xotcl::Class::Parameter proc Class {param args} {
-  #puts "*** [::xotcl::self] parameter: [::xotcl::self proc] '$param' <$args>"
-  ::xotcl::my set access [lindex $param 0]
-  ::xotcl::my set setter mkParameter
-  ::xotcl::my set getter getParameter
-  ::xotcl::my set extra {[::xotcl::self]}
-  ::xotcl::my set defaultParam [lrange $param 1 end]
-}
-::xotcl::Class::Parameter proc default {val} {
-  [::xotcl::my set cl] set __defaults([::xotcl::my set name]) $val
-}
-::xotcl::Class::Parameter proc setter x {
-  ::xotcl::my set setter $x
-}
-::xotcl::Class::Parameter proc getter x {
-  ::xotcl::my set getter $x
-}
-::xotcl::Class::Parameter proc access obj {
-  ::xotcl::my set access $obj
-  ::xotcl::my set extra \[::xotcl::self\]
-  foreach v [$obj info vars] {::xotcl::my set $v [$obj set $v]}
-}
-::xotcl::Class::Parameter proc values {param args} {
-  set cl [::xotcl::my set cl]
-  set ci [$cl info instinvar]
-  set valueTest {}
-  foreach a $args {
-    ::lappend valueTest "\[\$cl set $param\] == [list $a]"
+  # provide the standard command set for ::xotcl::Class
+  foreach cmd [info command ::xotcl::cmd::Class::*] {
+    ::xotcl::alias ::xotcl::Class [namespace tail $cmd] $cmd 
   }
-  ::lappend ci [join $valueTest " || "]
-  $cl instinvar $ci
-}
+  # "init" must exist on Object. per default it is empty.
+  ::xotcl::Object instproc init args {}
 
-##################
-# Slot definitions
-##################
-# bootstrap code; we cannot use -parameter yet
-::xotcl::Class create ::xotcl::MetaSlot
-::xotcl::setrelation ::xotcl::MetaSlot superclass ::xotcl::Class
-::xotcl::MetaSlot instproc new args {
-  set slotobject [self callingobject]::slot
-  if {![my isobject $slotobject]} {Object create $slotobject}
-  #namespace eval [self]::slot $cmds
-  #puts "metaslot $args // [namespace current] // [self callingobject]"
-  eval next -childof $slotobject $args
-}
-::xotcl::MetaSlot create ::xotcl::Slot -array set __defaults {
-  name "[namespace tail [::xotcl::self]]" 
-  domain "[lindex [regexp -inline {^(.*)::slot::[^:]+$} [::xotcl::self]] 1]"
-  defaultmethods {get assign}
-  manager "[::xotcl::self]"
-  multivalued false
-  per-object false
-}
-foreach p {name domain defaultmethods manager default multivalued type
-  per-object initcmd valuecmd valuechangedcmd} {
-  ::xotcl::Slot instparametercmd $p
-}
-unset p
+  #
+  # create class and object for nonpositional argument processing
+  ::xotcl::Class create ::xotcl::NonposArgs
 
-::xotcl::alias ::xotcl::Slot get ::xotcl::setinstvar
-::xotcl::alias ::xotcl::Slot assign ::xotcl::setinstvar
-::xotcl::Slot instproc add {obj prop value {pos 0}} {
-  if {![my multivalued]} {
-    error "Property $prop of [my domain]->$obj ist not multivalued"
+  foreach cmd [info command ::xotcl::cmd::NonposArgs::*] {
+    ::xotcl::alias ::xotcl::NonposArgs [namespace tail $cmd] $cmd 
   }
-  if {[$obj exists $prop]} {
-    $obj set $prop [linsert [$obj set $prop] $pos $value]
-  } else {
-    $obj set $prop [list $value]
+
+  ::xotcl::NonposArgs create ::xotcl::nonposArgs 
+
+  ########################
+  # Info definition
+  ########################
+  ::xotcl::Object create ::xotcl::objectInfo
+  ::xotcl::Object create ::xotcl::classInfo
+  foreach cmd [info command ::xotcl::cmd::ObjectInfo::*] {
+    ::xotcl::alias ::xotcl::objectInfo [namespace tail $cmd] $cmd 
+    ::xotcl::alias ::xotcl::classInfo [namespace tail $cmd] $cmd 
   }
-}
-::xotcl::Slot instproc delete {-nocomplain:switch obj prop value} {
-  set old [$obj set $prop]
-  set p [lsearch -glob $old $value]
-  if {$p>-1} {$obj set $prop [lreplace $old $p $p]} else {
-    error "$value is not a $prop of $obj (valid are: $old)"
+  foreach cmd [info command ::xotcl::cmd::ClassInfo::*] {
+    ::xotcl::alias ::xotcl::classInfo [namespace tail $cmd] $cmd 
   }
-}
+  ::xotcl::alias ::xotcl::objectInfo is ::xotcl::is
+  ::xotcl::alias ::xotcl::classInfo is ::xotcl::is
+  ::xotcl::alias ::xotcl::classInfo classparent ::xotcl::cmd::ObjectInfo::parent 
+  ::xotcl::alias ::xotcl::classInfo classchildren ::xotcl::cmd::ObjectInfo::children
+  unset cmd
+  ::xotcl::Object instforward info -onerror ::xotcl::infoError ::xotcl::objectInfo %1 {%@2 %self}
+  ::xotcl::Class instforward info -onerror ::xotcl::infoError ::xotcl::classInfo %1 {%@2 %self}
 
-::xotcl::Slot instproc unknown {method args} {
-  set methods [list]
-  foreach m [my info methods] {
-    if {[::xotcl::Object info methods $m] ne ""} continue
-    if {[string match __* $m]} continue
-    lappend methods $m
+  proc ::xotcl::infoError msg {
+    #puts stderr "INFO ERROR: <$msg>\n$::errorInfo"
+    regsub -all " <object>" $msg "" msg
+    regsub -all " <class>" $msg "" msg
+    regsub {\"} $msg "\"info " msg
+    error $msg ""
   }
-  error "Method '$method' unknown for slot [self]; valid are: {[lsort $methods]]}"
-}
-::xotcl::Slot instproc init {} {
-  my instvar name domain manager
-  set forwarder [expr {[my per-object] ? "forward" : "instforward"}]
-  #puts "domain=$domain /[self callingobject]/[my info parent]"
-  if {$domain eq ""} {
-    set domain [self callingobject]
+  ::xotcl::objectInfo proc info {obj} {
+    set methods [list]
+    foreach m [::info commands ::xotcl::objectInfo::*] {
+      set name [namespace tail $m]
+      if {$name eq "unknown"} continue
+      lappend methods $name
+    }
+    return "valid options are: [join [lsort $methods] {, }]"
   }
-  $domain $forwarder $name -default [$manager defaultmethods] $manager %1 %self %proc
-}
-#
-#  InfoSlot
-#
-::xotcl::MetaSlot create ::xotcl::InfoSlot -array set __defaults {
-  multivalued true
-}
-::xotcl::setrelation ::xotcl::InfoSlot superclass ::xotcl::Slot
-::xotcl::InfoSlot instproc get {obj prop} {$obj info $prop}
-::xotcl::InfoSlot instproc add {obj prop value {pos 0}} {
-  if {![my multivalued]} {
-    error "Property $prop of [my domain]->$obj ist not multivalued"
+  ::xotcl::objectInfo proc unknown {method args} {
+    error "unknown info option \"$method\"; [my info info]"
   }
-  $obj $prop [linsert [$obj info $prop] $pos $value]
-}
-::xotcl::InfoSlot instproc delete {-nocomplain:switch obj prop value} {
-  set old [$obj info $prop]
-  set p [lsearch -glob $old $value]
-  if {$p>-1} {$obj $prop [lreplace $old $p $p]} else {
-    error "$value is not a $prop of $obj (valid are: $old)"
-  }
-}
-#
-# InterceptorSlot
-#
-::xotcl::MetaSlot create ::xotcl::InterceptorSlot
-::xotcl::setrelation ::xotcl::InterceptorSlot superclass ::xotcl::InfoSlot
-::xotcl::alias ::xotcl::InterceptorSlot set ::xotcl::setrelation ;# for backwards compatibility
-::xotcl::alias ::xotcl::InterceptorSlot assign ::xotcl::setrelation
 
-::xotcl::InterceptorSlot instproc add {obj prop value {pos 0}} {
-  if {![my multivalued]} {
-    error "Property $prop of [my domain]->$obj ist not multivalued"
+  ::xotcl::classInfo proc info {cl} {
+    set methods [list]
+    foreach m [::info commands ::xotcl::classInfo::*] {
+      set name [namespace tail $m]
+      if {$name eq "unknown"} continue
+      lappend methods $name
+    }
+    return "valid options are: [join [lsort $methods] {, }]"
   }
-  $obj $prop [linsert [$obj info $prop -guards] $pos $value]
-}
+  ::xotcl::classInfo proc unknown {method args} {
+    error "unknown info option \"$method\"; [my info info]"
+  }
 
-######################
-# system slots
-######################
-namespace eval ::xotcl::Class::slot {}
-namespace eval ::xotcl::Object::slot {}
+  # documentation stub object -> just ignore per default. 
+  # if xoDoc is loaded, documentation will be activated
+  ::xotcl::Object create ::xotcl::@
 
-::xotcl::InfoSlot create ::xotcl::Class::slot::superclass
-::xotcl::alias ::xotcl::Class::slot::superclass assign ::xotcl::setrelation
+  ::xotcl::@ proc unknown args {}
+  proc ::xotcl::myproc {args} {linsert $args 0 [::xotcl::self]} 
+  proc ::xotcl::myvar  {var}  {::xotcl::my requireNamespace; return [::xotcl::self]::$var} 
 
-::xotcl::InfoSlot create ::xotcl::Object::slot::class
-::xotcl::alias ::xotcl::Object::slot::class assign ::xotcl::setrelation
+  namespace export Object Class @ myproc myvar Attribute
 
-::xotcl::InterceptorSlot create ::xotcl::Object::slot::mixin
-::xotcl::InterceptorSlot create ::xotcl::Object::slot::filter
-::xotcl::InterceptorSlot create ::xotcl::Class::slot::instmixin
-::xotcl::InterceptorSlot create ::xotcl::Class::slot::instfilter 
+  ##################
+  # Slot definitions
+  ##################
+  # still bootstrap code; we cannot use slots/-parameter yet
+  ::xotcl::Class create ::xotcl::MetaSlot
 
-#
-# Attribute
-#
-::xotcl::MetaSlot create ::xotcl::Attribute -superclass ::xotcl::Slot
-foreach p {default value_check initcmd valuecmd valuechangedcmd} {
-  ::xotcl::Attribute instparametercmd $p
-}
-unset p
-::xotcl::Attribute array set  __defaults {
-  value_check once
-}
-::xotcl::Attribute instproc __default_from_cmd {obj cmd var sub op} {
-  #puts "GETVAR [self proc] obj=$obj cmd=$cmd, var=$var, op=$op"
-  $obj trace remove variable $var $op [list [self] [self proc] $obj $cmd]
-  $obj set $var [$obj eval $cmd]
-}
-::xotcl::Attribute instproc __value_from_cmd {obj cmd var sub op} {
-  #puts "GETVAR [self proc] obj=$obj cmd=$cmd, var=$var, op=$op"
-  $obj set $var [$obj eval $cmd]
-}
-::xotcl::Attribute instproc __value_changed_cmd {obj cmd var sub op} {
-  #puts stderr "**************************"
-  #puts "valuechanged obj=$obj cmd=$cmd, var=$var, op=$op, ...
-  #$obj exists $var -> [$obj set $var]"
-  eval $cmd
-}
-::xotcl::Attribute instproc destroy {} {
-  #puts stderr "++++ [my domain] unset __defaults([my name]) [my default]"
-  #[my domain] unset -nocomplain __defaults([my name])
-  next
-}
-::xotcl::Attribute instproc check_single_value {
-  {-keep_old_value:boolean true} 
-  value predicate type obj var
-} {
-  #puts "+++ checking $value with $predicate ==> [expr $predicate]"
-  if {![expr $predicate]} {
-    if {[$obj exists __oldvalue($var)]} {
-      $obj set $var [$obj set __oldvalue($var)]
-    } else {
-      $obj unset -nocomplain $var
+  ::xotcl::relation ::xotcl::MetaSlot superclass ::xotcl::Class
+  ::xotcl::MetaSlot instproc new args {
+    set slotobject [::xotcl::self callingobject]::slot
+    if {![::xotcl::is $slotobject object]} {::xotcl::Object create $slotobject}
+    eval next -childof $slotobject $args
+  }
+  ::xotcl::MetaSlot create ::xotcl::Slot
+
+  # use low level interface for defining slot values. Normally, this is
+  # done via slot objects, which are defined later. 
+  
+  proc createBootstrapAttributeSlots {class definitions} {
+    if {![::xotcl::is ${class}::slot object]} {
+      ::xotcl::Object create ${class}::slot
     }
-    error "$value is not of type $type"
+    foreach att $definitions {
+      if {[llength $att]>1} {foreach {att default} $att break}
+      ::xotcl::Slot create ${class}::slot::$att
+      if {[info exists default]} {
+        ::xotcl::setinstvar ${class}::slot::$att default $default
+        unset default
+      }
+      $class instparametercmd $att
+    }
+    # do a second round to ensure that the already defined objects
+    # have the appropriate default values
+    foreach att $definitions {
+      if {[llength $att]>1} {foreach {att default} $att break}
+      if {[info exists default]} {
+        # checking subclasses is not required during bootstrap
+        foreach i [$class info instances] {
+          if {![$i exists $att]} {::xotcl::setinstvar $i $att $default}
+        }
+        unset default
+      }
+    }
   }
-  if {$keep_old_value} {$obj set __oldvalue($var) $value}
-}
+  
+  # We provide a default value for superclass (when no superclass is specified explicitely)
+  # for defining the top-level class of the object system, such that different
+  # object systems might co-exist.
+  createBootstrapAttributeSlots ::xotcl::Class {
+    {__default_superclass ::xotcl::Object}
+  }
 
-::xotcl::Attribute instproc check_multiple_values {values predicate type obj var} {
-  foreach value $values {
-    my check_single_value -keep_old_value false $value $predicate $type $obj $var
+  #
+  # Define slots for slots
+  #
+  createBootstrapAttributeSlots ::xotcl::Slot {
+    {name "[namespace tail [::xotcl::self]]"}
+    {domain "[lindex [regexp -inline {^(.*)::slot::[^:]+$} [::xotcl::self]] 1]"}
+    {defaultmethods {get assign}}
+    {manager "[::xotcl::self]"}
+    {multivalued false}
+    {per-object false}
+    {required false}
+    default 
+    type
   }
-  $obj set __oldvalue($var) $value
-}
-::xotcl::Attribute instproc mk_type_checker {} {
-  set __initcmd ""
-  if {[my exists type]} {
-    my instvar type name
-    if {[::xotcl::Object isclass $type]} {
-      set predicate [subst -nocommands {[::xotcl::Object isobject \$value] 
-	&& [\$value istype $type]}]
-    } elseif {[llength $type]>1} {
-      set predicate "\[$type \$value\]"
+  # maybe add the following slots at some later time here
+  #   initcmd
+  #   valuecmd
+  #   valuechangedcmd
+
+  ::xotcl::alias ::xotcl::Slot get ::xotcl::setinstvar
+  ::xotcl::alias ::xotcl::Slot assign ::xotcl::setinstvar
+
+  ::xotcl::Slot instproc add {obj prop value {pos 0}} {
+    if {![::xotcl::my multivalued]} {
+      error "Property $prop of [::xotcl::my domain]->$obj ist not multivalued"
+    }
+    if {[$obj exists $prop]} {
+      $obj set $prop [linsert [$obj set $prop] $pos $value]
     } else {
-      set predicate "\[string is $type \$value\]"
+      $obj set $prop [list $value]
     }
-    my append valuechangedcmd [subst {
-      my [expr {[my multivalued] ? "check_multiple_values" : "check_single_value"}] \[\$obj set $name\] \
-	  {$predicate} [list $type] \$obj $name
-    }]
-    append __initcmd [subst -nocommands {
-      if {[my exists $name]} {my set __oldvalue($name) [my set $name]}\n
-    }]
   }
-  return $__initcmd
-}
-::xotcl::Attribute instproc init {} {
-  my instvar domain name
-  next ;# do first ordinary slot initialization
-  # there might be already default values registered on the class
-  $domain unset -nocomplain __defaults($name) 
-  set __initcmd ""
-  if {[my exists default]} {
-    $domain set __defaults($name) [my default]
-  } elseif [my exists initcmd] {
-    append __initcmd "my trace add variable [list $name] read \
-	\[list [self] __default_from_cmd \[self\] [list [my initcmd]]\]\n"
-  } elseif [my exists valuecmd] {
-    append __initcmd "my trace add variable [list $name] read \
-	\[list [self] __value_from_cmd \[self\] [list [my valuecmd]]\]"
+  ::xotcl::Slot instproc delete {-nocomplain:switch obj prop value} {
+    set old [$obj set $prop]
+    set p [lsearch -glob $old $value]
+    if {$p>-1} {$obj set $prop [lreplace $old $p $p]} else {
+      error "$value is not a $prop of $obj (valid are: $old)"
+    }
   }
-  append __initcmd [my mk_type_checker]
-  if {[my exists valuechangedcmd]} {
-    append __initcmd "my trace add variable [list $name] write \
-	\[list [self] __value_changed_cmd \[self\] [list [my valuechangedcmd]]\]"
+
+  ::xotcl::Slot instproc unknown {method args} {
+    set methods [list]
+    foreach m [::xotcl::my info methods] {
+      if {[::xotcl::Object info methods $m] ne ""} continue
+      if {[string match __* $m]} continue
+      lappend methods $m
+    }
+    error "Method '$method' unknown for slot [::xotcl::self]; valid are: {[lsort $methods]]}"
   }
-  if {$__initcmd ne ""} {
-    $domain set __initcmds($name) $__initcmd
-    #puts stderr "$domain set __initcmds($name) $__initcmd"
+  ::xotcl::Slot instproc init {} {
+    ::xotcl::my instvar name domain manager per-object
+    set forwarder [expr {${per-object} ? "forward" : "instforward"}]
+    #puts "domain=$domain /[::xotcl::self callingobject]/[::xotcl::my info parent]"
+    if {$domain eq ""} {
+      set domain [::xotcl::self callingobject]
+    }
+    $domain $forwarder $name -default [$manager defaultmethods] $manager %1 %self %proc
   }
-}
-# mixin class for decativating all checks
-::xotcl::Class create ::xotcl::Slot::Nocheck \
-    -instproc check_single_value args {;} -instproc check_multiple_values args {;} \
-    -instproc mk_type_checker args {return ""}
-::xotcl::Class create ::xotcl::Slot::Optimizer \
-    -instproc proc args    {::xotcl::next; ::xotcl::my optimize} \
-    -instproc forward args {::xotcl::next; ::xotcl::my optimize} \
-    -instproc init args    {::xotcl::next; ::xotcl::my optimize} \
-    -instproc optimize {} {
-      if {[::xotcl::my multivalued]} return
-      if {[::xotcl::my defaultmethods] ne {get assign}} return
-      if {[::xotcl::my procsearch assign] ne "::xotcl::Slot instcmd assign"} return
-      if {[::xotcl::my procsearch get]    ne "::xotcl::Slot instcmd get"} return
-      set forwarder [expr {[::xotcl::my per-object] ? "parametercmd":"instparametercmd"}]
-      #puts stderr "**** optimizing       [::xotcl::my domain] $forwarder [::xotcl::my name]"
-      [::xotcl::my domain] $forwarder [::xotcl::my name]
+
+  #
+  #  InfoSlot
+  #
+  ::xotcl::MetaSlot create ::xotcl::InfoSlot 
+  createBootstrapAttributeSlots ::xotcl::InfoSlot {
+    {multivalued true}
+  }
+  
+  ::xotcl::relation ::xotcl::InfoSlot superclass ::xotcl::Slot
+  ::xotcl::InfoSlot instproc get {obj prop} {$obj info $prop}
+  ::xotcl::InfoSlot instproc add {obj prop value {pos 0}} {
+    if {![::xotcl::my multivalued]} {
+      error "Property $prop of [::xotcl::my domain]->$obj ist not multivalued"
     }
-# register the optimizer per default
-::xotcl::Slot instmixin add ::xotcl::Slot::Optimizer
+    $obj $prop [linsert [$obj info $prop] $pos $value]
+  }
+  ::xotcl::InfoSlot instproc delete {-nocomplain:switch obj prop value} {
+    set old [$obj info $prop]
+    set p [lsearch -glob $old $value]
+    if {$p>-1} {$obj $prop [lreplace $old $p $p]} else {
+      error "$value is not a $prop of $obj (valid are: $old)"
+    }
+  }
 
-#
-# Create a mixin class to overload method "new", such it does not allocate
-# new objects in ::xotcl::*, but in the specified object (without
-# syntactic overhead).
-#
-::xotcl::Class create ::xotcl::ScopedNew -superclass ::xotcl::Class \
-    -array set __defaults {withclass ::xotcl::Object}
-::xotcl::ScopedNew instparametercmd withclass
-::xotcl::ScopedNew instparametercmd inobject
-::xotcl::ScopedNew instproc init {} {
-  ::xotcl::my instproc new {-childof args} {
-    [::xotcl::self class] instvar {inobject object} withclass
-    if {![::xotcl::my isobject $object]} {
-      $withclass create $object
+  #
+  # InterceptorSlot
+  #
+  ::xotcl::MetaSlot alloc ::xotcl::InterceptorSlot
+
+  ::xotcl::relation ::xotcl::InterceptorSlot superclass ::xotcl::InfoSlot
+  ::xotcl::alias ::xotcl::InterceptorSlot set ::xotcl::relation ;# for backwards compatibility
+  ::xotcl::alias ::xotcl::InterceptorSlot assign ::xotcl::relation
+
+  ::xotcl::InterceptorSlot instproc add {obj prop value {pos 0}} {
+    if {![::xotcl::my multivalued]} {
+      error "Property $prop of [::xotcl::my domain]->$obj ist not multivalued"
     }
-    eval ::xotcl::next -childof $object $args
+    $obj $prop [linsert [$obj info $prop -guards] $pos $value]
   }
-}
-#
-# change the namespace to the specified object and create
-# objects there. This is a friendly notation for creating 
-# nested object structures. Optionally, creating new objects
-# in the specified scope can be turned off.
-#
-::xotcl::Object instproc contains {
-  {-withnew:boolean true} 
-  -object 
-  {-class ::xotcl::Object} 
-  cmds} {
-    if {![info exists object]} {set object [::xotcl::self]}
-    if {![::xotcl::my isobject $object]} {$class create $object}
-    $object requireNamespace
-    if {$withnew} {
-      set m [::xotcl::ScopedNew new \
-                 -inobject $object -withclass $class -volatile]
-      ::xotcl::Class instmixin add $m end
-      namespace eval $object $cmds
-      ::xotcl::Class instmixin delete $m
-    } else {
-      namespace eval $object $cmds
+
+  ######################
+  # system slots
+  ######################
+  #namespace eval ::xotcl::Class::slot {}
+  namespace eval ::xotcl::Object::slot {}
+  ::xotcl::Object alloc ::xotcl::Class::slot
+  ::xotcl::Object alloc ::xotcl::Object::slot
+
+  ::xotcl::InfoSlot create ::xotcl::Class::slot::superclass
+  ::xotcl::alias ::xotcl::Class::slot::superclass assign ::xotcl::relation
+  ::xotcl::InfoSlot create ::xotcl::Object::slot::class
+  ::xotcl::alias ::xotcl::Object::slot::class assign ::xotcl::relation
+
+  ::xotcl::InterceptorSlot create ::xotcl::Object::slot::mixin
+  ::xotcl::InterceptorSlot create ::xotcl::Object::slot::filter
+  ::xotcl::InterceptorSlot create ::xotcl::Class::slot::instmixin
+  ::xotcl::InterceptorSlot create ::xotcl::Class::slot::instfilter 
+
+  #
+  # Attribute
+  #
+  ::xotcl::MetaSlot create ::xotcl::Attribute -superclass ::xotcl::Slot
+
+  createBootstrapAttributeSlots ::xotcl::Attribute {
+    {value_check once}
+    initcmd
+    valuecmd
+    valuechangedcmd
+  }
+
+  ::xotcl::Attribute instproc __default_from_cmd {obj cmd var sub op} {
+    #puts "GETVAR [::xotcl::self proc] obj=$obj cmd=$cmd, var=$var, op=$op"
+    $obj trace remove variable $var $op [list [::xotcl::self] [::xotcl::self proc] $obj $cmd]
+    $obj set $var [$obj eval $cmd]
+  }
+  ::xotcl::Attribute instproc __value_from_cmd {obj cmd var sub op} {
+    #puts "GETVAR [::xotcl::self proc] obj=$obj cmd=$cmd, var=$var, op=$op"
+    $obj set $var [$obj eval $cmd]
+  }
+  ::xotcl::Attribute instproc __value_changed_cmd {obj cmd var sub op} {
+    # puts stderr "**************************"
+    # puts "valuechanged obj=$obj cmd=$cmd, var=$var, op=$op, ...\n$obj exists $var -> [$obj set $var]"
+    eval $cmd
+  }
+  ::xotcl::Attribute instproc check_single_value {
+    {-keep_old_value:boolean true}
+    value predicate type obj var
+  } {
+    #puts "+++ checking single value '$value' with $predicate ==> [expr $predicate]"
+    if {![expr $predicate]} {
+      if {[$obj exists __oldvalue($var)]} {
+        $obj set $var [$obj set __oldvalue($var)]
+      } else {
+        $obj unset -nocomplain $var
+      }
+      error "'$value' is not of type $type"
     }
+    if {$keep_old_value} {$obj set __oldvalue($var) $value}
+    #puts "+++ checking single value done"
   }
-::xotcl::Class instforward slots %self contains \
-    -object {%::xotcl::my subst [::xotcl::self]::slot}
 
-#
-# utilities
-#
-::xotcl::Class instproc parameter arglist {
-  if {![::xotcl::my isobject [self]::slot]} {::xotcl::Object create [self]::slot}
-  foreach arg $arglist {
-    #puts "arg=$arg"
-    set l [llength $arg]
-    set name [lindex $arg 0]
-    if {$l == 1} {
-      ::xotcl::Attribute create [::xotcl::self]::slot::$name
-      
-    } elseif {$l == 2} {
-      #puts  stderr "parameter $name has default '[lindex $arg 1]'"
-      ::xotcl::Attribute create [::xotcl::self]::slot::$name [list -default [lindex $arg 1]]
-    } elseif {$l == 3 && [lindex $arg 1] eq "-default"} {
-      ::xotcl::Attribute create [::xotcl::self]::slot::$name [list -default [lindex $arg 2]]
-    } else {
-      set paramstring [string range $arg [expr {[string length $name]+1}] end]
-      #puts  stderr "remaining arg = '$paramstring'"
-      if {[string match {[$\[]*} $paramstring]} {
-	#puts stderr "match,     $cl set __defaults($name) $paramstring"
-	::xotcl::Attribute create [::xotcl::self]::slot::$name [list -default $paramstring]
-	continue
+  ::xotcl::Attribute instproc check_multiple_values {values predicate type obj var} {
+    foreach value $values {
+      ::xotcl::my check_single_value -keep_old_value false $value $predicate $type $obj $var
+    }
+    $obj set __oldvalue($var) $value
+  }
+  ::xotcl::Attribute instproc mk_type_checker {} {
+    set __initcmd ""
+    if {[::xotcl::my exists type]} {
+      ::xotcl::my instvar type name
+      if {[::xotcl::Object isclass $type]} {
+        set predicate [subst -nocommands {
+          [::xotcl::Object isobject \$value] && [\$value istype $type]
+        }]
+      } elseif {[llength $type]>1} {
+        set predicate "\[$type \$value\]"
+      } else {
+        #set predicate "\[string is $type \$value\]"
+        set predicate "\[[self] type=$type $name \$value\]"
       }
+      #puts stderr predicate=$predicate
+      ::xotcl::my append valuechangedcmd [subst {
+        ::xotcl::my [expr {[::xotcl::my multivalued] ? 
+                           "check_multiple_values" : "check_single_value"
+                         }] \[\$obj set $name\] \
+            {$predicate} [list $type] \$obj $name
+      }]
+      append __initcmd [subst -nocommands {
+        if {[::xotcl::my exists $name]} {::xotcl::my set __oldvalue($name) [::xotcl::my set $name]}\n
+      }]
+    }
+    return $__initcmd
+  }
+  ::xotcl::Attribute instproc init {} {
+    ::xotcl::my instvar domain name
+    next ;# do first ordinary slot initialization
+    # there might be already default values registered on the class
+    set __initcmd ""
+    if {[::xotcl::my exists default]} {
+    } elseif [::xotcl::my exists initcmd] {
+      append __initcmd "::xotcl::my trace add variable [list $name] read \
+	\[list [::xotcl::self] __default_from_cmd \[::xotcl::self\] [list [::xotcl::my initcmd]]\]\n"
+    } elseif [::xotcl::my exists valuecmd] {
+      append __initcmd "::xotcl::my trace add variable [list $name] read \
+	\[list [::xotcl::self] __value_from_cmd \[::xotcl::self\] [list [::xotcl::my valuecmd]]\]"
+    }
+    append __initcmd [::xotcl::my mk_type_checker]
+    if {[::xotcl::my exists valuechangedcmd]} {
+      append __initcmd "::xotcl::my trace add variable [list $name] write \
+	\[list [::xotcl::self] __value_changed_cmd \[::xotcl::self\] [list [::xotcl::my valuechangedcmd]]\]"
+    }
+    if {$__initcmd ne ""} {
+      my set initcmd $__initcmd
+    }
+  }
 
-      set po ::xotcl::Class::Parameter
-      puts stderr "deprecated parameter usage '$arg'; use '-slots {Attribute ...}' instead"
+  # mixin class for decativating all checks
+::xotcl::Class create ::xotcl::Slot::Nocheck \
+      -instproc check_single_value args {;} -instproc check_multiple_values args {;} \
+      -instproc mk_type_checker args {return ""}
+  ::xotcl::Class create ::xotcl::Slot::Optimizer \
+      -instproc proc args    {::xotcl::next; ::xotcl::my optimize} \
+      -instproc forward args {::xotcl::next; ::xotcl::my optimize} \
+      -instproc init args    {::xotcl::next; ::xotcl::my optimize} \
+      -instproc optimize {} {
+        if {[::xotcl::my multivalued]} return
+        if {[::xotcl::my defaultmethods] ne {get assign}} return
+        if {[::xotcl::my procsearch assign] ne "::xotcl::Slot instcmd assign"} return
+        if {[::xotcl::my procsearch get]    ne "::xotcl::Slot instcmd get"} return
+        set forwarder [expr {[::xotcl::my per-object] ? "parametercmd":"instparametercmd"}]
+        #puts stderr "**** optimizing       [::xotcl::my domain] $forwarder [::xotcl::my name]"
+        [::xotcl::my domain] $forwarder [::xotcl::my name]
+      }
+  # register the optimizer per default
+  ::xotcl::Attribute instmixin add ::xotcl::Slot::Optimizer
 
-      set cl [self]
-      $po set name $name
-      $po set cl [self]
-      ::eval $po configure [lrange $arg 1 end]
+  #
+  # Create a mixin class to overload method "new", such it does not allocate
+  # new objects in ::xotcl::*, but in the specified object (without
+  # syntactic overhead).
+  #
+  ::xotcl::Class create ::xotcl::ScopedNew -superclass ::xotcl::Class
+  createBootstrapAttributeSlots ::xotcl::ScopedNew {
+    {withclass ::xotcl::Object}
+    inobject
+  }
 
-      if {[$po exists extra] || [$po exists setter] || 
-          [$po exists getter] || [$po exists access]} {
-        $po instvar extra setter getter access defaultParam
-        if {![info exists extra]} {set extra ""}
-        if {![info exists defaultParam]} {set defaultParam ""}
-        if {![info exists setter]} {set setter set}
-        if {![info exists getter]} {set getter set}
-        if {![info exists access]} {set access ::xotcl::my}
-        $cl instproc $name args "
+  ::xotcl::ScopedNew instproc init {} {
+    ::xotcl::my instproc new {-childof args} {
+      [::xotcl::self class] instvar {inobject object} withclass
+      if {![::xotcl::my isobject $object]} {
+        $withclass create $object
+      }
+      eval ::xotcl::next -childof $object $args
+    }
+  }
+  #
+  # change the namespace to the specified object and create
+  # objects there. This is a friendly notation for creating 
+  # nested object structures. Optionally, creating new objects
+  # in the specified scope can be turned off.
+  #
+  ::xotcl::Object instproc contains {
+    {-withnew:boolean true} 
+    -object 
+    {-class ::xotcl::Object} 
+    cmds} {
+      if {![info exists object]} {set object [::xotcl::self]}
+      if {![::xotcl::my isobject $object]} {$class create $object}
+      $object requireNamespace
+      if {$withnew} {
+        set m [::xotcl::ScopedNew new \
+                   -inobject $object -withclass $class -volatile]
+        ::xotcl::Class instmixin add $m end
+        namespace eval $object $cmds
+        ::xotcl::Class instmixin delete $m
+      } else {
+        namespace eval $object $cmds
+      }
+    }
+  ::xotcl::Class instforward slots %self contains \
+      -object {%::xotcl::my subst [::xotcl::self]::slot}
+  
+
+  #
+  # define parameter for backward compatibility and convenience
+  #
+  ::xotcl::Class instproc parameter arglist {
+    if {![::xotcl::is [::xotcl::self]::slot object]} {
+      ::xotcl::Object create [::xotcl::self]::slot
+    }
+    foreach arg $arglist {
+      #puts "arg=$arg"
+      set l [llength $arg]
+      set name [lindex $arg 0]
+      if {[string first : $name] > -1} {
+        foreach {name type} [split $name :] break
+        # TODO: comma list processing missing
+        if {$type eq "required"} {
+          set required 1
+          unset type
+        }
+      }
+      set cmd [list ::xotcl::Attribute create [::xotcl::self]::slot::$name]
+      if {[info exists type]} {
+        lappend cmd -type $type
+        unset type
+      }
+      if {[info exists required]} {
+        lappend cmd -required 1
+        unset required
+      }
+      if {$l == 1} {
+        eval $cmd
+        #puts stderr "parameter without default -> $cmd"
+      } elseif {$l == 2} {
+        lappend cmd [list -default [lindex $arg 1]]
+        #puts stderr "parameter with default -> $cmd"
+        eval $cmd
+      } elseif {$l == 3 && [lindex $arg 1] eq "-default"} {
+        lappend cmd [list -default [lindex $arg 2]]
+        eval $cmd
+      } else {
+        set paramstring [string range $arg [expr {[string length $name]+1}] end]
+        #puts  stderr "remaining arg = '$paramstring'"
+        if {[string match {[$\[]*} $paramstring]} {
+          lappend cmd [list -default $paramstring]
+          eval $cmd
+          continue
+        }
+        
+        set po ::xotcl::Class::Parameter
+        puts stderr "deprecated parameter usage '$arg'; use '-slots {Attribute ...}' instead"
+        
+        set cl [::xotcl::self]
+        $po set name $name
+        $po set cl [::xotcl::self]
+        ::eval $po configure [lrange $arg 1 end]
+        
+        if {[$po exists extra] || [$po exists setter] || 
+            [$po exists getter] || [$po exists access]} {
+          $po instvar extra setter getter access defaultParam
+          if {![info exists extra]} {set extra ""}
+          if {![info exists defaultParam]} {set defaultParam ""}
+          if {![info exists setter]} {set setter set}
+          if {![info exists getter]} {set getter set}
+          if {![info exists access]} {set access ::xotcl::my}
+          $cl instproc $name args "
          if {\[llength \$args] == 0} {
            return \[$access $getter $extra $name\]
          } else {
            return \[eval $access $setter $extra $name \$args $defaultParam \]
          }"
-        foreach instvar {extra defaultParam setter getter access} {
-          $po unset -nocomplain $instvar
+          foreach instvar {extra defaultParam setter getter access} {
+            $po unset -nocomplain $instvar
+          }
+        } else {
+          ::xotcl::my instparametercmd $name
         }
-      } else {
-        ::xotcl::my instparametercmd $name
       }
     }
+    [::xotcl::self]::slot set __parameter $arglist
   }
-  [self]::slot set __parameter $arglist
-}
-#
-# utilities
-#
-::xotcl::Object instproc self {} {::xotcl::self}
-::xotcl::Object instproc defaultmethod {} {
-  #if {"::" ne [::xotcl::my info parent] } {
-  #  [::xotcl::my info parent] __next
-  #}
-  return [::xotcl::self]
-}
 
-# support for XOTcl specifics
-::xotcl::Object instproc hasclass cl {
-  if {[::xotcl::my ismixin $cl]} {return 1}
-  ::xotcl::my istype $cl
-}
-::xotcl::Class instproc allinstances {} {
-  set set [::xotcl::my info instances]
-  foreach sc [::xotcl::my info subclass] {
-    eval lappend set [$sc allinstances]
-  }
-  return $set
-}
 
-
-# Exit Handler
-::xotcl::Object proc unsetExitHandler {} {
-  ::xotcl::Object proc __exitHandler {} {
-    # clients should append exit handlers to this proc body
-    ;
+  #
+  # utilities
+  #
+  ::xotcl::Object instproc self {} {::xotcl::self}
+  ::xotcl::Object instproc defaultmethod {} {
+    #if {"::" ne [::xotcl::my info parent] } {
+    #  [::xotcl::my info parent] __next
+    #}
+    return [::xotcl::self]
   }
-}
-# pre-defined as empty method
-::xotcl::Object unsetExitHandler
-::xotcl::Object proc setExitHandler {newbody} {
-  ::xotcl::Object proc __exitHandler {} $newbody
-}
-::xotcl::Object proc getExitHandler {} {
-  ::xotcl::Object info body __exitHandler
-}
+  
+  # support for XOTcl specific convenience routines
+  ::xotcl::Object instproc hasclass cl {
+    if {[::xotcl::my ismixin $cl]} {return 1}
+    ::xotcl::my istype $cl
+  }
+  ::xotcl::Class instproc allinstances {} {
+    set set [::xotcl::my info instances]
+    foreach sc [::xotcl::my info subclass] {
+      eval lappend set [$sc allinstances]
+    }
+    return $set
+  }
 
-::xotcl::Object instproc abstract {methtype methname arglist} {
-  if {$methtype ne "proc" && $methtype ne "instproc"} {
-    error "invalid method type '$methtype', \
-	must be either 'proc' or 'instproc'."
+  # Exit Handler
+  ::xotcl::Object proc unsetExitHandler {} {
+    ::xotcl::Object proc __exitHandler {} {
+      # clients should append exit handlers to this proc body
+      ;
+    }
   }
-  ::xotcl::my $methtype $methname $arglist "
+  # pre-defined as empty method
+  ::xotcl::Object unsetExitHandler
+  ::xotcl::Object proc setExitHandler {newbody} {
+    ::xotcl::Object proc __exitHandler {} $newbody
+  }
+  ::xotcl::Object proc getExitHandler {} {
+    ::xotcl::Object info body __exitHandler
+  }
+  # provide a global handler to avoid a proc on the global object.
+  proc ::xotcl::__exitHandler {} {
+    ::xotcl::Object __exitHandler
+  }
+  ::xotcl::Object instproc abstract {methtype methname arglist} {
+    if {$methtype ne "proc" && $methtype ne "instproc"} {
+      error "invalid method type '$methtype', \
+	must be either 'proc' or 'instproc'."
+    }
+    ::xotcl::my $methtype $methname $arglist "
     if {!\[::xotcl::self isnextcall\]} {
       error \"Abstract method $methname $arglist called\"
     } else {::xotcl::next}
   "
-}
-
-#
-# copy/move implementation 
-#
-::xotcl::Class create ::xotcl::Object::CopyHandler -parameter {
-  {targetList ""}
-  {dest ""}
-  objLength
-}
-
-# targets are all namspaces and objs part-of the copied obj
-::xotcl::Object::CopyHandler instproc makeTargetList t {
-  ::xotcl::my lappend targetList $t
-  # if it is an object without namespace, it is a leaf
-  if {[::xotcl::my isobject $t]} {
-    if {[$t info hasNamespace]} {
-      # make target list from all children
-      set children [$t info children]
-    } else {
-      # ok, no namespace -> no more children 
-      return
-    }
   }
-  # now append all namespaces that are in the obj, but that
-  # are not objects
-  foreach c [namespace children $t] {
-    if {![::xotcl::my isobject $c]} {
-      lappend children [namespace children $t]
-    }
-  }
 
-  # a namespace or an obj with namespace may have children
-  # itself
-  foreach c $children {
-    ::xotcl::my makeTargetList $c
+  #
+  # copy/move implementation 
+  #
+  ::xotcl::Class create ::xotcl::Object::CopyHandler -parameter {
+    {targetList ""}
+    {dest ""}
+    objLength
   }
-}
-
-::xotcl::Object::CopyHandler instproc copyNSVarsAndCmds {orig dest} {
-  ::xotcl::namespace_copyvars $orig $dest
-  ::xotcl::namespace_copycmds $orig $dest
-}
-
-# construct destination obj name from old qualified ns name
-::xotcl::Object::CopyHandler instproc getDest origin {
-  set tail [string range $origin [::xotcl::my set objLength] end]
-  return ::[string trimleft [::xotcl::my set dest]$tail :]
-}
-
-::xotcl::Object::CopyHandler instproc copyTargets {} {
-  #puts stderr "copy targetList = [::xotcl::my set targetList]"
-  foreach origin [::xotcl::my set targetList] {
-    set dest [::xotcl::my getDest $origin]
-    if {[::xotcl::my isobject $origin]} {
-      # copy class information
-      if {[::xotcl::my isclass $origin]} {
-	set cl [[$origin info class] create $dest -noinit]
-	# class object
-	set obj $cl
-	$cl superclass [$origin info superclass]
-	$cl parameterclass [$origin info parameterclass]
-	$cl instinvar [$origin info instinvar]
-	$cl instfilter [$origin info instfilter -guards]
-	$cl instmixin [$origin info instmixin]
-	my copyNSVarsAndCmds ::xotcl::classes::$origin ::xotcl::classes::$dest
-	#$cl parameter [$origin info parameter]
+  
+  # targets are all namspaces and objs part-of the copied obj
+  ::xotcl::Object::CopyHandler instproc makeTargetList t {
+    ::xotcl::my lappend targetList $t
+    # if it is an object without namespace, it is a leaf
+    if {[::xotcl::my isobject $t]} {
+      if {[$t info hasNamespace]} {
+        # make target list from all children
+        set children [$t info children]
       } else {
-	# create obj
-	set obj [[$origin info class] create $dest -noinit]
+        # ok, no namespace -> no more children 
+        return
       }
-      # copy object -> may be a class obj
-      $obj invar [$origin info invar]
-      $obj check [$origin info check]
-      $obj mixin [$origin info mixin]
-      $obj filter [$origin info filter -guards]
-      # set md [$origin info metadata]
-      # $obj metadata add $md
-      # foreach m $md { $obj metadata $m [$origin metadata $m] }
-      if {[$origin info hasNamespace]} {
-	$obj requireNamespace
+    }
+    # now append all namespaces that are in the obj, but that
+    # are not objects
+    foreach c [namespace children $t] {
+      if {![::xotcl::my isobject $c]} {
+        lappend children [namespace children $t]
       }
-    } else {
-      namespace eval $dest {}
     }
-    ::xotcl::my copyNSVarsAndCmds $origin $dest
-    foreach i [$origin info forward] {
-      eval [concat $dest forward $i [$origin info forward -definition $i]]
+    
+    # a namespace or an obj with namespace may have children
+    # itself
+    foreach c $children {
+      ::xotcl::my makeTargetList $c
     }
-    if {[::xotcl::my isclass $origin]} {
-      foreach i [$origin info instforward] {
-        eval [concat $dest instforward $i [$origin info instforward -definition $i]]
+  }
+  
+  ::xotcl::Object::CopyHandler instproc copyNSVarsAndCmds {orig dest} {
+    ::xotcl::namespace_copyvars $orig $dest
+    ::xotcl::namespace_copycmds $orig $dest
+  }
+  
+  # construct destination obj name from old qualified ns name
+  ::xotcl::Object::CopyHandler instproc getDest origin {
+    set tail [string range $origin [::xotcl::my set objLength] end]
+    return ::[string trimleft [::xotcl::my set dest]$tail :]
+  }
+  
+  ::xotcl::Object::CopyHandler instproc copyTargets {} {
+    #puts stderr "copy targetList = [::xotcl::my set targetList]"
+    foreach origin [::xotcl::my set targetList] {
+      set dest [::xotcl::my getDest $origin]
+      if {[::xotcl::my isobject $origin]} {
+        # copy class information
+        if {[::xotcl::my isclass $origin]} {
+          set cl [[$origin info class] create $dest -noinit]
+          # class object
+          set obj $cl
+          $cl superclass [$origin info superclass]
+          #$cl parameterclass [$origin info parameterclass]
+          $cl instinvar [$origin info instinvar]
+          $cl instfilter [$origin info instfilter -guards]
+          $cl instmixin [$origin info instmixin]
+          my copyNSVarsAndCmds ::xotcl::classes::$origin ::xotcl::classes::$dest
+          #$cl parameter [$origin info parameter]
+        } else {
+          # create obj
+          set obj [[$origin info class] create $dest -noinit]
+        }
+        # copy object -> may be a class obj
+        $obj invar [$origin info invar]
+        $obj check [$origin info check]
+        $obj mixin [$origin info mixin]
+        $obj filter [$origin info filter -guards]
+        # set md [$origin info metadata]
+        # $obj metadata add $md
+        # foreach m $md { $obj metadata $m [$origin metadata $m] }
+        if {[$origin info hasNamespace]} {
+          $obj requireNamespace
+        }
+      } else {
+        namespace eval $dest {}
       }
-    }
-    set traces [list]
-    foreach var [$origin info vars] {
-      set cmds [$origin trace info variable $var]
-      if {$cmds ne ""} {
-        foreach cmd $cmds {
-          foreach {op def} $cmd break
-          $origin trace remove variable $var $op $def
-          if {[lindex $def 0] eq $origin} {
-            set def [concat $dest [lrange $def 1 end]]
+      ::xotcl::my copyNSVarsAndCmds $origin $dest
+      foreach i [$origin info forward] {
+        eval [concat $dest forward $i [$origin info forward -definition $i]]
+      }
+      if {[::xotcl::my isclass $origin]} {
+        foreach i [$origin info instforward] {
+          eval [concat $dest instforward $i [$origin info instforward -definition $i]]
+        }
+      }
+      set traces [list]
+      foreach var [$origin info vars] {
+        set cmds [$origin trace info variable $var]
+        if {$cmds ne ""} {
+          foreach cmd $cmds {
+            foreach {op def} $cmd break
+            $origin trace remove variable $var $op $def
+            if {[lindex $def 0] eq $origin} {
+              set def [concat $dest [lrange $def 1 end]]
+            }
+            $dest trace add variable $var $op $def
           }
-          $dest trace add variable $var $op $def
         }
       }
     }
-  }
-  # alter 'domain' and 'manager' in slot objects
-  set origin [lindex [::xotcl::my set targetList] 0]
-  if {[::xotcl::my isclass $origin]} {
-    foreach oldslot [$origin info slots] {
-      set newslot ${cl}::slot::[namespace tail $oldslot]
-      if {[$oldslot domain] eq $origin}   {$newslot domain $cl}
-      if {[$oldslot manager] eq $oldslot} {$newslot manager $newslot}
+    # alter 'domain' and 'manager' in slot objects
+    set origin [lindex [::xotcl::my set targetList] 0]
+    if {[::xotcl::my isclass $origin]} {
+      foreach oldslot [$origin info slots] {
+        set newslot ${cl}::slot::[namespace tail $oldslot]
+        if {[$oldslot domain] eq $origin}   {$newslot domain $cl}
+        if {[$oldslot manager] eq $oldslot} {$newslot manager $newslot}
+      }
     }
   }
-}
-
-::xotcl::Object::CopyHandler instproc copy {obj dest} {
-  #puts stderr "[::xotcl::self] copy <$obj> <$dest>"
-  ::xotcl::my set objLength [string length $obj]
-  ::xotcl::my set dest $dest
-  ::xotcl::my makeTargetList $obj
-  ::xotcl::my copyTargets
-}
-
-#Class create ::xotcl::NoInit
-#::xotcl::NoInit instproc init args {;}
-
-
-::xotcl::Object instproc copy newName {
-  if {[string compare [string trimleft $newName :] [string trimleft [::xotcl::self] :]]} {
-    [[::xotcl::self class]::CopyHandler new -volatile] copy [::xotcl::self] $newName
+  
+  ::xotcl::Object::CopyHandler instproc copy {obj dest} {
+    #puts stderr "[::xotcl::self] copy <$obj> <$dest>"
+    ::xotcl::my set objLength [string length $obj]
+    ::xotcl::my set dest $dest
+    ::xotcl::my makeTargetList $obj
+    ::xotcl::my copyTargets
   }
-}
-
-::xotcl::Object instproc move newName {
-  if {[string trimleft $newName :] ne [string trimleft [::xotcl::self] :]} {
-    if {$newName ne ""} {
-      ::xotcl::my copy $newName
+  
+  #Class create ::xotcl::NoInit
+  #::xotcl::NoInit instproc init args {;}
+  
+  
+  ::xotcl::Object instproc copy newName {
+    if {[string compare [string trimleft $newName :] [string trimleft [::xotcl::self] :]]} {
+      [[::xotcl::self class]::CopyHandler new -volatile] copy [::xotcl::self] $newName
     }
-    ### let all subclasses get the copied class as superclass
-    if {[::xotcl::my isclass [::xotcl::self]] && $newName ne ""} {
-      foreach subclass [::xotcl::my info subclass] {
-	set scl [$subclass info superclass]
-	if {[set index [lsearch -exact $scl [::xotcl::self]]] != -1} {
-	  set scl [lreplace $scl $index $index $newName]
-	  $subclass superclass $scl
-	}
-      }	     
+  }
+  
+  ::xotcl::Object instproc move newName {
+    if {[string trimleft $newName :] ne [string trimleft [::xotcl::self] :]} {
+      if {$newName ne ""} {
+        ::xotcl::my copy $newName
+      }
+      ### let all subclasses get the copied class as superclass
+      if {[::xotcl::my isclass [::xotcl::self]] && $newName ne ""} {
+        foreach subclass [::xotcl::my info subclass] {
+          set scl [$subclass info superclass]
+          if {[set index [lsearch -exact $scl [::xotcl::self]]] != -1} {
+            set scl [lreplace $scl $index $index $newName]
+            $subclass superclass $scl
+          }
+        }	     
+      }
+      ::xotcl::my destroy
     }
-    ::xotcl::my destroy
   }
-}
-
-::xotcl::Object create ::xotcl::config
-::xotcl::config proc load {obj file} {
-  source $file
-  foreach i [array names ::auto_index [list $obj *proc *]] {
-    set type [lindex $i 1]
-    set meth [lindex $i 2]
-    if {[$obj info ${type}s $meth] == {}} {
-      $obj $type $meth auto $::auto_index($i)
+  
+  ::xotcl::Object create ::xotcl::config
+  ::xotcl::config proc load {obj file} {
+    source $file
+    foreach i [array names ::auto_index [list $obj *proc *]] {
+      set type [lindex $i 1]
+      set meth [lindex $i 2]
+      if {[$obj info ${type}s $meth] == {}} {
+        $obj $type $meth auto $::auto_index($i)
+      }
     }
   }
-}
-
-::xotcl::config proc mkindex {meta dir args} {
-  set sp {[ 	]+}
-  set st {^[ 	]*}
-  set wd {([^ 	;]+)}
-  foreach creator $meta {
-    ::lappend cp $st$creator${sp}create$sp$wd
-    ::lappend ap $st$creator$sp$wd
-  }
-  foreach method {proc instproc} {
-    ::lappend mp $st$wd${sp}($method)$sp$wd
-  }
-  foreach cl [concat ::xotcl::Class [::xotcl::Class info heritage]] {
-    eval ::lappend meths [$cl info instcommands]
-  }
-  set old [pwd]
-  cd $dir
-  ::append idx "# Tcl autoload index file, version 2.0\n"
-  ::append idx "# xotcl additions generated with "
-  ::append idx "\"::xotcl::config::mkindex [list $meta] [list $dir] $args\"\n"
-  set oc 0
-  set mc 0
-  foreach file [eval glob -nocomplain -- $args] {
-    if {[catch {set f [open $file]} msg]} then {
-      catch {close $f}
-      cd $old
-      error $msg
+  
+  ::xotcl::config proc mkindex {meta dir args} {
+    set sp {[ 	]+}
+    set st {^[ 	]*}
+    set wd {([^ 	;]+)}
+    foreach creator $meta {
+      ::lappend cp $st$creator${sp}create$sp$wd
+      ::lappend ap $st$creator$sp$wd
     }
-    while {[gets $f line] >= 0} {
-      foreach c $cp {
-	if {[regexp $c $line x obj]==1 &&
-	    [string index $obj 0]!={$}} then {
-	  ::incr oc
-	  ::append idx "set auto_index($obj) "
-	  ::append idx "\"::xotcl::config::load $obj \$dir/$file\"\n"
-	}
+    foreach method {proc instproc} {
+      ::lappend mp $st$wd${sp}($method)$sp$wd
+    }
+    foreach cl [concat ::xotcl::Class [::xotcl::Class info heritage]] {
+      eval ::lappend meths [$cl info instcommands]
+    }
+    set old [pwd]
+    cd $dir
+    ::append idx "# Tcl autoload index file, version 2.0\n"
+    ::append idx "# xotcl additions generated with "
+    ::append idx "\"::xotcl::config::mkindex [list $meta] [list $dir] $args\"\n"
+    set oc 0
+    set mc 0
+    foreach file [eval glob -nocomplain -- $args] {
+      if {[catch {set f [open $file]} msg]} then {
+        catch {close $f}
+        cd $old
+        error $msg
       }
-      foreach a $ap {
-	if {[regexp $a $line x obj]==1 &&
-	    [string index $obj 0]!={$} &&
-	    [lsearch -exact $meths $obj]==-1} {
-	  ::incr oc
-	  ::append idx "set auto_index($obj) "
-	  ::append idx "\"::xotcl::config::load $obj \$dir/$file\"\n"
-	}
+      while {[gets $f line] >= 0} {
+        foreach c $cp {
+          if {[regexp $c $line x obj]==1 &&
+              [string index $obj 0]!={$}} then {
+            ::incr oc
+            ::append idx "set auto_index($obj) "
+            ::append idx "\"::xotcl::config::load $obj \$dir/$file\"\n"
+          }
+        }
+        foreach a $ap {
+          if {[regexp $a $line x obj]==1 &&
+              [string index $obj 0]!={$} &&
+              [lsearch -exact $meths $obj]==-1} {
+            ::incr oc
+            ::append idx "set auto_index($obj) "
+            ::append idx "\"::xotcl::config::load $obj \$dir/$file\"\n"
+          }
+        }
+        foreach m $mp {
+          if {[regexp $m $line x obj ty pr]==1 &&
+              [string index $obj 0]!={$} &&
+              [string index $pr 0]!={$}} then {
+            ::incr mc
+            ::append idx "set \{auto_index($obj "
+            ::append idx "$ty $pr)\} \"source \$dir/$file\"\n"
+          }
+        }
       }
-      foreach m $mp {
-	if {[regexp $m $line x obj ty pr]==1 &&
-	    [string index $obj 0]!={$} &&
-	    [string index $pr 0]!={$}} then {
-	  ::incr mc
-	  ::append idx "set \{auto_index($obj "
-	  ::append idx "$ty $pr)\} \"source \$dir/$file\"\n"
-	}
-      }
+      close $f
     }
-    close $f
+    set t [open tclIndex a+]
+    puts $t $idx nonewline
+    close $t
+    cd $old
+    return "$oc objects, $mc methods"
   }
-  set t [open tclIndex a+]
-  puts $t $idx nonewline
-  close $t
-  cd $old
-  return "$oc objects, $mc methods"
-}
-
-#
-# if cutTheArg not 0, it cut from upvar argsList
-# 
-::xotcl::Object instproc extractConfigureArg {al name {cutTheArg 0}} {
-  set value ""
-  upvar $al argList
-  set largs [llength $argList]
-  for {set i 0} {$i < $largs} {incr i} {
-    if {[lindex $argList $i] == $name && $i + 1 < $largs} {
-      set startIndex $i
-      set endIndex [expr {$i + 1}]
-      while {$endIndex < $largs &&
-	     [string first - [lindex $argList $endIndex]] != 0} {
-	lappend value [lindex $argList $endIndex]
-	incr endIndex
+  
+  #
+  # if cutTheArg not 0, it cut from upvar argsList
+  # 
+  ::xotcl::Object instproc extractConfigureArg {al name {cutTheArg 0}} {
+    set value ""
+    upvar $al argList
+    set largs [llength $argList]
+    for {set i 0} {$i < $largs} {incr i} {
+      if {[lindex $argList $i] == $name && $i + 1 < $largs} {
+        set startIndex $i
+        set endIndex [expr {$i + 1}]
+        while {$endIndex < $largs &&
+               [string first - [lindex $argList $endIndex]] != 0} {
+          lappend value [lindex $argList $endIndex]
+          incr endIndex
+        }
       }
     }
+    if {[info exists startIndex] && $cutTheArg != 0} {
+      set argList [lreplace $argList $startIndex [expr {$endIndex - 1}]]
+    }
+    return $value
   }
-  if {[info exists startIndex] && $cutTheArg != 0} {
-    set argList [lreplace $argList $startIndex [expr {$endIndex - 1}]]
+  
+  ::xotcl::Object create ::xotcl::rcs
+  ::xotcl::rcs proc date string {
+    lreplace [lreplace $string 0 0] end end
+  } 
+  ::xotcl::rcs proc version string {
+    lindex $string 2
+  } 
+  
+  # if HOME is not set, and ~ is resolved, Tcl chokes on that
+  if {![info exists ::env(HOME)]} {set ::env(HOME) /root}
+  set ::xotcl::confdir ~/.xotcl
+  set ::xotcl::logdir $::xotcl::confdir/log
+  
+  ::xotcl::Class proc __unknown name {
+    #unknown $name
   }
-  return $value
-}
-
-::xotcl::Object create ::xotcl::rcs
-::xotcl::rcs proc date string {
-  lreplace [lreplace $string 0 0] end end
-} 
-::xotcl::rcs proc version string {
-  lindex $string 2
-} 
-
-# if HOME is not set, and ~ is resolved, Tcl chokes on that
-if {![info exists ::env(HOME)]} {set ::env(HOME) /root}
-set ::xotcl::confdir ~/.xotcl
-set ::xotcl::logdir $::xotcl::confdir/log
-
-::xotcl::Class proc __unknown name {
-  #unknown $name
-}
-
-#
-# package support
-#
-::xotcl::Class instproc uses list {
-  foreach package $list {
-    ::xotcl::package import -into [self] $package
-    puts stderr "*** using ${package}::* in [self]"
+  
+  #
+  # package support
+  #
+  ::xotcl::Class instproc uses list {
+    foreach package $list {
+      ::xotcl::package import -into [::xotcl::self] $package
+      puts stderr "*** using ${package}::* in [::xotcl::self]"
+    }
   }
-}
-::xotcl::Class create ::xotcl::package -superclass ::xotcl::Class -parameter {
-  provide 
-  {version 1.0} 
-  {autoexport {}}
-  {export {}}
-}
-::xotcl::package proc create {name args} {
-  set nq [namespace qualifiers $name]
-  if {$nq ne "" && ![namespace exists $nq]} {Object create $nq}
-  next
-}
-::xotcl::package proc extend {name args} {
-  my require $name
-  eval $name configure $args
-}
-::xotcl::package instproc contains script {
-  if {[my exists provide]} {
-    package provide [my provide] [my version]
-  } else {
-    package provide [self] [my version]
+  ::xotcl::Class create ::xotcl::package -superclass ::xotcl::Class -parameter {
+    provide 
+    {version 1.0} 
+    {autoexport {}}
+    {export {}}
   }
-  namespace eval [self] {namespace import ::xotcl::*}
-  namespace eval [self] $script
-  foreach e [my export] { 
-    set nq [namespace qualifiers $e]
-    if {$nq ne ""} {
-      namespace eval [self]::$nq [list namespace export [namespace tail $e]]
+  ::xotcl::package proc create {name args} {
+    set nq [namespace qualifiers $name]
+    if {$nq ne "" && ![namespace exists $nq]} {Object create $nq}
+    next
+  }
+  ::xotcl::package proc extend {name args} {
+    my require $name
+    eval $name configure $args
+  }
+  ::xotcl::package instproc contains script {
+    if {[my exists provide]} {
+      package provide [my provide] [my version]
     } else {
-      namespace eval [self] [list namespace export $e] 
+      package provide [::xotcl::self] [::xotcl::my version]
     }
+    namespace eval [::xotcl::self] {namespace import ::xotcl::*}
+    namespace eval [::xotcl::self] $script
+    foreach e [my export] { 
+      set nq [namespace qualifiers $e]
+      if {$nq ne ""} {
+        namespace eval [::xotcl::self]::$nq [list namespace export [namespace tail $e]]
+      } else {
+        namespace eval [::xotcl::self] [list namespace export $e] 
+      }
+    }
+    foreach e [my autoexport] { 
+      namespace eval :: [list namespace import [::xotcl::self]::$e]
+    }
   }
-  foreach e [my autoexport] { 
-    namespace eval :: [list namespace import [self]::$e]
+  ::xotcl::package configure \
+      -set component . \
+      -set verbose 0 \
+      -set packagecmd ::package
+  
+  ::xotcl::package proc unknown args {
+    #puts stderr "unknown: package $args"
+    eval [my set packagecmd] $args
   }
-}
-::xotcl::package configure \
-    -set component . \
-    -set verbose 0 \
-    -set packagecmd ::package
-
-::xotcl::package proc unknown args {
-  #puts stderr "unknown: package $args"
-  eval [my set packagecmd] $args
-}
-::xotcl::package proc verbose value {
-  my set verbose $value
-}
-::xotcl::package proc present args {
-  if {$::tcl_version<8.3} {
-    my instvar loaded
-    switch -exact -- [lindex $args 0] {
-      -exact  {set pkg [lindex $args 1]}
-      default {set pkg [lindex $args 0]}
-    }
-    if {[info exists loaded($pkg)]} {
-      return $loaded($pkg)
+  ::xotcl::package proc verbose value {
+    my set verbose $value
+  }
+  ::xotcl::package proc present args {
+    if {$::tcl_version<8.3} {
+      my instvar loaded
+      switch -exact -- [lindex $args 0] {
+        -exact  {set pkg [lindex $args 1]}
+        default {set pkg [lindex $args 0]}
+      }
+      if {[info exists loaded($pkg)]} {
+        return $loaded($pkg)
+      } else {
+        error "not found"
+      }
     } else {
-      error "not found"
+      eval [my set packagecmd] present $args
     }
-  } else {
-    eval [my set packagecmd] present $args
   }
-}
-::xotcl::package proc import {{-into ::} pkg} {
-  my require $pkg
-  namespace eval $into [subst -nocommands {
-    #puts stderr "*** package import ${pkg}::* into [namespace current]"
-    namespace import ${pkg}::*
-  }]
-  # import subclasses if any
-  foreach e [$pkg export] {
-    set nq [namespace qualifiers $e]
-    if {$nq ne ""} {
-      namespace eval $into$nq [list namespace import ${pkg}::$e]
+  ::xotcl::package proc import {{-into ::} pkg} {
+    my require $pkg
+    namespace eval $into [subst -nocommands {
+      #puts stderr "*** package import ${pkg}::* into [namespace current]"
+      namespace import ${pkg}::*
+    }]
+    # import subclasses if any
+    foreach e [$pkg export] {
+      set nq [namespace qualifiers $e]
+      if {$nq ne ""} {
+        namespace eval $into$nq [list namespace import ${pkg}::$e]
+      }
     }
   }
-}
-::xotcl::package proc require args {
-  #puts "XOTCL package require $args, current=[namespace current]"
-  ::xotcl::my instvar component verbose uses loaded
-  set prevComponent $component
-  if {[catch {set v [eval package present $args]} msg]} {
-    #puts stderr "we have to load $msg"
-    switch -exact -- [lindex $args 0] {
-      -exact  {set pkg [lindex $args 1]}
-      default {set pkg [lindex $args 0]}
+  ::xotcl::package proc require args {
+    #puts "XOTCL package require $args, current=[namespace current]"
+    ::xotcl::my instvar component verbose uses loaded
+    set prevComponent $component
+    if {[catch {set v [eval package present $args]} msg]} {
+      #puts stderr "we have to load $msg"
+      switch -exact -- [lindex $args 0] {
+        -exact  {set pkg [lindex $args 1]}
+        default {set pkg [lindex $args 0]}
+      }
+      set component $pkg
+      lappend uses($prevComponent) $component
+      set v [uplevel \#1 [my set packagecmd] require $args]
+      if {$v ne "" && $verbose} {
+        set path [lindex [::package ifneeded $pkg $v] 1]
+        puts "... $pkg $v loaded from '$path'"
+        set loaded($pkg) $v   ;# loaded stuff needed for Tcl 8.0
+      }
     }
-    set component $pkg
-    lappend uses($prevComponent) $component
-    set v [uplevel \#1 [my set packagecmd] require $args]
-    if {$v ne "" && $verbose} {
-      set path [lindex [::package ifneeded $pkg $v] 1]
-      puts "... $pkg $v loaded from '$path'"
-      set loaded($pkg) $v   ;# loaded stuff needed for Tcl 8.0
-    }
+    set component $prevComponent
+    return $v
   }
-  set component $prevComponent
-  return $v
-}
+ 
 
-::xotcl::Object instproc method {name arguments body} {
-   my proc name $arguments $body				  
-}
-::xotcl::Class instproc method {
-  -per-object:switch name arguments body} {
-
-   if {${per-object}} {
-     my proc $name $arguments $body       
-   } else {
-     my instproc $name $arguments $body  
-   }
-}
-
-# setup a temp directory
-proc ::xotcl::tmpdir {} {
-  foreach e [list TMPDIR TEMP TMP] {
-    if {[info exists ::env($e)] \
-            && [file isdirectory $::env($e)] \
-            && [file writable $::env($e)]} {
-      return $::env($e)
+  #
+  # define method method
+  #
+  ::xotcl::Object instproc method {name arguments body} {
+    my proc name $arguments $body				  
+  }
+  ::xotcl::Class instproc method {
+    -per-object:switch name arguments body} {
+                                             
+    if {${per-object}} {
+      my proc $name $arguments $body       
+    } else {
+      my instproc $name $arguments $body  
     }
   }
-  if {$::tcl_platform(platform) eq "windows"} {
-    foreach d [list "C:\\TEMP" "C:\\TMP" "\\TEMP" "\\TMP"] {
-      if {[file isdirectory $d] && [file writable $d]} {
-        return $d
+
+  # return temp directory
+  proc ::xotcl::tmpdir {} {
+    foreach e [list TMPDIR TEMP TMP] {
+      if {[info exists ::env($e)] \
+              && [file isdirectory $::env($e)] \
+              && [file writable $::env($e)]} {
+        return $::env($e)
       }
     }
+    if {$::tcl_platform(platform) eq "windows"} {
+      foreach d [list "C:\\TEMP" "C:\\TMP" "\\TEMP" "\\TMP"] {
+        if {[file isdirectory $d] && [file writable $d]} {
+          return $d
+        }
+      }
+    }
+    return /tmp
   }
-  return /tmp
-}
+ 
+  unset bootstrap
+}
\ No newline at end of file