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::*] {
    ::xotcl::alias Object [namespace tail $cmd] $cmd 
  }

  # provide some Tcl-commands as methods for ::xotcl2::Object
  #foreach cmd {array append eval incr lappend set subst unset trace} {
  #  ::xotcl::alias Object $cmd -objscope ::$cmd
  #}

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

  # protect some methods against redefinition
  ::xotcl::methodproperty Object destroy static true
  ::xotcl::methodproperty Class  alloc   static true
  ::xotcl::methodproperty Class  dealloc static true
  ::xotcl::methodproperty Class  create  static true

  Class method unknown {args} {
    puts stderr "use '[self] create $args', not '[self] $args'"
    eval my create $args
  }
  Object method unknown {m args} {
    if {![self isnext]} {
      error "[self]: unable to dispatch method '$m'"
    }
  }

  # "init" must exist on Object. per default it is empty.
  Object method init args {}

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

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

  # 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 __unknwn, XOTcl
  # tries to resolve the class again. This meachnism is used e.g. by
  # the ::ttrace mechanism for partial loading by Zoran.
  Class method -per-object __unknown {name} {
  }

  #
  # TODO: ::xotcl::alias has -per-object after methodName, "method" before it (because auf arguments)
  #
  Object method alias {-per-object:switch methodName -cmd -source-object -source-method -source-per-object:switch} {
    if {[info exists cmd]} {
      set cmd [namespace origin $cmd]
    } elseif {[info exists source-method]} {
      if {![info exists source-object]} {
        set source-object [self]
      } else {
        set source-object [::xotcl::dispatch ${source-object} -objscope ::xotcl::self]
      }
      if {${source-per-object}} {
        set cmd ${source-object}::$methodName
      } else {
        set cmd ::xotcl::classes${source-object}::${source-method}
      }
    }
    if {${per-object} && [::xotcl::is [self] class]} {
      eval ::xotcl::alias [self] $methodName -per-object $cmd
    } else {
      eval ::xotcl::alias [self] $methodName $cmd
    }
  }

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

  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::*] {
    ::xotcl::alias ::xotcl2::classInfo [namespace tail $cmd] $cmd
  }
  unset cmd

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

    .method info {obj} {
      set methods [list]
      foreach name [::xotcl::dispatch [self] ::xotcl::cmd::ObjectInfo::methods [self] -defined] {
        if {$name eq "unknown"} continue
        lappend methods $name
      }
      return "valid options are: [join [lsort $methods] {, }]"
    }
    
    .method unknown {method obj args} {
      error "[::xotcl::self] unknown info option \"$method\"; [$obj info info]"
    }
  }

  ::xotcl::dispatch classInfo -objscope ::eval {
    .alias is -cmd ::xotcl::is
    .alias classparent -cmd ::xotcl::cmd::ObjectInfo::parent
    .alias classchildren -cmd ::xotcl::cmd::ObjectInfo::children
    .alias info -source-object objectInfo -source-per-object -source-method info
    .alias unknown -source-object objectInfo -source-per-object -source-method unknown
  }

  Object instforward info -onerror ::xotcl::infoError ::xotcl2::objectInfo %1 {%@2 %self}
  Class instforward 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::self 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
########################################
#
# We are still 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 method new args {
  set slotobject [::xotcl::self callingobject]::slot
  if {![::xotcl::is $slotobject object]} {::xotcls::Object create $slotobject}
  eval next -childof $slotobject $args
}

::xotcl::MetaSlot create ::xotcl::Slot
# We have no working objectparameter yet. So invalidate MetaSlot to
# avoid caching.
::xotcl::MetaSlot invalidateobjectparameter

#foreach o {::xotcl::MetaSlot ::xotcl2::Slot} {
#  foreach r {object class metaclass} {
#    puts stderr "$o $r=[::xotcl::is $o $r]"
#  }
#}

# Provide the a slot based mechanism for building an object
# configuration interface from slot definitions
proc ::xotcl::parametersFromSlots {obj} {
  set parameterdefinitions [list]
  set slots [::xotcl2::objectInfo slotobjects $obj]
  foreach slot $slots {
    set parameterdefinition "-[namespace tail $slot]"
    set opts [list]

    if {[$slot exists required] && [$slot required]} {
      lappend opts required
    }
    if {[$slot exists type]} {
      lappend opts [$slot type]
    }
    if {[$slot exists default]} {
      set arg [::xotcl::setinstvar $slot default]
      # deactivated for now: || [string first {$} $arg] > -1
      if {[string match {*\[*\]*} $arg]} {
	lappend opts substdefault
      }
    } elseif {[$slot exists initcmd]} {
      set arg [::xotcl::setinstvar $slot initcmd]
      lappend opts initcmd
    }
    if {[llength $opts] > 0} {
      append parameterdefinition :[join $opts ,]
    }
    if {[info exists arg]} {
      lappend parameterdefinition $arg
      unset arg
    }
    lappend parameterdefinitions $parameterdefinition
  }
  return $parameterdefinitions
}

::xotcl2::Object method objectparameter {} {
  set parameterdefinitions [::xotcl::parametersFromSlots [self]]
  if {[::xotcl::is [self] class]} {
    lappend parameterdefinitions -parameter:method,optional
  }
  lappend parameterdefinitions -noinit:method,optional,noarg -volatile:method,optional,noarg arg:initcmd,optional
  # for the time being, use:
  #lappend parameterdefinitions args
  #puts stderr "*** parameter definition for [self]: $parameterdefinitions"
  return $parameterdefinitions
}

#
# create class and object for nonpositional argument processing
::xotcl2::Class create ::xotcl2::ParameterType
foreach cmd [info command ::xotcl::cmd::ParameterType::*] {
  ::xotcl::alias ::xotcl2::ParameterType [namespace tail $cmd] $cmd
}

# create an object for dispatching
::xotcl2::ParameterType create ::xotcl2::parameterType


# 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]} {
    ::xotcl2::Object create ${class}::slot
  }
  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
      # todo: do we really need $class twice?
      foreach i [::xotcl::dispatch $class ::xotcl::cmd::ClassInfo::instances $class] {
	if {![$i exists $att]} {
	  if {[string match {*[*]*} $default]} {
            #set default [$i eval subst $default]
            set default [::xotcl::dispatch $i -objscope ::eval subst $default]
          }
	  ::xotcl::setinstvar $i $att $default
	}
      }
      unset default
    }
  }
  #puts stderr "Bootstrapslot for $class calls invalidateobjectparameter"
  $class invalidateobjectparameter
}


############################################
# 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
}
# 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 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::setinstvar $obj $prop [linsert [::xotcl::setinstvar $obj $prop] $pos $value]
  } else {
    ::xotcl::setinstvar $obj $prop [list $value]
  }
  #[set .domain] invalidateobjectparameter  ;# TODO maybe not needed here
}
::xotcl::Slot method delete {-nocomplain:switch obj prop value} {
  set old [::xotcl::setinstvar $obj $prop]
  set p [lsearch -glob $old $value]
  if {$p>-1} {::xotcl::setinstvar $obj $prop [lreplace $old $p $p]} else {
    error "$value is not a $prop of $obj (valid are: $old)"
  }
}

::xotcl::Slot method unknown {method args} {
  set methods [list]
  foreach m [.info methods] {
    if {[::xotcl2::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]]}"
}

::xotcl::Slot method destroy {} {
  if {${.domain} ne ""} {
    ${.domain} invalidateobjectparameter
  }
  next
}

::xotcl::Slot method init {args} {
  set forwarder [expr {${.per-object} ? "forward" : "instforward"}]
  if {${.domain} eq ""} {
    set .domain [::xotcl::self callingobject]
  }
  if {${.domain} ne ""} {
    ${.domain} invalidateobjectparameter
    ${.domain} $forwarder ${.name} -default [${.manager} defaultmethods] ${.manager} %1 %self %proc
  }
}

############################################
#  InfoSlot
############################################
::xotcl::MetaSlot create ::xotcl::InfoSlot
createBootstrapAttributeSlots ::xotcl::InfoSlot {
  {multivalued true}
  {elementtype ::xotcl2::Class}
}
::xotcl::relation ::xotcl::InfoSlot superclass ::xotcl::Slot
::xotcl::InfoSlot method get {obj prop} {$obj info $prop}
::xotcl::InfoSlot method add {obj prop value {pos 0}} {
  if {![set .multivalued]} {
    error "Property $prop of ${.domain}->$obj ist not multivalued"
  }
  $obj $prop [linsert [$obj info $prop] $pos $value]
}
::xotcl::InfoSlot method delete {-nocomplain:switch obj prop value} {
  set old [$obj info $prop]
  if {[string first * $value] > -1 || [string first \[ $value] > -1} {
    # string contains meta characters
    if {${.elementtype} ne "" && ![string match ::* $value]} {
      # prefix string with ::, since all object names have leading ::
      set value ::$value
    }
    return [$obj $prop [lsearch -all -not -glob -inline $old $value]]
  } elseif {${.elementtype} ne ""} {
    if {[string first :: $value] == -1} {
      if {![::xotcl::is $value object]} {
	error "$value does not appear to be an object"
      }
      set value [$value self]
    }
    if {![::xotcl::is ${.elementtype} class]} {
      error "$value does not appear to be of type ${.elementtype}"
    }
  }
  set p [lsearch -exact $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 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 method add {obj prop value {pos 0}} {
  if {![set .multivalued]} {
    error "Property $prop of ${.domain}->$obj ist not multivalued"
  }
  $obj $prop [linsert [$obj info $prop -guards] $pos $value]
}

############################################
# system slots
############################################
proc ::xotcl::register_system_slots {os} {
  ${os}::Object alloc ${os}::Class::slot
  ${os}::Object alloc ${os}::Object::slot
  
  ::xotcl::InfoSlot create ${os}::Class::slot::superclass -type relation
  ::xotcl::alias           ${os}::Class::slot::superclass assign ::xotcl::relation
  ::xotcl::InfoSlot create ${os}::Object::slot::class -type relation
  ::xotcl::alias           ${os}::Object::slot::class assign ::xotcl::relation

  ::xotcl::InterceptorSlot create ${os}::Object::slot::mixin \
      -type relation
  ::xotcl::InterceptorSlot create ${os}::Object::slot::filter \
      -elementtype "" -type relation
  ::xotcl::InterceptorSlot create ${os}::Class::slot::instmixin \
      -type relation
  ::xotcl::InterceptorSlot create ${os}::Class::slot::instfilter \
      -elementtype "" \
      -type relation
}
::xotcl::register_system_slots ::xotcl2

############################################
# Attribute slots
############################################
::xotcl::MetaSlot invalidateobjectparameter
::xotcl::MetaSlot create ::xotcl::Attribute -superclass ::xotcl::Slot

createBootstrapAttributeSlots ::xotcl::Attribute {
  {value_check once}
  initcmd
  valuecmd
  valuechangedcmd
}

::xotcl::Attribute method __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]
  ::xotcl::setinstvar $obj $var [$obj eval $cmd]
}
::xotcl::Attribute method __value_from_cmd {obj cmd var sub op} {
  #puts "GETVAR [::xotcl::self proc] obj=$obj cmd=$cmd, var=$var, op=$op"
  ::xotcl::setinstvar $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::setinstvar $obj $var]"
  eval $cmd
}
::xotcl::Attribute method 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)]} {
      ::xotcl::setinstvar $obj $var [::xotcl::setinstvar $obj __oldvalue($var)]
    } else {
      $obj unset -nocomplain $var
    }
    error "'$value' is not of type $type"
  }
  if {$keep_old_value} {::xotcl::setinstvar $obj __oldvalue($var) $value}
  #puts "+++ checking single value done"
}

::xotcl::Attribute method check_multiple_values {values predicate type obj var} {
  foreach value $values {
    .check_single_value -keep_old_value false $value $predicate $type $obj $var
  }
  ::xotcl::setinstvar $obj __oldvalue($var) $value
}
::xotcl::Attribute method mk_type_checker {} {
  set __initcmd ""
  if {[.exists type]} {
    if {[::xotcl::is ${.type} class]} {
      set predicate [subst -nocommands {
	[::xotcl::is \$value object] && [::xotcl::is \$value type ${.type}]
      }]
    } elseif {[llength ${.type}]>1} {
      set predicate "\[${.type} \$value\]"
    } else {
      #set predicate "\[string is ${.type} \$value\]"
      set predicate "\[.type=${.type} ${.name} \$value\]"
    }
    #puts stderr predicate=$predicate
    append .valuechangedcmd [subst {
      [expr {${.multivalued} ? ".check_multiple_values" : ".check_single_value"
           }] \[::xotcl::setinstvar \$obj ${.name}\] \
	  {$predicate} [list ${.type}] \$obj ${.name}
    }]
    append __initcmd [subst -nocommands {
      if {[.exists ${.name}]} {set .__oldvalue(${.name}) [set .${.name}]}\n
    }]
  }
  return $__initcmd
}
::xotcl::Attribute 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::self] __default_from_cmd \[::xotcl::self\] [list [set .initcmd]]\]\n"
  } elseif [.exists valuecmd] {
    append __initcmd ".trace add variable [list ${.name}] read \
	\[list [::xotcl::self] __value_from_cmd \[::xotcl::self\] [list [set .valuecmd]]\]"
  }
  #append __initcmd [.mk_type_checker]
  if {[.exists valuechangedcmd]} {
    append __initcmd ".trace add variable [list ${.name}] write \
	\[list [::xotcl::self] __value_changed_cmd \[::xotcl::self\] [list [set .valuechangedcmd]]\]"
  }
  if {$__initcmd ne ""} {
    set .initcmd $__initcmd
  }
}

# mixin class for decativating all value checks in slots
::xotcl2::Class create ::xotcl::Slot::Nocheck {
  .method check_single_value args {;}
  .method check_multiple_values args {;}
  .method mk_type_checker args {return ""}
}
# mixin class for optimizing slots
::xotcl2::Class create ::xotcl::Slot::Optimizer {
  .method proc args    {::xotcl::next; .optimize}
  .method forward args {::xotcl::next; .optimize}
  .method init args    {::xotcl::next; .optimize}
  .method optimize {} {
    #puts stderr "slot optimizer for ${.domain} calls invalidateobjectparameter"
    #${.domain} invalidateobjectparameter
    if {[set .multivalued]} return
    if {[set .defaultmethods] ne {get assign}} return
    if {[.procsearch assign] ne "::xotcl::Slot instcmd assign"} return
    if {[.procsearch get]    ne "::xotcl::Slot instcmd get"} return
    set forwarder [expr {[set .per-object] ? "parametercmd":"instparametercmd"}]
    #puts stderr "**** optimizing       ${.domain} $forwarder ${.name}"
    ${.domain} $forwarder ${.name}
  }
}
# register the optimizer per default
::xotcl::Attribute instmixin add ::xotcl::Slot::Optimizer

##################################################################
# 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
createBootstrapAttributeSlots ::xotcl::ScopedNew {
  {withclass ::xotcl2::Object}
  inobject
}

::xotcl::ScopedNew method init {} {
  .method new {-childof args} {
    ::xotcl::instvar -object [::xotcl::self class] {inobject object} withclass
    if {![::xotcl::is $object 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.
#
::xotcl2::Object method contains {
   {-withnew:boolean true}
   -object
   {-class ::xotcl2::Object}
   cmds
 } {
  if {![info exists object]} {set object [::xotcl::self]}
  if {![::xotcl::is $object object]} {$class create $object}
  $object requireNamespace
  if {$withnew} {
    set m [::xotcl::ScopedNew new \
	       -inobject $object -withclass $class -volatile]
    ::xotcl2::Class instmixin add $m end
    namespace eval $object $cmds
    ::xotcl2::Class instmixin delete $m
  } else {
    namespace eval $object $cmds
  }
}
::xotcl2::Class instforward slots %self contains \
    -object {%::xotcl::dispatch [::xotcl::self] -objscope ::subst [::xotcl::self]::slot}

############################################
# Define method "parameter" for backward 
# compatibility and convenience
############################################
::xotcl2::Class method parameter arglist {
  if {![::xotcl::is [::xotcl::self]::slot object]} {
    ::xotcl2::Object create [::xotcl::self]::slot
  }
  foreach arg $arglist {
    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 $arg without default -> $cmd"
    } elseif {$l == 2} {
      lappend cmd -default [lindex $arg 1]
      eval $cmd
    } elseif {$l == 3 && [lindex $arg 1] eq "-default"} {
      lappend cmd -default [lindex $arg 2]
      eval $cmd
    } else {
      set paramstring [string range $arg [expr {[string length $name]+1}] end]
      if {[string match {[$\[]*} $paramstring]} {
	lappend cmd -default $paramstring
	eval $cmd
	continue
      }

      set po ::xotcl2::Class::Parameter
      puts stderr "deprecated parameter usage '$arg'; use '-slots {Attribute ...}' instead"

      set cl [::xotcl::self]
      ::xotcl::setinstvar $po name $name
      ::xotcl::setinstvar $po cl [::xotcl::self]
      ::eval $po configure [lrange $arg 1 end]

      if {[$po exists extra] || [$po exists setter] ||
	  [$po exists getter] || [$po exists access]} {
	::xotcl::instvar -object $po 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 method $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
	}
      } else {
	.instparametercmd $name
      }
    }
  }
  ::xotcl::setinstvar [::xotcl::self]::slot __parameter $arglist
}

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

#
# copy/move implementation
#
::xotcl2::Class create ::xotcl::CopyHandler -parameter {
  {targetList ""}
  {dest ""}
  objLength
} {
  
  .method makeTargetList {t} {
    lappend .targetList $t
    # if it is an object without namespace, it is a leaf
    if {[::xotcl::is $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::is $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::is $origin object]} {
        # copy class information
        if {[::xotcl::is $origin class]} {
          set cl [[$origin info class] create $dest -noinit]
          # class object
          set obj $cl
          $cl superclass [$origin info superclass]
          $cl instinvar  [$origin info instinvar]
          $cl instfilter [$origin info instfilter -guards]
          $cl instmixin  [$origin info instmixin]
          .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
        $obj invar  [$origin info invar]
        $obj check  [$origin info check]
        $obj mixin  [$origin info mixin]
        $obj filter [$origin info filter -guards]
        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::is $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::is $origin class]} {
        set dest [.getDest $origin]
        foreach oldslot [$origin info slots] {
          set newslot ${dest}::slot::[namespace tail $oldslot]
          if {[$oldslot domain] eq $origin}   {$newslot domain $cl}
          if {[$oldslot manager] eq $oldslot} {$newslot manager $newslot}
        }
      }
    }
  }
  
  .method copy {obj dest} {
    #puts stderr "[::xotcl::self] copy <$obj> <$dest>"
    set .objLength [string length $obj]
    set .dest $dest
    .makeTargetList $obj
    .copyTargets
  }
}

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

::xotcl2::Object method move newName {
  if {[string trimleft $newName :] ne [string trimleft [::xotcl::self] :]} {
    if {$newName ne ""} {
      .copy $newName
    }
    ### let all subclasses get the copied class as superclass
    if {[::xotcl::is [::xotcl::self] class] && $newName ne ""} {
      foreach subclass [.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
        }
      }	
    }
    .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 {}
}




#######################################################
# Classical ::xotcl 1.*
#######################################################
namespace eval ::xotcl {
  #
  # Perform the basic setup of XOTcl 1.x. First, let us allocate the
  # basic classes of XOTcl. This call creates the classes
  # ::xotcl::Object and ::xotcl::Class and defines these as root class
  # of the object system and as root meta class.
  #
  ::xotcl::createobjectsystem ::xotcl::Object ::xotcl::Class

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

  # provide some Tcl-commands as methods for ::xotcl::Object
  foreach cmd {array append eval incr lappend set subst unset trace} {
    ::xotcl::alias Object $cmd -objscope ::$cmd
  }

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

  # protect some methods against redefinition
  ::xotcl::methodproperty Object destroy static true
  ::xotcl::methodproperty Class  alloc   static true
  ::xotcl::methodproperty Class  dealloc static true
  ::xotcl::methodproperty Class  create  static true

  Class method unknown {args} {
    #puts stderr "use '[self] create $args', not '[self] $args'"
    eval my create $args
  }

  Object method unknown {m args} {
    if {![self isnext]} {
      error "[self]: unable to dispatch method '$m'"
    }
  }

  # "init" must exist on Object. per default it is empty.
  Object method init args {}

  Object method self {} {::xotcl::self}

  #
  # object-parameter definition, backwards compatible
  #
  ::xotcl::Object method objectparameter {} {
    set parameterdefinitions [::xotcl::parametersFromSlots [self]]
    lappend parameterdefinitions args
    #puts stderr "*** parameter definition for [self]: $parameterdefinitions"
    return $parameterdefinitions
  }

  #
  # create class and object for nonpositional argument processing
  Class create ::xotcl::ParameterType
  foreach cmd [info command ::xotcl::cmd::ParameterType::*] {
    ::xotcl::alias ::xotcl::ParameterType [namespace tail $cmd] $cmd
  }
  # register type boolean as checker for "switch"
  ::xotcl::alias ::xotcl::ParameterType type=switch ::xotcl::cmd::ParameterType::type=boolean
  # create an object for dispatching
  ::xotcl::ParameterType create ::xotcl::parameterType

  #
  # TODO:
  # - are createBootstrapAttributeSlots for ::xotcl::Class still needed?
  # - Defaults for objectparameter seem more natural.
  # - no definition yet for xotcl2::Class
  #
  
  # 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}
    {__default_metaclass ::xotcl::Class}
  }

  ::xotcl::register_system_slots ::xotcl

  ########################
  # Info definition
  ########################
  Object create ::xotcl::objectInfo
  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
  }
  foreach cmd [::info command ::xotcl::cmd::ClassInfo::*] {
    ::xotcl::alias ::xotcl::classInfo [namespace tail $cmd] $cmd
  }
  unset 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

  # note, we are using ::xotcl::infoError defined earlier
  Object instforward info -onerror ::xotcl::infoError ::xotcl::objectInfo %1 {%@2 %self}
  Class instforward info -onerror ::xotcl::infoError ::xotcl::classInfo %1 {%@2 %self}

  objectInfo method 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] {, }]"
  }
  objectInfo method unknown {method args} {
    error "[::xotcl::self] unknown info option \"$method\"; [.info info]"
  }

  classInfo method 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] {, }]"
  }
  classInfo method unknown {method args} {
    error "[::xotcl::self] unknown info option \"$method\"; [.info info]"
  }

  #
  # Backward compatibility info subcommands;
  #
  # TODO: should go finally into a library.
  #
  # Obsolete methods
  #
  #   already emulated:
  #
  #    => info params .... replaces
  #     info args
  #     info nonposargs
  #     info default
  #
  #    => info instparams .... replaces
  #     info instargs
  #     info instnonposargs
  #     info instdefault
  #
  #   => maybe instead of "info params" and "info instparams"
  #      info params ?-per-object?
  #
  #   => TODO: use "params" in serializer, and all other occurances
  #
  #  TODO: not yet emulated:
  #
  #    => info is (bzw. ::xotcl::is) replaces
  #     isobject
  #     isclass
  #     ismetaclass
  #     ismixin
  #     istype
  #
  #    => method (should get pre- and postconditions via positional params)
  #     proc
  #     instproc
  #
  # TODO mark all absolete calls at least as deprecated in library
  #
  # TODO move unknown handler for Class into a library, make sure that
  # regression test and library function use explicit "creates".
  #

  proc ::xotcl::info_args {inst o method} {
  set result [list]
  foreach \
      argName [::xotcl::classInfo ${inst}params $o $method -varNames] \
      flag    [::xotcl::classInfo ${inst}params $o $method] {
	if {[string match -* $flag]} continue
	lappend result $argName
      }
    #puts stderr "+++ get ${inst}args for $o $method => $result"
    return $result
  }

  proc ::xotcl::info_nonposargs {inst o method} {
    set result [list]
    foreach flag [::xotcl::classInfo ${inst}params $o $method] {
      if {![string match -* $flag]} continue
      lappend result $flag
    }
    #puts stderr "+++ get ${inst}nonposargs for $o $method => $result"
    return $result
  }
  proc ::xotcl::info_default {inst o method arg varName} {
    foreach \
        argName [::xotcl::classInfo ${inst}params $o $method -varNames] \
        flag    [::xotcl::classInfo ${inst}params $o $method] {
          if {$argName eq $arg} {
            upvar 3 $varName default
            if {[llength $flag] == 2} {
              set default [lindex $flag 1]
              #puts stderr "--- get ${inst}default for $o $method $arg => $default"
              return 1
            }
            #puts stderr "--- get ${inst}default for $o $method $arg fails"
            set default ""
            return 0
          }
        }
    error "procedure \"$method\" doesn't have an argument \"$varName\""
  }
  classInfo eval {
    .method instargs {o method} {::xotcl::info_args inst $o $method}
    .method args     {o method} {::xotcl::info_args "" $o $method}
    .method instnonposargs {o method} {::xotcl::info_nonposargs inst $o $method}
    .method nonposargs     {o method} {::xotcl::info_nonposargs "" $o $method}
    .method instdefault {o method arg var} {::xotcl::info_default inst $o $method $arg $var}
    .method default     {o method arg var} {::xotcl::info_default "" $o $method $arg $var}
    .method instprocs   {o pattern:optional} {
      if {[::info exists pattern]} {
        $o info methods -defined -nocmds $pattern
      } {
        $o info methods -defined -nocmds
      }
    }
    .method procs       {o pattern:optional} {
      if {[::info exists pattern]} {
        $o info methods -defined -per-object -nocmds $pattern
      } {
        $o info methods -defined -per-object -nocmds
      }
    }

  }

  objectInfo eval {
    .method args        {o method} {::xotcl::info_args "" $o $method}
    .method nonposargs  {o method} {::xotcl::info_nonposargs "" $o $method}
    .method default     {o method arg var} {::xotcl::info_default "" $o $method $arg $var}
    .method procs       {o pattern:optional} {
      if {[::info exists pattern]} {
        $o info methods -defined -nocmds $pattern
      } {
        $o info methods -defined -nocmds
      }
    }
  }

  # emulation of isobject, ...
  Object method isobject    {{object:substdefault "[self]"}} {::xotcl::is $object object}
  Object method isclass     {{class:substdefault  "[self]"}} {::xotcl::is $class class}
  Object method ismetaclass {{class:substdefault  "[self]"}} {::xotcl::is $class metaclass}
  Object method ismixin     {class}  {::xotcl::is [self] mixin $class}
  Object method istype      {class}  {::xotcl::is [self] type $class}

  ::xotcl::alias ::xotcl::Object contains ::xotcl::classes::xotcl2::Object::contains
  ::xotcl::Class instforward slots %self contains \
      -object {%::xotcl::dispatch [::xotcl::self] -objscope ::subst [::xotcl::self]::slot}
  #
  # define proc and instproc in terms of method
  #
  Object method proc {name arglist body precondition:optional postcondition:optional} {
    set cmd [list my method $name $arglist $body]
    if {[info exists precondition]}  {lappend cmd -precondition  $precondition}
    if {[info exists postcondition]} {lappend cmd -postcondition $postcondition}
    eval $cmd
  }
  Class method proc {name arglist body precondition:optional postcondition:optional} {
    set cmd [list my method -per-object $name $arglist $body]
    if {[info exists precondition]}  {lappend cmd -precondition  $precondition}
    if {[info exists postcondition]} {lappend cmd -postcondition $postcondition}
    eval $cmd
  }
  Class method instproc {name arglist body precondition:optional postcondition:optional} {
    set cmd [list my method $name $arglist $body]
    if {[info exists precondition]}  {lappend cmd -precondition  $precondition}
    if {[info exists postcondition]} {lappend cmd -postcondition $postcondition}
    eval $cmd
  }
  Object method abstract {methtype methname arglist} {
    if {$methtype ne "proc" && $methtype ne "instproc" && $methtype ne "method"} {
      error "invalid method type '$methtype', \
	must be either 'proc', 'instproc' or 'method'."
    }
    .$methtype $methname $arglist "
      if {!\[::xotcl::self isnextcall\]} {
        error \"Abstract method $methname $arglist called\"
      } else {::xotcl::next}
    "
  }

  # support for XOTcl 1.* specific convenience routines
  Object method hasclass cl {
    if {[::xotcl::is [self] mixin $cl]} {return 1}
    ::xotcl::is [self] type $cl
  }
  Class method allinstances {} {
    # TODO: mark it deprecated
    return [.info instances -closure]
  }

  # keep old object interface for xotcl 1.*
  Object method -per-object unsetExitHandler {} {::xotcl::unsetExitHandler $newbody}
  Object method -per-object setExitHandler   {newbody} {::xotcl::setExitHandler $newbody}
  Object method -per-object getExitHandler   {} {:xotcl::getExitHandler}

  # resue some definitions from ::xotcl2
  ::xotcl::alias ::xotcl::Object copy ::xotcl::classes::xotcl2::Object::copy
  ::xotcl::alias ::xotcl::Object move ::xotcl::classes::xotcl2::Object::move
  ::xotcl::alias ::xotcl::Object defaultmethod ::xotcl::classes::xotcl2::Object::defaultmethod

  ::xotcl::alias ::xotcl::Class __unknown -per-object ::xotcl2::Class::__unknown
  ::xotcl::alias ::xotcl::Class parameter ::xotcl::classes::xotcl2::Class::parameter

  proc myproc {args} {linsert $args 0 [::xotcl::self]}
  proc myvar  {var}  {.requireNamespace; return [::xotcl::self]::$var}

  Object create ::xotcl::config
  config method 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)
      }
  }
  }
  
  config method 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 methodkind {proc instproc} {
      ::lappend mp $st$wd${sp}($methodkind)$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
      }
      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"
          }
        }
      }
      close $f
    }
    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
  #
  Object method 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
  }

  Object create ::xotcl::rcs
  rcs method date string {
    lreplace [lreplace $string 0 0] end end
  }
  rcs method version string {
    lindex $string 2
  }

  #
  # package support
  #
  # puts this for the time being into xotcl 1.*
  #
  ::xotcl::Class method uses list {
    foreach package $list {
      ::xotcl::package import -into [::xotcl::self] $package
      puts stderr "*** using ${package}::* in [::xotcl::self]"
    }
  }
  ::xotcl2::Class create ::xotcl::package -superclass ::xotcl::Class -parameter {
    provide
    {version 1.0}
    {autoexport {}}
    {export {}}
  } {
    
    .method -per-object create {name args} {
      set nq [namespace qualifiers $name]
      if {$nq ne "" && ![namespace exists $nq]} {Object create $nq}
      next
    }

    .method -per-object  extend {name args} {
      .require $name
      eval $name configure $args
    }
    
    .method -per-object contains script {
      if {[.exists provide]} {
        package provide [set .provide] [set .version]
      } else {
        package provide [::xotcl::self] [set .version]
      }
      namespace eval [::xotcl::self] {namespace import ::xotcl::*}
      namespace eval [::xotcl::self] $script
      foreach e [set .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 [set .autoexport] {
        namespace eval :: [list namespace import [::xotcl::self]::$e]
      }
    }
    
    .method -per-object unknown args {
      #puts stderr "unknown: package $args"
      eval [set .packagecmd] $args
    }
    
    .method -per-object verbose value {
      set .verbose $value
    }
    
    .method -per-object present args {
      if {$::tcl_version<8.3} {
        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 {
        eval [set .packagecmd] present $args
      }
    }
    
    .method -per-object import {{-into ::} pkg} {
      .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]
        }
      }
    }
    
    .method -per-object require args {
      #puts "XOTCL package require $args, current=[namespace current]"
      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 [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 .
    set .verbose 0
    set .packagecmd ::package
  }
  
  # finally, export contents defined for xotcl 1.*
  namespace export Object Class myproc myvar
}
#######################################################################


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

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

  # 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
  }

  unset bootstrap
}