namespace eval ::xotcl {
  #
  # By setting the variable bootstrap, we can check later, whether we
  # are in bootstrapping mode
  #
  set bootstrap 1
}

#
# First create the ::xotcl2 object system. 
#

namespace eval xotcl2 {
  namespace path ::xotcl
  ::xotcl::createobjectsystem ::xotcl2::Object ::xotcl2::Class

  # provide the standard command set for ::xotcl2::Object
  foreach cmd [info command ::xotcl::cmd::Object::*] {
    set cmdName [namespace tail $cmd]
    if {$cmdName in [list "instvar"]} continue
    ::xotcl::alias Object $cmdName $cmd 
  }
  
  # provide ::eval as method for ::xotcl2::Object
  ::xotcl::alias Object eval -nonleaf ::eval

  # provide the standard command set for Class
  foreach cmd [info command ::xotcl::cmd::Class::*] {
    set cmdName [namespace tail $cmd]
    ::xotcl::alias Class $cmdName $cmd 
  }

  # set a few aliases as protected
  foreach cmd [list __next cleanup  noinit residualargs uplevel upvar] {
    ::xotcl::methodproperty Object $cmd protected 1
  }
  foreach cmd [list recreate] {
    ::xotcl::methodproperty Class $cmd protected 1
  }
  # TODO: info methods shows finally "slots" and "slot". Wanted?

  # protect some methods against redefinition
  ::xotcl::methodproperty Object destroy redefine-protected true
  ::xotcl::methodproperty Class  alloc   redefine-protected true
  ::xotcl::methodproperty Class  dealloc redefine-protected true
  ::xotcl::methodproperty Class  create  redefine-protected true
  
  # define method "method" for Class and Object
  ::xotcl::method Class method {
    name arguments body -precondition -postcondition
  } {
    set conditions [list]
    if {[info exists precondition]}  {lappend conditions -precondition  $precondition}
    if {[info exists postcondition]} {lappend conditions -postcondition $postcondition}
    ::xotcl::method [::xotcl::current object] $name $arguments $body {*}$conditions
  }

  ::xotcl::method Object method {
    name arguments body -precondition -postcondition
  } {
    set conditions [list]
    if {[info exists precondition]}  {lappend conditions -precondition  $precondition}
    if {[info exists postcondition]} {lappend conditions -postcondition $postcondition}
    ::xotcl::method [::xotcl::current object] -per-object $name $arguments $body {*}$conditions
  }

  # define method modifiers "object", "public" and "protected"
  Class eval {

    # method-modifier for object specific methos
    :method object {what args} {
      if {$what in [list "alias" "attribute" "forward" "method" "setter"]} {
        return [::xotcl::dispatch [::xotcl::current object] ::xotcl::classes::xotcl2::Object::$what {*}$args]
      }
      if {$what in [list "info"]} {
        return [::xotcl2::objectInfo [lindex $args 0] [::xotcl::current object] {*}[lrange $args 1 end]]
      }
      if {$what in [list "filter" "mixin"]} {
        return [:object-$what {*}$args]
      }
      if {$what in [list "filterguard" "mixinguard"]} {
        return [::xotcl::dispatch [::xotcl::current object] ::xotcl::cmd::Object::$what {*}$args]
      }
    }

    # define unknown handler for class
    :method unknown {m args} {
      error "Method '$m' unknown for [::xotcl::current object].\
	Consider '[::xotcl::current object] create $m $args' instead of '[::xotcl::current object] $m $args'"
    }
    # protected is not jet defined
    ::xotcl::methodproperty [::xotcl::current object] unknown protected 1
  }


  Object eval {

    # method modifier "public"
    :method public {args} {
      set p [lsearch -regexp $args {^(method|alias|attribute|forward|setter)$}]
      if {$p == -1} {error "$args is not a method defining method"}
      set r [{*}:$args]
      ::xotcl::methodproperty [::xotcl::current object] $r protected false
      return $r
    }

    # method modifier "protected"
    :method protected {args} {
      set p [lsearch -regexp $args {^(method|alias|attribute|forward|setter)$}]
      if {$p == -1} {error "$args is not a method defining command"}
      set r [{*}:$args]
      ::xotcl::methodproperty [::xotcl::current object] $r [::xotcl::current method] true
      return $r
    }

    # unknown handler for Object
    :protected method unknown {m args} {
      if {![::xotcl::current isnext]} {
        error "[::xotcl::current object]: unable to dispatch method '$m'"
      }
    }
    
    # "init" must exist on Object. per default it is empty.
    :protected method init args {}

    # this method is called on calls to object without a specified method
    :protected method defaultmethod {} {::xotcl::current object}

    # provide a placeholder for the bootup process. The real definition
    # is based on slots, which are not available at this point.
    :protected method objectparameter {} {;}
  }

  # define forward methods
  ::xotcl::forward Object forward ::xotcl::forward %self -per-object
  ::xotcl::forward Class  forward ::xotcl::forward %self

  # The method __unknown is called in cases, where we try to resolve
  # an unkown class. one could define a custom resolver with this name
  # to load the class on the fly. After the call to __unknown, XOTcl
  # tries to resolve the class again. This meachnism is used e.g. by
  # the ::ttrace mechanism for partial loading by Zoran.
  #
  Class protected object method __unknown {name} {}

  # Add alias methods. cmdName for XOTcl method can be added via
  #   [... info method name <methodName>]
  #
  # -nonleaf and -objscope make only sense for c-defined cmds,
  # -objscope implies -nonleaf
  #
  Object public method alias {-nonleaf:switch -objscope:switch methodName cmd} {
    ::xotcl::alias [::xotcl::current object] -per-object $methodName \
        {*}[expr {${objscope} ? "-objscope" : ""}] \
        {*}[expr {${nonleaf} ? "-nonleaf" : ""}] \
        $cmd
  }
  Class public method alias {-nonleaf:switch -objscope:switch methodName cmd} {
    ::xotcl::alias [::xotcl::current object] $methodName \
        {*}[expr {${objscope} ? "-objscope" : ""}] \
        {*}[expr {${nonleaf} ? "-nonleaf" : ""}] \
        $cmd
  }

  # Add setter methods. 
  #  
  Object public method setter {methodName value:optional} {
    if {[info exists value]} {
      ::xotcl::setter [::xotcl::current object] -per-object $methodName $value
    } else {
      ::xotcl::setter [::xotcl::current object] -per-object $methodName
    }
  }
  Class public method setter {methodName value:optional} {
    if {[info exists value]} {
      ::xotcl::setter [::xotcl::current object] $methodName $value
    } else {
      ::xotcl::setter [::xotcl::current object] $methodName
    }
  }

  ########################
  # Info definition
  ########################
  Object create ::xotcl2::objectInfo
  Object create ::xotcl2::classInfo

  #
  # It would be nice to do here "objectInfo configure {alias ..}", but
  # we have no working objectparameter yet due to bootstrapping
  #
  objectInfo eval {
    :alias is ::xotcl::objectproperty

    # info info
    :public method info {obj} {
      set methods [list]
      foreach name [::xotcl::cmd::ObjectInfo::methods [::xotcl::current object]] {
        if {$name eq "unknown"} continue
        lappend methods $name
      }
      return "valid options are: [join [lsort $methods] {, }]"
    }

    :method unknown {method obj args} {
      error "[::xotcl::current object] unknown info option \"$method\"; [$obj info info]"
    }
  }

  classInfo eval {
    :alias is ::xotcl::objectproperty
    :alias classparent ::xotcl::cmd::ObjectInfo::parent
    :alias classchildren ::xotcl::cmd::ObjectInfo::children
    :alias info [::xotcl::cmd::ObjectInfo::method objectInfo name info]
    :alias unknown [::xotcl::cmd::ObjectInfo::method objectInfo name info]
  }

  foreach cmd [info command ::xotcl::cmd::ObjectInfo::*] {
    ::xotcl::alias ::xotcl2::objectInfo [namespace tail $cmd] $cmd
    ::xotcl::alias ::xotcl2::classInfo [namespace tail $cmd] $cmd
  }
  foreach cmd [info command ::xotcl::cmd::ClassInfo::*] {
    set cmdName [namespace tail $cmd]
    if {$cmdName in [list "object-mixin-of" "class-mixin-of"]} continue
    ::xotcl::alias ::xotcl2::classInfo $cmdName $cmd
  }
  unset cmd

  # register method "info" on Object and Class
  Object forward info -onerror ::xotcl::infoError ::xotcl2::objectInfo %1 {%@2 %self}
  Class forward  info -onerror ::xotcl::infoError ::xotcl2::classInfo %1 {%@2 %self}

  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 ""
  }
  
  #
  # definition of "abstract method foo ...."
  #
  Object method abstract {methtype -per-object:switch methname arglist} {
    if {$methtype ne "method"} {
      error "invalid method type '$methtype', must be 'method'"
    }
    set body "
      if {!\[::xotcl::current isnextcall\]} {
        error \"Abstract method $methname $arglist called\"
      } else {::xotcl::next}
    "
    if {${per-object}} {
      :method -per-object $methname $arglist $body
    }  else {
      :method $methname $arglist $body
    }
  }

  #
  # exit handlers
  #
  proc ::xotcl::unsetExitHandler {} {
    proc ::xotcl::__exitHandler {} {
      # clients should append exit handlers to this proc body
    }
  }
  proc ::xotcl::setExitHandler {newbody} {::proc ::xotcl::__exitHandler {} $newbody}
  proc ::xotcl::getExitHandler {} {::info body ::xotcl::__exitHandler}
  # initialize exit handler
  ::xotcl::unsetExitHandler
 
  namespace export Object Class
}


########################################
# Slot definitions
########################################
namespace eval ::xotcl {
  #
  # We are in bootstrap code; we cannot use slots/parameter to define
  # slots, so the code is a little low level. After the defintion of
  # the slots, we can use slot-based code such as "-parameter" or
  # "objectparameter".
  #
  ::xotcl2::Class create ::xotcl::MetaSlot
  ::xotcl::relation ::xotcl::MetaSlot superclass ::xotcl2::Class

  ::xotcl::MetaSlot public method slotName {name baseObject} {
    # Create slot parent object if needed
    set slotParent ${baseObject}::slot
    if {![::xotcl::objectproperty ${slotParent} object]} {
      ::xotcl2::Object create ${slotParent}
    }
    return ${slotParent}::$name
  }

  ::xotcl::MetaSlot method createFromParameterSyntax {target -per-object:switch {-initblock ""} value default:optional} {
    set opts [list]
    set colonPos [string first : $value]
    if {$colonPos == -1} {
      set name $value
    } else {
      set properties [string range $value [expr {$colonPos+1}] end]
      set name [string range $value 0 [expr {$colonPos -1}]]
      foreach property [split $properties ,] {
        if {$property eq "required"} {
          lappend opts -required 1
        } elseif {$property eq "multivalued"} {
          lappend opts -multivalued 1
        } elseif {[string match type=* $property]} {
          set type [string range $property 5 end]
          if {![string match ::* $type]} {set type ::$type}
        } elseif {[string match arg=* $property]} {
          set argument [string range $property 4 end]
          lappend opts -arg $argument
        } else {
          set type $property
        }
      }
    }
    if {[info exists type]} {
      lappend opts -type $type
    }

    if {[info exists default]} {
      lappend opts -default $default
    }
    if {${per-object}} {
      lappend opts -per-object true
      set info ObjectInfo
    } else {
      set info ClassInfo
    }

    :create [:slotName $name $target] {*}$opts $initblock
    return [::xotcl::cmd::${info}::method $target name $name]
  }
  
  # ::xotcl::MetaSlot public method new args {
  #   set slotobject [::xotcl::current callingobject]::slot
  #   if {![::xotcl::objectproperty $slotobject object]} {::xotcls::Object create $slotobject}
  #   eval next -childof $slotobject $args
  # }

  ::xotcl::MetaSlot create ::xotcl::Slot
  ::xotcl::MetaSlot create ::xotcl::ObjectParameterSlot
  ::xotcl::relation ::xotcl::ObjectParameterSlot superclass ::xotcl::Slot

  #
  # create class and object for method parameter slots
  ::xotcl::MetaSlot create ::xotcl::MethodParameterSlot
  ::xotcl::relation ::xotcl::MethodParameterSlot superclass ::xotcl::Slot

  # create an object for dispatching
  ::xotcl::MethodParameterSlot create ::xotcl::methodParameterSlot
  
  # use low level interface for defining slot values. Normally, this is
  # done via slot objects, which are defined later.
  
  proc createBootstrapAttributeSlots {class definitions} {
    foreach att $definitions {
      if {[llength $att]>1} {foreach {att default} $att break}
      set slotObj [::xotcl::ObjectParameterSlot slotName $att $class] 
      ::xotcl::ObjectParameterSlot create $slotObj
      if {[info exists default]} {
        ::xotcl::setvar $slotObj default $default
        unset default
      }
      ::xotcl::setter $class $att
    }
    
    #
    # Perform a second round to set default values for already defined
    # objects.
    #
    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 [::xotcl::cmd::ClassInfo::instances $class] {
          if {![$i exists $att]} {
            if {[string match {*\[*\]*} $default]} {
              set value [::xotcl::dispatch $i -objscope ::eval subst $default]
            } else {
	      set value $default
	    }
            ::xotcl::setvar $i $att $value
          }
        }
        unset default
      }
    }

    #puts stderr "Bootstrapslot for $class calls __invalidateobjectparameter"
    $class __invalidateobjectparameter
  }
  
  
  ############################################
  # Define slots for slots
  ############################################
  createBootstrapAttributeSlots ::xotcl::Slot {
    {name}
    {multivalued false}
    {required false}
    default
    type
  }

  createBootstrapAttributeSlots ::xotcl::ObjectParameterSlot {
    {name "[namespace tail [::xotcl::current object]]"}
    {methodname}
    {domain "[lindex [regexp -inline {^(.*)::slot::[^:]+$} [::xotcl::current object]] 1]"}
    {defaultmethods {get assign}}
    {manager "[::xotcl::current object]"}
    {per-object false}
  }
  # maybe add the following slots at some later time here
  #   initcmd
  #   valuecmd
  #   valuechangedcmd
  
  ::xotcl::alias ::xotcl::ObjectParameterSlot get ::xotcl::setvar
  ::xotcl::alias ::xotcl::ObjectParameterSlot assign ::xotcl::setvar
  
  ::xotcl::ObjectParameterSlot public method add {obj prop value {pos 0}} {
    if {![set :multivalued]} {
      error "Property $prop of [set :domain]->$obj ist not multivalued"
    }
    if {[$obj exists $prop]} {
      ::xotcl::setvar $obj $prop [linsert [::xotcl::setvar $obj $prop] $pos $value]
    } else {
      ::xotcl::setvar $obj $prop [list $value]
    }
  }
  ::xotcl::ObjectParameterSlot public method delete {-nocomplain:switch obj prop value} {
    set old [::xotcl::setvar $obj $prop]
    set p [lsearch -glob $old $value]
    if {$p>-1} {::xotcl::setvar $obj $prop [lreplace $old $p $p]} else {
      error "$value is not a $prop of $obj (valid are: $old)"
    }
  }
  
  ::xotcl::ObjectParameterSlot method unknown {method args} {
    set methods [list]
    foreach m [:info callable] {
      if {[::xotcl2::Object info callable $m] ne ""} continue
      if {[string match __* $m]} continue
      lappend methods $m
    }
    error "Method '$method' unknown for slot [[::xotcl::current object]; valid are: {[lsort $methods]]}"
  }
  
  ::xotcl::ObjectParameterSlot public method destroy {} {
    if {${:domain} ne "" && [::xotcl::objectproperty ${:domain} class]} {
      ${:domain} __invalidateobjectparameter
    }
    next
  }
  
  ::xotcl::ObjectParameterSlot protected method init {args} {
    if {${:domain} eq ""} {
      set :domain [::xotcl::current callingobject]
    }
    if {${:domain} ne ""} {
      if {![info exists :methodname]} {
        set :methodname ${:name}
      }
      if {[::xotcl::objectproperty ${:domain} class]} {
        ${:domain} __invalidateobjectparameter
      } 
      if {${:per-object} && [info exists :default] } {
        ::xotcl::setvar ${:domain} ${:name} ${:default}
      }
      set cl [expr {${:per-object} ? "Object" : "Class"}]
      #puts stderr "Slot [::xotcl::current object] init, forwarder on ${:domain}"
      ::xotcl::forward ${:domain} ${:name} \
          ${:manager} \
          [list %1 [${:manager} defaultmethods]] %self \
          ${:methodname}
    }
  }
  
  #################################################################
  # We have no working objectparameter yet, since it requires a
  # minimal slot infrastructure to build object parameters from
  # slots. The above definitions should be sufficient. We provide the
  # definition here before we refine the slot definitions.
  # 
  # Invalidate previously defined object parameter.
  ::xotcl::MetaSlot __invalidateobjectparameter

  # Provide the a slot based mechanism for building an object
  # configuration interface from slot definitions
  ::xotcl::ObjectParameterSlot method toParameterSyntax {{name:substdefault ${:name}}} {
    set objparamdefinition $name
    set methodparamdefinition ""
    set objopts [list]
    set methodopts [list]
    set type ""
    if {[info exists :required] && ${:required}} {
      lappend objopts required
      lappend methodopts required
    }
    if {[info exists :type]} {
      if {[string match ::* ${:type}]} {
	set type [expr {[::xotcl::objectproperty ${:type} metaclass] ? "class" : "object"}]
        lappend objopts type=${:type}
        lappend methodopts type=${:type}
      } else {
        set type ${:type}
      }
    }
    # TODO: remove multivalued check on relations by handling multivalued
    # not in relation, but in the converters
    if {[info exists :multivalued] && ${:multivalued}} {
      if {!([info exists :type] && ${:type} eq "relation")} {
        lappend objopts multivalued
      } else {
        #puts stderr "ignore multivalued for $name in relation"
      }
    }
    if {[info exists :arg]} {
      set prefix [expr {$type eq "object" || $type eq "class" ? "type" : "arg"}]
      lappend objopts $prefix=${:arg}
      lappend methodopts $prefix=${:arg}
    }
    if {[info exists :default]} {
      set arg ${:default}
      # deactivated for now: || [string first {$} $arg] > -1
      if {[string match {*\[*\]*} $arg]} {
        lappend objopts substdefault
      }
    } elseif {[info exists :initcmd]} {
      set arg ${:initcmd}
      lappend objopts initcmd
    }
    if {[info exists :methodname]} {
      if {${:methodname} ne ${:name}} {
        lappend objopts arg=${:methodname}
        lappend methodopts arg=${:methodname}
        #puts stderr "..... setting arg for methodname: $slot has arg arg=${:methodname}"
      }
    }
    if {$type ne ""} {
      set objopts [linsert $objopts 0 $type]
      set methodopts [linsert $methodopts 0 $type]
    }
    lappend objopts slot=[::xotcl::current object]

    if {[llength $objopts] > 0} {
      append objparamdefinition :[join $objopts ,]
    }
    if {[llength $methodopts] > 0} {
      set methodparamdefinition [join $methodopts ,]
    }
    if {[info exists arg]} {
      lappend objparamdefinition $arg
    }
    #puts stderr "[::xotcl::current method] ${name} returns [list oparam $objparamdefinition mparam $methodparamdefinition]"
    return [list oparam $objparamdefinition mparam $methodparamdefinition]
  }
   
  proc ::xotcl::parametersFromSlots {obj} {
    set parameterdefinitions [list]
    foreach slot [::xotcl2::objectInfo slotobjects $obj] {
      # Skip some slots for xotcl1; 
      # TODO: maybe different parameterFromSlots for xotcl1?
      if {[::xotcl::objectproperty $obj type ::xotcl::Object] && 
          ([$slot name] eq "mixin" || [$slot name] eq "filter")
        } continue
      array set "" [$slot toParameterSyntax]
      lappend parameterdefinitions -$(oparam)
    }
    return $parameterdefinitions
  }
  
  ::xotcl2::Object protected method objectparameter {} {
    #puts stderr "... objectparameter [::xotcl::current object]"
    set parameterdefinitions [::xotcl::parametersFromSlots [::xotcl::current object]]
    if {[::xotcl::objectproperty [::xotcl::current object] class]} {
      lappend parameterdefinitions -parameter:method,optional
    }
    lappend parameterdefinitions \
        -noinit:method,optional,noarg \
        -volatile:method,optional,noarg \
        arg:initcmd,optional
    #puts stderr "*** parameter definition for [::xotcl::current object]: $parameterdefinitions"
    return $parameterdefinitions
  }
  

  ############################################
  #  RelationSlot
  ############################################
  ::xotcl::MetaSlot create ::xotcl::RelationSlot
  createBootstrapAttributeSlots ::xotcl::RelationSlot {
    {multivalued true}
    {type relation}
    {elementtype ::xotcl2::Class}
  }
  ::xotcl::relation ::xotcl::RelationSlot superclass ::xotcl::ObjectParameterSlot
  ::xotcl::alias ::xotcl::RelationSlot assign ::xotcl::relation

  ::xotcl::RelationSlot protected method init {} {
    if {${:type} ne "relation"} {
      error "RelationSlot requires type == \"relation\""
    }
    next
  }
  ::xotcl::RelationSlot protected method delete_value {obj prop old value} {
    if {[string first * $value] > -1 || [string first \[ $value] > -1} {
      # value contains globbing meta characters
      if {${:elementtype} ne "" && ![string match ::* $value]} {
        # prefix glob pattern with ::, since all object names have leading ::
        set value ::$value
      }
      return [lsearch -all -not -glob -inline $old $value]
    } elseif {${:elementtype} ne ""} {
      # value contains no globbing meta characters, but elementtype is given
      if {[string first :: $value] == -1} {
	# get fully qualified name
        if {![::xotcl::objectproperty $value object]} {
          error "$value does not appear to be an object"
        }
        set value [::xotcl::dispatch $value -objscope ::xotcl::current object]
      }
      if {![::xotcl::objectproperty ${:elementtype} class]} {
        error "$value does not appear to be of type ${:elementtype}"
      }
    }
    set p [lsearch -exact $old $value]
    if {$p > -1} {
      return [lreplace $old $p $p]
    } else {
      error "$value is not a $prop of $obj (valid are: $old)"
    }
  }
  
  ::xotcl::RelationSlot public method delete {-nocomplain:switch obj prop value} {
    #puts stderr RelationSlot-delete-[::xotcl::current args]
    $obj $prop [:delete_value $obj $prop [$obj info $prop] $value]
  }
  
  ::xotcl::RelationSlot public method get {obj prop} {
    ::xotcl::relation $obj $prop
  }
  ::xotcl::RelationSlot public method add {obj prop value {pos 0}} {
    if {![set :multivalued]} {
      error "Property $prop of ${:domain}->$obj ist not multivalued"
    }
    set oldSetting [::xotcl::relation $obj $prop]
    # use uplevel to avoid namespace surprises
    uplevel [list ::xotcl::relation $obj $prop [linsert $oldSetting $pos $value]]
  }
  ::xotcl::RelationSlot public method delete {-nocomplain:switch obj prop value} {
    uplevel [list ::xotcl::relation $obj $prop [:delete_value $obj $prop [::xotcl::relation $obj $prop] $value]]
  }
  
  
  ############################################
  # system slots
  ############################################
  proc ::xotcl::register_system_slots {os} {
    ${os}::Object alloc ${os}::Class::slot
    ${os}::Object alloc ${os}::Object::slot
    
    ::xotcl::RelationSlot create ${os}::Class::slot::superclass
    ::xotcl::alias           ${os}::Class::slot::superclass assign ::xotcl::relation
    ::xotcl::RelationSlot create ${os}::Object::slot::class -multivalued false
    ::xotcl::alias           ${os}::Object::slot::class assign ::xotcl::relation
    
    ::xotcl::RelationSlot create ${os}::Object::slot::mixin -methodname object-mixin    
    ::xotcl::RelationSlot create ${os}::Object::slot::filter -elementtype ""
    
    ::xotcl::RelationSlot create ${os}::Class::slot::mixin -methodname class-mixin
    ::xotcl::RelationSlot create ${os}::Class::slot::filter -elementtype "" \
        -methodname filter-mixin
    
    # Create two conveniance slots to allow configuration of 
    # object-slots for classes via object-mixin
    ::xotcl::RelationSlot create ${os}::Class::slot::object-mixin 
    ::xotcl::RelationSlot create ${os}::Class::slot::object-filter -elementtype ""
  }
  ::xotcl::register_system_slots ::xotcl2
  proc ::xotcl::register_system_slots {} {}
  
  ############################################
  # Attribute slots
  ############################################
  ::xotcl::MetaSlot __invalidateobjectparameter
  ::xotcl::MetaSlot create ::xotcl::Attribute -superclass ::xotcl::ObjectParameterSlot
  
  createBootstrapAttributeSlots ::xotcl::Attribute {
    {value_check once}
    incremental
    initcmd
    valuecmd
    valuechangedcmd
    arg
  }

  ::xotcl::Attribute method __default_from_cmd {obj cmd var sub op} {
    #puts "GETVAR [::xotcl::current method] obj=$obj cmd=$cmd, var=$var, op=$op"
    $obj trace remove variable $var $op [list [::xotcl::current object] [::xotcl::current method] $obj $cmd]
    ::xotcl::setvar $obj $var [$obj eval $cmd]
  }
  ::xotcl::Attribute method __value_from_cmd {obj cmd var sub op} {
    #puts "GETVAR [::xotcl::current method] obj=$obj cmd=$cmd, var=$var, op=$op"
    ::xotcl::setvar $obj $var [$obj eval $cmd]
  }
  ::xotcl::Attribute method __value_changed_cmd {obj cmd var sub op} {
    # puts stderr "**************************"
    # puts "valuechanged obj=$obj cmd=$cmd, var=$var, op=$op, ...\n$obj exists $var -> [::xotcl::setvar $obj $var]"
    eval $cmd
  }
  ::xotcl::Attribute protected method init {} {
    next ;# do first ordinary slot initialization
    # there might be already default values registered on the class
    set __initcmd ""
    if {[:exists default]} {
    } elseif [:exists initcmd] {
      append __initcmd ":trace add variable [list ${:name}] read \
	\[list [::xotcl::current object] __default_from_cmd \[::xotcl::current object\] [list [set :initcmd]]\]\n"
    } elseif [:exists valuecmd] {
      append __initcmd ":trace add variable [list ${:name}] read \
	\[list [::xotcl::current object] __value_from_cmd \[::xotcl::current object\] [list [set :valuecmd]]\]"
    }
    array set "" [:toParameterSyntax ${:name}]

    #puts stderr "Attribute.init valueParam for [::xotcl::current object] is $(mparam)"
    if {$(mparam) ne ""} {
      if {[info exists :multivalued] && ${:multivalued}} {
        #puts stderr "adding assign [list obj var value:$(mparam),multivalued] // for [::xotcl::current object] with $(mparam)"
        :method assign [list obj var value:$(mparam),multivalued,slot=[::xotcl::current object]] {::xotcl::setvar $obj $var $value}
        #puts stderr "adding add method for [::xotcl::current object] with value:$(mparam)"
        :method add [list obj prop value:$(mparam),slot=[::xotcl::current object] {pos 0}] {next}
      } else {
        #puts stderr "adding assign [list obj var value:$(mparam)] // for [::xotcl::current object] with $(mparam)"
        :method assign [list obj var value:$(mparam),slot=[::xotcl::current object]] {::xotcl::setvar $obj $var $value}
        #::xotcl::setter ${:domain} ${:name}:$(mparam),slot=[::xotcl::current object]
        #puts stderr "::xotcl::setter ${:domain} ${:name}:$(mparam),slot=[::xotcl::current object]"
      }
    }
    if {[:exists valuechangedcmd]} {
      append __initcmd ":trace add variable [list ${:name}] write \
	\[list [::xotcl::current object] __value_changed_cmd \[::xotcl::current object\] [list [set :valuechangedcmd]]\]"
    }
    if {$__initcmd ne ""} {
      set :initcmd $__initcmd
    }
  }
  
  # mixin class for optimizing slots
  ::xotcl2::Class create ::xotcl::Attribute::Optimizer {
    :method method args  {::xotcl::next; :optimize}
    :method forward args {::xotcl::next; :optimize}
    :protected method init args {::xotcl::next; :optimize}
    :public method optimize {} {
      #puts stderr OPTIMIZER-[info exists :incremental]
      set object [expr {${:per-object} ? {object} : {}}]
      if {${:per-object}} {
        set perObject -per-object
        set infokind Object
      } else {
        set perObject ""
        set infokind Class
      }
      if {[::xotcl::cmd::${infokind}Info::method ${:domain} name ${:name}] ne ""} {
        #puts stderr "RESETTING ${:domain} slot ${:name}"
        ::xotcl::forward ${:domain} {*}$perObject ${:name} \
            ${:manager} \
            [list %1 [${:manager} defaultmethods]] %self \
            ${:methodname}
      }
      #if {[set :multivalued]} return
      if {[info exists :incremental] && ${:incremental}} return
      if {[set :defaultmethods] ne {get assign}} return
      set assignInfo [:info callable -which assign]
      #puts stderr assign=$assignInfo//[lindex $assignInfo {end 0}]
      if {$assignInfo ne "::xotcl::ObjectParameterSlot alias assign ::xotcl::setvar" &&
          [lindex $assignInfo {end 0}] ne "::xotcl::setvar" } return
      if {[:info callable -which get]    ne "::xotcl::ObjectParameterSlot alias get ::xotcl::setvar"} return

      array set "" [:toParameterSyntax ${:name}]
      if {$(mparam) ne ""} {
        set setterParam [lindex $(oparam) 0]
        #puts stderr "setterParam=$setterParam, op=$(oparam)"
      } else {
        set setterParam ${:name}
      }
      ::xotcl::setter ${:domain} {*}$perObject $setterParam
      #puts stderr "::xotcl::setter ${:domain} {*}$perObject $setterParam"
    }
  }
  # register the optimizer per default
  ::xotcl::Attribute mixin add ::xotcl::Attribute::Optimizer

  ############################################
  # Define method "attribute" for convenience
  ############################################
  ::xotcl2::Class method attribute {spec {-slotclass ::xotcl::Attribute} {initblock ""}} {
    $slotclass createFromParameterSyntax [::xotcl::current object] -initblock $initblock {*}$spec
  }
  ::xotcl2::Object method attribute {spec {-slotclass ::xotcl::Attribute} {initblock ""}} {
    $slotclass createFromParameterSyntax [::xotcl::current object] -per-object -initblock $initblock {*}$spec
  }
  ############################################
  # Define method "parameter" for backward 
  # compatibility and convenience
  ############################################
  ::xotcl2::Class public method parameter arglist {
  
    foreach arg $arglist {
      ::xotcl::Attribute createFromParameterSyntax [::xotcl::current object] {*}$arg
    }
    # todo needed?
    ::xotcl::setvar [::xotcl::current object]::slot __parameter $arglist
  }

  ##################################################################
  # now the slots are defined; now we can defines the Objects or 
  # classes with parameters more easily than above.
  ##################################################################

  # remove helper proc
  proc createBootstrapAttributeSlots {} {}

  ##################################################################
  # create user-level converter/checker based on ::xotcl::ls
  ##################################################################

  ::xotcl::Slot method type=hasmixin {name value arg} {
    if {![::xotcl::objectproperty $value hasmixin $arg]} {
      error "expected object with mixin $arg but got \"$value\" for parameter $name"
    }
    return $value
  }

  ::xotcl::Slot method type=baseclass {name value} {
    if {![::xotcl::objectproperty $value baseclass]} {
      error "expected baseclass but got \"$value\" for parameter $name"
    }
    return $value
  }

  ::xotcl::Slot method type=metaclass {name value} {
    if {![::xotcl::objectproperty $value metaclass]} {
      error "expected metaclass but got \"$value\" for parameter $name"
    }
    return $value
  }

}

##################################################################
# 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).
##################################################################

::xotcl2::Class create ::xotcl::ScopedNew -superclass ::xotcl2::Class {
  
  :attribute {withclass ::xotcl2::Object}
  :attribute container

  :protected method init {} {
    :public method new {-childof args} {
      ::xotcl::importvar [::xotcl::current class] {container object} withclass
      if {![::xotcl::objectproperty $object object]} {
        $withclass create $object
      }
      eval ::xotcl::next -childof $object $args
    }
  }
}

##################################################################
# The method 'contains' changes the namespace in which objects with
# realtive names are created.  Therefore, 'contains' provides a
# friendly notation for creating nested object structures. Optionally,
# creating new objects in the specified scope can be turned off.
##################################################################

::xotcl2::Object public method contains {
   {-withnew:boolean true}
   -object
   {-class ::xotcl2::Object}
   cmds
 } {
  if {![info exists object]} {set object [::xotcl::current object]}
  if {![::xotcl::objectproperty $object object]} {$class create $object}
  $object requireNamespace
  if {$withnew} {
    set m [::xotcl::ScopedNew new -volatile \
	       -container $object -withclass $class]
    ::xotcl2::Class mixin add $m end
    # TODO: the following is not pretty; however, contains might build xotcl1 and xotcl2 objects.
    if {[::xotcl::objectproperty ::xotcl::Class class]} {::xotcl::Class instmixin add $m end}
    namespace eval $object $cmds
    ::xotcl2::Class mixin delete $m
    if {[::xotcl::objectproperty ::xotcl::Class class]} {::xotcl::Class instmixin delete $m}
  } else {
    namespace eval $object $cmds
  }
}
::xotcl2::Class forward slots %self contains \
    -object {%::xotcl::dispatch [::xotcl::current object] -objscope ::subst [::xotcl::current object]::slot}

##################################################################
# copy/move implementation
##################################################################

::xotcl2::Class create ::xotcl::CopyHandler {

  :attribute {targetList ""}
  :attribute {dest ""}
  :attribute objLength

  :method makeTargetList {t} {
    lappend :targetList $t
    #puts stderr "COPY makeTargetList $t target= ${:targetList}"
    # if it is an object without namespace, it is a leaf
    if {[::xotcl::objectproperty $t object]} {
      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::objectproperty $c object]} {
        lappend children [namespace children $t]
      }
    }
    
    # a namespace or an obj with namespace may have children
    # itself
    foreach c $children {
      :makeTargetList $c
    }
  }


  :method copyNSVarsAndCmds {orig dest} {
    ::xotcl::namespace_copyvars $orig $dest
    ::xotcl::namespace_copycmds $orig $dest
  }

  # construct destination obj name from old qualified ns name
  :method getDest origin {
    set tail [string range $origin [set :objLength] end]
    return ::[string trimleft [set :dest]$tail :]
  }
  
  :method copyTargets {} {
    #puts stderr "COPY will copy targetList = [set :targetList]"
    foreach origin [set :targetList] {
      set dest [:getDest $origin]
      if {[::xotcl::objectproperty $origin object]} {
        # copy class information
        if {[::xotcl::objectproperty $origin class]} {
          set cl [[$origin info class] create $dest -noinit]
          # class object
          set obj $cl
          $cl superclass [$origin info superclass]
          ::xotcl::assertion $cl class-invar [::xotcl::assertion $origin class-invar]
          ::xotcl::relation $cl class-filter [::xotcl::relation $origin class-filter]
          ::xotcl::relation $cl class-mixin [::xotcl::relation $origin class-mixin]
          :copyNSVarsAndCmds ::xotcl::classes$origin ::xotcl::classes$dest
        } else {
          # create obj
          set obj [[$origin info class] create $dest -noinit]
        }
        # copy object -> may be a class obj
        ::xotcl::assertion $obj check [::xotcl::assertion $origin check]
        ::xotcl::assertion $obj object-invar [::xotcl::assertion $origin object-invar]
        ::xotcl::relation $obj object-filter [::xotcl::relation $origin object-filter]
        ::xotcl::relation $obj object-mixin [::xotcl::relation $origin object-mixin]
        if {[$origin info hasnamespace]} {
          $obj requireNamespace
        }
      } else {
        namespace eval $dest {}
      }
      :copyNSVarsAndCmds $origin $dest
      foreach i [$origin info forward] {
        eval [concat $dest forward $i [$origin info forward -definition $i]]
      }
      if {[::xotcl::objectproperty $origin class]} {
        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 [::xotcl::dispatch $origin -objscope ::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
          }
        }
      }
      #puts stderr "====="
    }
    # alter 'domain' and 'manager' in slot objects for classes
    foreach origin [set :targetList] {
      if {[::xotcl::objectproperty $origin class]} {
        set dest [:getDest $origin]
        foreach oldslot [$origin info slots] {
          set newslot [::xotcl::Slot slotName [namespace tail $oldslot] $dest] 
          if {[$oldslot domain] eq $origin}   {$newslot domain $cl}
          if {[$oldslot manager] eq $oldslot} {$newslot manager $newslot}
        }
      }
    }
  }
  
  :public method copy {obj dest} {
    #puts stderr "[::xotcl::current object] copy <$obj> <$dest>"
    set :objLength [string length $obj]
    set :dest $dest
    :makeTargetList $obj
    :copyTargets
  }
}


::xotcl2::Object public method copy newName {
  if {[string compare [string trimleft $newName :] [string trimleft [::xotcl::current object] :]]} {
    [::xotcl::CopyHandler new -volatile] copy [::xotcl::current object] $newName
  }
}

::xotcl2::Object public method move newName {
  if {[string trimleft $newName :] ne [string trimleft [::xotcl::current object] :]} {
    if {$newName ne ""} {
      :copy $newName
    }
    ### let all subclasses get the copied class as superclass
    if {[::xotcl::objectproperty [::xotcl::current object] class] && $newName ne ""} {
      foreach subclass [:info subclass] {
        set scl [$subclass info superclass]
        if {[set index [lsearch -exact $scl [::xotcl::current object]]] != -1} {
          set scl [lreplace $scl $index $index $newName]
          $subclass superclass $scl
        }
      }	
    }
    :destroy
  }
}

#######################################################
# some utilities
#######################################################

# documentation stub object -> just ignore per default.
# if xoDoc is loaded, documentation will be activated
::xotcl2::Object create ::xotcl::@ {
  :method unknown args {}
}





#######################################################################


# common code for all xotcl versions
namespace eval ::xotcl {

  # export the contents for all xotcl versions
  namespace export @ Attribute current

  # 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
  
  # return platform aware temp directory
  proc 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
  }

  proc use {version} {
    set callingNs [uplevel {namespace current}]
    switch -exact $version {
      xotcl1 {
	package require xotcl1
	#puts stderr "current=[namespace current], ul=[uplevel {namespace current}]"
	if {$callingNs ne "::xotcl"} {uplevel {namespace import -force ::xotcl::*}}
      }
      default {
	if {$callingNs ne "::xotcl"} {uplevel {namespace import -force ::xotcl::*}}
	if {$callingNs ne "::xotcl2"} {uplevel {namespace import -force ::xotcl2::*}}
      }
    }
  }
  unset bootstrap
}