static char cmd[] = 
"namespace eval ::xotcl {\n"
"set bootstrap 1}\n"
"namespace eval xotcl2 {\n"
"namespace path ::xotcl\n"
"::xotcl::createobjectsystem ::xotcl2::Object ::xotcl2::Class\n"
"foreach cmd [info command ::xotcl::cmd::Object::*] {\n"
"::xotcl::alias Object [namespace tail $cmd] $cmd}\n"
"foreach cmd [info command ::xotcl::cmd::Class::*] {\n"
"::xotcl::alias Class [namespace tail $cmd] $cmd}\n"
"::xotcl::methodproperty Object destroy static true\n"
"::xotcl::methodproperty Class  alloc   static true\n"
"::xotcl::methodproperty Class  dealloc static true\n"
"::xotcl::methodproperty Class  create  static true\n"
"Class method unknown {args} {\n"
"puts stderr \"use '[self] create $args', not '[self] $args'\"\n"
"eval my create $args}\n"
"Object method unknown {m args} {\n"
"if {![self isnext]} {\n"
"error \"[self]: unable to dispatch method '$m'\"}}\n"
"Object method init args {}\n"
"Object method defaultmethod {} {::xotcl::self}\n"
"Object method objectparameter {} {;}\n"
"Class method -per-object __unknown {name} {}\n"
"Object method alias {-per-object:switch methodName -cmd -source-object -source-method -source-per-object:switch} {\n"
"if {[info exists cmd]} {\n"
"set cmd [namespace origin $cmd]} elseif {[info exists source-method]} {\n"
"if {![info exists source-object]} {\n"
"set source-object [self]} else {\n"
"set source-object [::xotcl::dispatch ${source-object} -objscope ::xotcl::self]}\n"
"if {${source-per-object}} {\n"
"set cmd ${source-object}::$methodName} else {\n"
"set cmd ::xotcl::classes${source-object}::${source-method}}}\n"
"if {${per-object} && [::xotcl::is [self] class]} {\n"
"eval ::xotcl::alias [self] $methodName -per-object $cmd} else {\n"
"eval ::xotcl::alias [self] $methodName $cmd}}\n"
"Object create ::xotcl2::objectInfo\n"
"Object create ::xotcl2::classInfo\n"
"foreach cmd [info command ::xotcl::cmd::ObjectInfo::*] {\n"
"::xotcl::alias ::xotcl2::objectInfo [namespace tail $cmd] $cmd\n"
"::xotcl::alias ::xotcl2::classInfo [namespace tail $cmd] $cmd}\n"
"foreach cmd [info command ::xotcl::cmd::ClassInfo::*] {\n"
"::xotcl::alias ::xotcl2::classInfo [namespace tail $cmd] $cmd}\n"
"unset cmd\n"
"::xotcl::dispatch objectInfo -objscope ::eval {\n"
".alias is -cmd ::xotcl::is\n"
".method info {obj} {\n"
"set methods [list]\n"
"foreach name [::xotcl::dispatch [self] ::xotcl::cmd::ObjectInfo::methods [self] -defined] {\n"
"if {$name eq \"unknown\"} continue\n"
"lappend methods $name}\n"
"return \"valid options are: [join [lsort $methods] {, }]\"}\n"
".method unknown {method obj args} {\n"
"error \"[::xotcl::self] unknown info option \\\"$method\\\"; [$obj info info]\"}}\n"
"::xotcl::dispatch classInfo -objscope ::eval {\n"
".alias is -cmd ::xotcl::is\n"
".alias classparent -cmd ::xotcl::cmd::ObjectInfo::parent\n"
".alias classchildren -cmd ::xotcl::cmd::ObjectInfo::children\n"
".alias info -source-object objectInfo -source-per-object -source-method info\n"
".alias unknown -source-object objectInfo -source-per-object -source-method unknown}\n"
"Object instforward info -verbose -onerror ::xotcl::infoError ::xotcl2::objectInfo %1 {%@2 %self}\n"
"Class instforward info -onerror ::xotcl::infoError ::xotcl2::classInfo %1 {%@2 %self}\n"
"proc ::xotcl::infoError msg {\n"
"regsub -all \" <object>\" $msg \"\" msg\n"
"regsub -all \" <class>\" $msg \"\" msg\n"
"regsub {\\\"} $msg \"\\\"info \" msg\n"
"error $msg \"\"}\n"
"Object method abstract {methtype -per-object:switch methname arglist} {\n"
"if {$methtype ne \"method\"} {\n"
"error \"invalid method type '$methtype', must be 'method'\"}\n"
"set body \"\n"
"if {!\\[::xotcl::self isnextcall\\]} {\n"
"error \\\"Abstract method $methname $arglist called\\\"} else {::xotcl::next}\n"
"\"\n"
"if {${per-object}} {\n"
".method -per-object $methname $arglist $body}  else {\n"
".method $methname $arglist $body}}\n"
"proc ::xotcl::unsetExitHandler {} {\n"
"proc ::xotcl::__exitHandler {} {}}\n"
"proc ::xotcl::setExitHandler {newbody} {proc ::xotcl::__exitHandler {} $newbody}\n"
"proc ::xotcl::getExitHandler {} {::info body ::xotcl::__exitHandler}\n"
"::xotcl::unsetExitHandler\n"
"namespace export Object Class}\n"
"::xotcl2::Class create ::xotcl::MetaSlot\n"
"::xotcl::relation ::xotcl::MetaSlot superclass ::xotcl2::Class\n"
"::xotcl::MetaSlot method new args {\n"
"set slotobject [::xotcl::self callingobject]::slot\n"
"if {![::xotcl::is $slotobject object]} {::xotcls::Object create $slotobject}\n"
"eval next -childof $slotobject $args}\n"
"::xotcl::MetaSlot create ::xotcl::Slot\n"
"::xotcl::MetaSlot invalidateobjectparameter\n"
"proc ::xotcl::parametersFromSlots {obj} {\n"
"set parameterdefinitions [list]\n"
"set slots [::xotcl2::objectInfo slotobjects $obj]\n"
"foreach slot $slots {\n"
"set parameterdefinition \"-[namespace tail $slot]\"\n"
"set opts [list]\n"
"if {[$slot exists required] && [$slot required]} {\n"
"lappend opts required}\n"
"if {[$slot exists type]} {\n"
"lappend opts [$slot type]}\n"
"if {[$slot exists default]} {\n"
"set arg [::xotcl::setinstvar $slot default]\n"
"if {[string match {*\\[*\\]*} $arg]} {\n"
"lappend opts substdefault}} elseif {[$slot exists initcmd]} {\n"
"set arg [::xotcl::setinstvar $slot initcmd]\n"
"lappend opts initcmd}\n"
"if {[llength $opts] > 0} {\n"
"append parameterdefinition :[join $opts ,]}\n"
"if {[info exists arg]} {\n"
"lappend parameterdefinition $arg\n"
"unset arg}\n"
"lappend parameterdefinitions $parameterdefinition}\n"
"return $parameterdefinitions}\n"
"::xotcl2::Object method objectparameter {} {\n"
"set parameterdefinitions [::xotcl::parametersFromSlots [self]]\n"
"if {[::xotcl::is [self] class]} {\n"
"lappend parameterdefinitions -parameter:method,optional}\n"
"lappend parameterdefinitions -noinit:method,optional,noarg -volatile:method,optional,noarg arg:initcmd,optional\n"
"return $parameterdefinitions}\n"
"::xotcl2::Class create ::xotcl2::ParameterType\n"
"foreach cmd [info command ::xotcl::cmd::ParameterType::*] {\n"
"::xotcl::alias ::xotcl2::ParameterType [namespace tail $cmd] $cmd}\n"
"::xotcl2::ParameterType create ::xotcl2::parameterType\n"
"proc createBootstrapAttributeSlots {class definitions} {\n"
"if {![::xotcl::is ${class}::slot object]} {\n"
"::xotcl2::Object create ${class}::slot}\n"
"foreach att $definitions {\n"
"if {[llength $att]>1} {foreach {att default} $att break}\n"
"::xotcl::Slot create ${class}::slot::$att\n"
"if {[info exists default]} {\n"
"::xotcl::setinstvar ${class}::slot::$att default $default\n"
"unset default}\n"
"$class instparametercmd $att}\n"
"foreach att $definitions {\n"
"if {[llength $att]>1} {foreach {att default} $att break}\n"
"if {[info exists default]} {\n"
"foreach i [::xotcl::dispatch $class ::xotcl::cmd::ClassInfo::instances $class] {\n"
"if {![$i exists $att]} {\n"
"if {[string match {*[*]*} $default]} {\n"
"set default [::xotcl::dispatch $i -objscope ::eval subst $default]}\n"
"::xotcl::setinstvar $i $att $default}}\n"
"unset default}}\n"
"$class invalidateobjectparameter}\n"
"createBootstrapAttributeSlots ::xotcl::Slot {\n"
"{name \"[namespace tail [::xotcl::self]]\"}\n"
"{domain \"[lindex [regexp -inline {^(.*)::slot::[^:]+$} [::xotcl::self]] 1]\"}\n"
"{defaultmethods {get assign}}\n"
"{manager \"[::xotcl::self]\"}\n"
"{multivalued false}\n"
"{per-object false}\n"
"{required false}\n"
"default\n"
"type}\n"
"::xotcl::alias ::xotcl::Slot get ::xotcl::setinstvar\n"
"::xotcl::alias ::xotcl::Slot assign ::xotcl::setinstvar\n"
"::xotcl::Slot method add {obj prop value {pos 0}} {\n"
"if {![set .multivalued]} {\n"
"error \"Property $prop of [set .domain]->$obj ist not multivalued\"}\n"
"if {[$obj exists $prop]} {\n"
"::xotcl::setinstvar $obj $prop [linsert [::xotcl::setinstvar $obj $prop] $pos $value]} else {\n"
"::xotcl::setinstvar $obj $prop [list $value]}}\n"
"::xotcl::Slot method delete {-nocomplain:switch obj prop value} {\n"
"set old [::xotcl::setinstvar $obj $prop]\n"
"set p [lsearch -glob $old $value]\n"
"if {$p>-1} {::xotcl::setinstvar $obj $prop [lreplace $old $p $p]} else {\n"
"error \"$value is not a $prop of $obj (valid are: $old)\"}}\n"
"::xotcl::Slot method unknown {method args} {\n"
"set methods [list]\n"
"foreach m [.info methods] {\n"
"if {[::xotcl2::Object info methods $m] ne \"\"} continue\n"
"if {[string match __* $m]} continue\n"
"lappend methods $m}\n"
"error \"Method '$method' unknown for slot [::xotcl::self]; valid are: {[lsort $methods]]}\"}\n"
"::xotcl::Slot method destroy {} {\n"
"if {${.domain} ne \"\"} {\n"
"${.domain} invalidateobjectparameter}\n"
"next}\n"
"::xotcl::Slot method init {args} {\n"
"set forwarder [expr {${.per-object} ? \"forward\" : \"instforward\"}]\n"
"if {${.domain} eq \"\"} {\n"
"set .domain [::xotcl::self callingobject]}\n"
"if {${.domain} ne \"\"} {\n"
"${.domain} invalidateobjectparameter\n"
"${.domain} $forwarder ${.name} -default [${.manager} defaultmethods] ${.manager} %1 %self %proc}}\n"
"::xotcl::MetaSlot create ::xotcl::InfoSlot\n"
"createBootstrapAttributeSlots ::xotcl::InfoSlot {\n"
"{multivalued true}\n"
"{elementtype ::xotcl2::Class}}\n"
"::xotcl::relation ::xotcl::InfoSlot superclass ::xotcl::Slot\n"
"::xotcl::InfoSlot method get {obj prop} {$obj info $prop}\n"
"::xotcl::InfoSlot method add {obj prop value {pos 0}} {\n"
"if {![set .multivalued]} {\n"
"error \"Property $prop of ${.domain}->$obj ist not multivalued\"}\n"
"$obj $prop [linsert [$obj info $prop] $pos $value]}\n"
"::xotcl::InfoSlot method delete {-nocomplain:switch obj prop value} {\n"
"set old [$obj info $prop]\n"
"if {[string first * $value] > -1 || [string first \\[ $value] > -1} {\n"
"if {${.elementtype} ne \"\" && ![string match ::* $value]} {\n"
"set value ::$value}\n"
"return [$obj $prop [lsearch -all -not -glob -inline $old $value]]} elseif {${.elementtype} ne \"\"} {\n"
"if {[string first :: $value] == -1} {\n"
"if {![::xotcl::is $value object]} {\n"
"error \"$value does not appear to be an object\"}\n"
"set value [$value self]}\n"
"if {![::xotcl::is ${.elementtype} class]} {\n"
"error \"$value does not appear to be of type ${.elementtype}\"}}\n"
"set p [lsearch -exact $old $value]\n"
"if {$p > -1} {\n"
"$obj $prop [lreplace $old $p $p]} else {\n"
"error \"$value is not a $prop of $obj (valid are: $old)\"}}\n"
"::xotcl::MetaSlot alloc ::xotcl::InterceptorSlot\n"
"::xotcl::relation ::xotcl::InterceptorSlot superclass ::xotcl::InfoSlot\n"
"::xotcl::alias ::xotcl::InterceptorSlot set ::xotcl::relation ;# for backwards compatibility\n"
"::xotcl::alias ::xotcl::InterceptorSlot assign ::xotcl::relation\n"
"::xotcl::InterceptorSlot method add {obj prop value {pos 0}} {\n"
"if {![set .multivalued]} {\n"
"error \"Property $prop of ${.domain}->$obj ist not multivalued\"}\n"
"$obj $prop [linsert [$obj info $prop -guards] $pos $value]}\n"
"proc ::xotcl::register_system_slots {os} {\n"
"${os}::Object alloc ${os}::Class::slot\n"
"${os}::Object alloc ${os}::Object::slot\n"
"::xotcl::InfoSlot create ${os}::Class::slot::superclass -type relation\n"
"::xotcl::alias           ${os}::Class::slot::superclass assign ::xotcl::relation\n"
"::xotcl::InfoSlot create ${os}::Object::slot::class -type relation\n"
"::xotcl::alias           ${os}::Object::slot::class assign ::xotcl::relation\n"
"::xotcl::InterceptorSlot create ${os}::Object::slot::mixin \\\n"
"-type relation\n"
"::xotcl::InterceptorSlot create ${os}::Object::slot::filter \\\n"
"-elementtype \"\" -type relation\n"
"::xotcl::InterceptorSlot create ${os}::Class::slot::instmixin \\\n"
"-type relation\n"
"::xotcl::InterceptorSlot create ${os}::Class::slot::instfilter \\\n"
"-elementtype \"\" \\\n"
"-type relation}\n"
"::xotcl::register_system_slots ::xotcl2\n"
"::xotcl::MetaSlot invalidateobjectparameter\n"
"::xotcl::MetaSlot create ::xotcl::Attribute -superclass ::xotcl::Slot\n"
"createBootstrapAttributeSlots ::xotcl::Attribute {\n"
"{value_check once}\n"
"initcmd\n"
"valuecmd\n"
"valuechangedcmd}\n"
"::xotcl::Attribute method __default_from_cmd {obj cmd var sub op} {\n"
"$obj trace remove variable $var $op [list [::xotcl::self] [::xotcl::self proc] $obj $cmd]\n"
"::xotcl::setinstvar $obj $var [$obj eval $cmd]}\n"
"::xotcl::Attribute method __value_from_cmd {obj cmd var sub op} {\n"
"::xotcl::setinstvar $obj $var [$obj eval $cmd]}\n"
"::xotcl::Attribute method __value_changed_cmd {obj cmd var sub op} {\n"
"eval $cmd}\n"
"::xotcl::Attribute method check_single_value { {-keep_old_value:boolean true} value predicate type obj var} {\n"
"if {![expr $predicate]} {\n"
"if {[$obj exists __oldvalue($var)]} {\n"
"::xotcl::setinstvar $obj $var [::xotcl::setinstvar $obj __oldvalue($var)]} else {\n"
"$obj unset -nocomplain $var}\n"
"error \"'$value' is not of type $type\"}\n"
"if {$keep_old_value} {::xotcl::setinstvar $obj __oldvalue($var) $value}}\n"
"::xotcl::Attribute method check_multiple_values {values predicate type obj var} {\n"
"foreach value $values {\n"
".check_single_value -keep_old_value false $value $predicate $type $obj $var}\n"
"::xotcl::setinstvar $obj __oldvalue($var) $value}\n"
"::xotcl::Attribute method mk_type_checker {} {\n"
"set __initcmd \"\"\n"
"if {[.exists type]} {\n"
"if {[::xotcl::is ${.type} class]} {\n"
"set predicate [subst -nocommands {\n"
"[::xotcl::is \\$value object] && [::xotcl::is \\$value type ${.type}]}]} elseif {[llength ${.type}]>1} {\n"
"set predicate \"\\[${.type} \\$value\\]\"} else {\n"
"set predicate \"\\[.type=${.type} ${.name} \\$value\\]\"}\n"
"append .valuechangedcmd [subst {\n"
"[expr {${.multivalued} ? \".check_multiple_values\" : \".check_single_value\"}] \\[::xotcl::setinstvar \\$obj ${.name}\\] \\\n"
"{$predicate} [list ${.type}] \\$obj ${.name}}]\n"
"append __initcmd [subst -nocommands {\n"
"if {[.exists ${.name}]} {set .__oldvalue(${.name}) [set .${.name}]}\\n}]}\n"
"return $__initcmd}\n"
"::xotcl::Attribute method init {} {\n"
"next ;# do first ordinary slot initialization\n"
"set __initcmd \"\"\n"
"if {[.exists default]} {} elseif [.exists initcmd] {\n"
"append __initcmd \".trace add variable [list ${.name}] read \\\n"
"\\[list [::xotcl::self] __default_from_cmd \\[::xotcl::self\\] [list [set .initcmd]]\\]\\n\"} elseif [.exists valuecmd] {\n"
"append __initcmd \".trace add variable [list ${.name}] read \\\n"
"\\[list [::xotcl::self] __value_from_cmd \\[::xotcl::self\\] [list [set .valuecmd]]\\]\"}\n"
"if {[.exists valuechangedcmd]} {\n"
"append __initcmd \".trace add variable [list ${.name}] write \\\n"
"\\[list [::xotcl::self] __value_changed_cmd \\[::xotcl::self\\] [list [set .valuechangedcmd]]\\]\"}\n"
"if {$__initcmd ne \"\"} {\n"
"set .initcmd $__initcmd}}\n"
"::xotcl2::Class create ::xotcl::Slot::Nocheck {\n"
".method check_single_value args {;}\n"
".method check_multiple_values args {;}\n"
".method mk_type_checker args {return \"\"}}\n"
"::xotcl2::Class create ::xotcl::Slot::Optimizer {\n"
".method proc args    {::xotcl::next; .optimize}\n"
".method forward args {::xotcl::next; .optimize}\n"
".method init args    {::xotcl::next; .optimize}\n"
".method optimize {} {\n"
"if {[set .multivalued]} return\n"
"if {[set .defaultmethods] ne {get assign}} return\n"
"if {[.procsearch assign] ne \"::xotcl::Slot instcmd assign\"} return\n"
"if {[.procsearch get]    ne \"::xotcl::Slot instcmd get\"} return\n"
"set forwarder [expr {[set .per-object] ? \"parametercmd\":\"instparametercmd\"}]\n"
"${.domain} $forwarder ${.name}}}\n"
"::xotcl::Attribute instmixin add ::xotcl::Slot::Optimizer\n"
"::xotcl2::Class create ::xotcl::ScopedNew -superclass ::xotcl2::Class\n"
"createBootstrapAttributeSlots ::xotcl::ScopedNew {\n"
"{withclass ::xotcl2::Object}\n"
"inobject}\n"
"::xotcl::ScopedNew method init {} {\n"
".method new {-childof args} {\n"
"::xotcl::instvar -object [::xotcl::self class] {inobject object} withclass\n"
"if {![::xotcl::is $object object]} {\n"
"$withclass create $object}\n"
"eval ::xotcl::next -childof $object $args}}\n"
"::xotcl2::Object method contains {\n"
"{-withnew:boolean true}\n"
"-object\n"
"{-class ::xotcl2::Object}\n"
"cmds} {\n"
"if {![info exists object]} {set object [::xotcl::self]}\n"
"if {![::xotcl::is $object object]} {$class create $object}\n"
"$object requireNamespace\n"
"if {$withnew} {\n"
"set m [::xotcl::ScopedNew new \\\n"
"-inobject $object -withclass $class -volatile]\n"
"::xotcl2::Class instmixin add $m end\n"
"namespace eval $object $cmds\n"
"::xotcl2::Class instmixin delete $m} else {\n"
"namespace eval $object $cmds}}\n"
"::xotcl2::Class instforward slots %self contains \\\n"
"-object {%::xotcl::dispatch [::xotcl::self] -objscope ::subst [::xotcl::self]::slot}\n"
"::xotcl2::Class method parameter arglist {\n"
"if {![::xotcl::is [::xotcl::self]::slot object]} {\n"
"::xotcl2::Object create [::xotcl::self]::slot}\n"
"foreach arg $arglist {\n"
"set l [llength $arg]\n"
"set name [lindex $arg 0]\n"
"if {[string first : $name] > -1} {\n"
"foreach {name type} [split $name :] break\n"
"if {$type eq \"required\"} {\n"
"set required 1\n"
"unset type}}\n"
"set cmd [list ::xotcl::Attribute create [::xotcl::self]::slot::$name]\n"
"if {[info exists type]} {\n"
"lappend cmd -type $type\n"
"unset type}\n"
"if {[info exists required]} {\n"
"lappend cmd -required 1\n"
"unset required}\n"
"if {$l == 1} {\n"
"eval $cmd} elseif {$l == 2} {\n"
"lappend cmd -default [lindex $arg 1]\n"
"eval $cmd} elseif {$l == 3 && [lindex $arg 1] eq \"-default\"} {\n"
"lappend cmd -default [lindex $arg 2]\n"
"eval $cmd} else {\n"
"set paramstring [string range $arg [expr {[string length $name]+1}] end]\n"
"if {[string match {[$\\[]*} $paramstring]} {\n"
"lappend cmd -default $paramstring\n"
"eval $cmd\n"
"continue}\n"
"set po ::xotcl2::Class::Parameter\n"
"puts stderr \"deprecated parameter usage '$arg'; use '-slots {Attribute ...}' instead\"\n"
"set cl [::xotcl::self]\n"
"::xotcl::setinstvar $po name $name\n"
"::xotcl::setinstvar $po cl [::xotcl::self]\n"
"::eval $po configure [lrange $arg 1 end]\n"
"if {[$po exists extra] || [$po exists setter] ||\n"
"[$po exists getter] || [$po exists access]} {\n"
"::xotcl::instvar -object $po extra setter getter access defaultParam\n"
"if {![info exists extra]} {set extra \"\"}\n"
"if {![info exists defaultParam]} {set defaultParam \"\"}\n"
"if {![info exists setter]} {set setter set}\n"
"if {![info exists getter]} {set getter set}\n"
"if {![info exists access]} {set access ::xotcl::my}\n"
"$cl method $name args \"\n"
"if {\\[llength \\$args] == 0} {\n"
"return \\[$access $getter $extra $name\\]} else {\n"
"return \\[eval $access $setter $extra $name \\$args $defaultParam \\]}\"\n"
"foreach instvar {extra defaultParam setter getter access} {\n"
"$po unset -nocomplain $instvar}} else {\n"
".instparametercmd $name}}}\n"
"::xotcl::setinstvar [::xotcl::self]::slot __parameter $arglist}\n"
"::xotcl2::Class create ::xotcl::CopyHandler -parameter {\n"
"{targetList \"\"}\n"
"{dest \"\"}\n"
"objLength} {\n"
".method makeTargetList {t} {\n"
"lappend .targetList $t\n"
"if {[::xotcl::is $t object]} {\n"
"if {[$t info hasnamespace]} {\n"
"set children [$t info children]} else {\n"
"return}}\n"
"foreach c [namespace children $t] {\n"
"if {![::xotcl::is $c object]} {\n"
"lappend children [namespace children $t]}}\n"
"foreach c $children {\n"
".makeTargetList $c}}\n"
".method copyNSVarsAndCmds {orig dest} {\n"
"::xotcl::namespace_copyvars $orig $dest\n"
"::xotcl::namespace_copycmds $orig $dest}\n"
".method getDest origin {\n"
"set tail [string range $origin [set .objLength] end]\n"
"return ::[string trimleft [set .dest]$tail :]}\n"
".method copyTargets {} {\n"
"foreach origin [set .targetList] {\n"
"set dest [.getDest $origin]\n"
"if {[::xotcl::is $origin object]} {\n"
"if {[::xotcl::is $origin class]} {\n"
"set cl [[$origin info class] create $dest -noinit]\n"
"set obj $cl\n"
"$cl superclass [$origin info superclass]\n"
"$cl instinvar  [$origin info instinvar]\n"
"$cl instfilter [$origin info instfilter -guards]\n"
"$cl instmixin  [$origin info instmixin]\n"
".copyNSVarsAndCmds ::xotcl::classes$origin ::xotcl::classes$dest} else {\n"
"set obj [[$origin info class] create $dest -noinit]}\n"
"$obj invar  [$origin info invar]\n"
"$obj check  [$origin info check]\n"
"$obj mixin  [$origin info mixin]\n"
"$obj filter [$origin info filter -guards]\n"
"if {[$origin info hasnamespace]} {\n"
"$obj requireNamespace}} else {\n"
"namespace eval $dest {}}\n"
".copyNSVarsAndCmds $origin $dest\n"
"foreach i [$origin info forward] {\n"
"eval [concat $dest forward $i [$origin info forward -definition $i]]}\n"
"if {[::xotcl::is $origin class]} {\n"
"foreach i [$origin info instforward] {\n"
"eval [concat $dest instforward $i [$origin info instforward -definition $i]]}}\n"
"set traces [list]\n"
"foreach var [$origin info vars] {\n"
"set cmds [::xotcl::dispatch $origin -objscope ::trace info variable $var]\n"
"if {$cmds ne \"\"} {\n"
"foreach cmd $cmds {\n"
"foreach {op def} $cmd break\n"
"if {[lindex $def 0] eq $origin} {\n"
"set def [concat $dest [lrange $def 1 end]]}\n"
"$dest trace add variable $var $op $def}}}}\n"
"foreach origin [set .targetList] {\n"
"if {[::xotcl::is $origin class]} {\n"
"set dest [.getDest $origin]\n"
"foreach oldslot [$origin info slots] {\n"
"set newslot ${dest}::slot::[namespace tail $oldslot]\n"
"if {[$oldslot domain] eq $origin}   {$newslot domain $cl}\n"
"if {[$oldslot manager] eq $oldslot} {$newslot manager $newslot}}}}}\n"
".method copy {obj dest} {\n"
"set .objLength [string length $obj]\n"
"set .dest $dest\n"
".makeTargetList $obj\n"
".copyTargets}}\n"
"::xotcl2::Object method copy newName {\n"
"if {[string compare [string trimleft $newName :] [string trimleft [::xotcl::self] :]]} {\n"
"[::xotcl::CopyHandler new -volatile] copy [::xotcl::self] $newName}}\n"
"::xotcl2::Object method move newName {\n"
"if {[string trimleft $newName :] ne [string trimleft [::xotcl::self] :]} {\n"
"if {$newName ne \"\"} {\n"
".copy $newName}\n"
"if {[::xotcl::is [::xotcl::self] class] && $newName ne \"\"} {\n"
"foreach subclass [.info subclass] {\n"
"set scl [$subclass info superclass]\n"
"if {[set index [lsearch -exact $scl [::xotcl::self]]] != -1} {\n"
"set scl [lreplace $scl $index $index $newName]\n"
"$subclass superclass $scl}}	}\n"
".destroy}}\n"
"::xotcl2::Object create ::xotcl::@ {\n"
".method unknown args {}}\n"
"namespace eval ::xotcl {\n"
"::xotcl::createobjectsystem ::xotcl::Object ::xotcl::Class\n"
"foreach cmd [info command ::xotcl::cmd::Object::*] {\n"
"::xotcl::alias Object [namespace tail $cmd] $cmd}\n"
"foreach cmd {array append eval incr lappend set subst unset trace} {\n"
"::xotcl::alias Object $cmd -objscope ::$cmd}\n"
"foreach cmd [info command ::xotcl::cmd::Class::*] {\n"
"::xotcl::alias Class [namespace tail $cmd] $cmd}\n"
"unset cmd\n"
"::xotcl::methodproperty Object destroy static true\n"
"::xotcl::methodproperty Class  alloc   static true\n"
"::xotcl::methodproperty Class  dealloc static true\n"
"::xotcl::methodproperty Class  create  static true\n"
"Class method unknown {args} {\n"
"eval my create $args}\n"
"Object method unknown {m args} {\n"
"if {![self isnext]} {\n"
"error \"[self]: unable to dispatch method '$m'\"}}\n"
"Object method init args {}\n"
"Object method self {} {::xotcl::self}\n"
"::xotcl::Object method objectparameter {} {\n"
"set parameterdefinitions [::xotcl::parametersFromSlots [self]]\n"
"lappend parameterdefinitions args\n"
"return $parameterdefinitions}\n"
"Class create ::xotcl::ParameterType\n"
"foreach cmd [info command ::xotcl::cmd::ParameterType::*] {\n"
"::xotcl::alias ::xotcl::ParameterType [namespace tail $cmd] $cmd}\n"
"::xotcl::alias ::xotcl::ParameterType type=switch ::xotcl::cmd::ParameterType::type=boolean\n"
"::xotcl::ParameterType create ::xotcl::parameterType\n"
"createBootstrapAttributeSlots ::xotcl::Class {\n"
"{__default_superclass ::xotcl::Object}\n"
"{__default_metaclass ::xotcl::Class}}\n"
"::xotcl::register_system_slots ::xotcl\n"
"Object create ::xotcl::objectInfo\n"
"Object create ::xotcl::classInfo\n"
"foreach cmd [::info command ::xotcl::cmd::ObjectInfo::*] {\n"
"::xotcl::alias ::xotcl::objectInfo [namespace tail $cmd] $cmd\n"
"::xotcl::alias ::xotcl::classInfo [namespace tail $cmd] $cmd}\n"
"foreach cmd [::info command ::xotcl::cmd::ClassInfo::*] {\n"
"::xotcl::alias ::xotcl::classInfo [namespace tail $cmd] $cmd}\n"
"unset cmd\n"
"::xotcl::alias ::xotcl::objectInfo is ::xotcl::is\n"
"::xotcl::alias ::xotcl::classInfo is ::xotcl::is\n"
"::xotcl::alias ::xotcl::classInfo classparent ::xotcl::cmd::ObjectInfo::parent\n"
"::xotcl::alias ::xotcl::classInfo classchildren ::xotcl::cmd::ObjectInfo::children\n"
"Object instforward info -onerror ::xotcl::infoError ::xotcl::objectInfo %1 {%@2 %self}\n"
"Class instforward info -onerror ::xotcl::infoError ::xotcl::classInfo %1 {%@2 %self}\n"
"objectInfo method info {obj} {\n"
"set methods [list]\n"
"foreach m [::info commands ::xotcl::objectInfo::*] {\n"
"set name [namespace tail $m]\n"
"if {$name eq \"unknown\"} continue\n"
"lappend methods $name}\n"
"return \"valid options are: [join [lsort $methods] {, }]\"}\n"
"objectInfo method unknown {method args} {\n"
"error \"[::xotcl::self] unknown info option \\\"$method\\\"; [.info info]\"}\n"
"classInfo method info {cl} {\n"
"set methods [list]\n"
"foreach m [::info commands ::xotcl::classInfo::*] {\n"
"set name [namespace tail $m]\n"
"if {$name eq \"unknown\"} continue\n"
"lappend methods $name}\n"
"return \"valid options are: [join [lsort $methods] {, }]\"}\n"
"classInfo method unknown {method args} {\n"
"error \"[::xotcl::self] unknown info option \\\"$method\\\"; [.info info]\"}\n"
"#     info instargs\n"
"#     istype\n"
"proc ::xotcl::info_args {inst o method} {\n"
"set result [list]\n"
"foreach \\\n"
"argName [::xotcl::classInfo ${inst}params $o $method -varNames] \\\n"
"flag    [::xotcl::classInfo ${inst}params $o $method] {\n"
"if {[string match -* $flag]} continue\n"
"lappend result $argName}\n"
"return $result}\n"
"proc ::xotcl::info_nonposargs {inst o method} {\n"
"set result [list]\n"
"foreach flag [::xotcl::classInfo ${inst}params $o $method] {\n"
"if {![string match -* $flag]} continue\n"
"lappend result $flag}\n"
"return $result}\n"
"proc ::xotcl::info_default {inst o method arg varName} {\n"
"foreach \\\n"
"argName [::xotcl::classInfo ${inst}params $o $method -varNames] \\\n"
"flag    [::xotcl::classInfo ${inst}params $o $method] {\n"
"if {$argName eq $arg} {\n"
"upvar 3 $varName default\n"
"if {[llength $flag] == 2} {\n"
"set default [lindex $flag 1]\n"
"return 1}\n"
"set default \"\"\n"
"return 0}}\n"
"error \"procedure \\\"$method\\\" doesn't have an argument \\\"$varName\\\"\"}\n"
"classInfo eval {\n"
".method instargs {o method} {::xotcl::info_args inst $o $method}\n"
".method args     {o method} {::xotcl::info_args \"\" $o $method}\n"
".method instnonposargs {o method} {::xotcl::info_nonposargs inst $o $method}\n"
".method nonposargs     {o method} {::xotcl::info_nonposargs \"\" $o $method}\n"
".method instdefault {o method arg var} {::xotcl::info_default inst $o $method $arg $var}\n"
".method default     {o method arg var} {::xotcl::info_default \"\" $o $method $arg $var}\n"
".method instprocs   {o pattern:optional} {\n"
"if {[::info exists pattern]} {\n"
"$o info methods -defined -nocmds $pattern} {\n"
"$o info methods -defined -nocmds}}\n"
".method procs       {o pattern:optional} {\n"
"if {[::info exists pattern]} {\n"
"$o info methods -defined -per-object -nocmds $pattern} {\n"
"$o info methods -defined -per-object -nocmds}}}\n"
"objectInfo eval {\n"
".method args        {o method} {::xotcl::info_args \"\" $o $method}\n"
".method nonposargs  {o method} {::xotcl::info_nonposargs \"\" $o $method}\n"
".method default     {o method arg var} {::xotcl::info_default \"\" $o $method $arg $var}\n"
".method procs       {o pattern:optional} {\n"
"if {[::info exists pattern]} {\n"
"$o info methods -defined -nocmds $pattern} {\n"
"$o info methods -defined -nocmds}}}\n"
"Object method isobject    {{object:substdefault \"[self]\"}} {::xotcl::is $object object}\n"
"Object method isclass     {{class:substdefault  \"[self]\"}} {::xotcl::is $class class}\n"
"Object method ismetaclass {{class:substdefault  \"[self]\"}} {::xotcl::is $class metaclass}\n"
"Object method ismixin     {class}  {::xotcl::is [self] mixin $class}\n"
"Object method istype      {class}  {::xotcl::is [self] type $class}\n"
"::xotcl::alias ::xotcl::Object contains ::xotcl::classes::xotcl2::Object::contains\n"
"::xotcl::Class instforward slots %self contains \\\n"
"-object {%::xotcl::dispatch [::xotcl::self] -objscope ::subst [::xotcl::self]::slot}\n"
"Object method proc {name arglist body precondition:optional postcondition:optional} {\n"
"set cmd [list my method $name $arglist $body]\n"
"if {[info exists precondition]}  {lappend cmd -precondition  $precondition}\n"
"if {[info exists postcondition]} {lappend cmd -postcondition $postcondition}\n"
"eval $cmd}\n"
"Class method proc {name arglist body precondition:optional postcondition:optional} {\n"
"set cmd [list my method -per-object $name $arglist $body]\n"
"if {[info exists precondition]}  {lappend cmd -precondition  $precondition}\n"
"if {[info exists postcondition]} {lappend cmd -postcondition $postcondition}\n"
"eval $cmd}\n"
"Class method instproc {name arglist body precondition:optional postcondition:optional} {\n"
"set cmd [list my method $name $arglist $body]\n"
"if {[info exists precondition]}  {lappend cmd -precondition  $precondition}\n"
"if {[info exists postcondition]} {lappend cmd -postcondition $postcondition}\n"
"eval $cmd}\n"
"Object method abstract {methtype methname arglist} {\n"
"if {$methtype ne \"proc\" && $methtype ne \"instproc\" && $methtype ne \"method\"} {\n"
"error \"invalid method type '$methtype', \\\n"
"must be either 'proc', 'instproc' or 'method'.\"}\n"
".$methtype $methname $arglist \"\n"
"if {!\\[::xotcl::self isnextcall\\]} {\n"
"error \\\"Abstract method $methname $arglist called\\\"} else {::xotcl::next}\n"
"\"}\n"
"Object method hasclass cl {\n"
"if {[::xotcl::is [self] mixin $cl]} {return 1}\n"
"::xotcl::is [self] type $cl}\n"
"Class method allinstances {} {\n"
"return [.info instances -closure]}\n"
"Object method -per-object unsetExitHandler {} {::xotcl::unsetExitHandler $newbody}\n"
"Object method -per-object setExitHandler   {newbody} {::xotcl::setExitHandler $newbody}\n"
"Object method -per-object getExitHandler   {} {:xotcl::getExitHandler}\n"
"::xotcl::alias ::xotcl::Object copy ::xotcl::classes::xotcl2::Object::copy\n"
"::xotcl::alias ::xotcl::Object move ::xotcl::classes::xotcl2::Object::move\n"
"::xotcl::alias ::xotcl::Object defaultmethod ::xotcl::classes::xotcl2::Object::defaultmethod\n"
"::xotcl::alias ::xotcl::Class __unknown -per-object ::xotcl2::Class::__unknown\n"
"::xotcl::alias ::xotcl::Class parameter ::xotcl::classes::xotcl2::Class::parameter\n"
"proc myproc {args} {linsert $args 0 [::xotcl::self]}\n"
"proc myvar  {var}  {.requireNamespace; return [::xotcl::self]::$var}\n"
"Object create ::xotcl::config\n"
"config method load {obj file} {\n"
"source $file\n"
"foreach i [array names ::auto_index [list $obj *proc *]] {\n"
"set type [lindex $i 1]\n"
"set meth [lindex $i 2]\n"
"if {[$obj info ${type}s $meth] == {}} {\n"
"$obj $type $meth auto $::auto_index($i)}}}\n"
"config method mkindex {meta dir args} {\n"
"set sp {[ 	]+}\n"
"set st {^[ 	]*}\n"
"set wd {([^ 	;]+)}\n"
"foreach creator $meta {\n"
"::lappend cp $st$creator${sp}create$sp$wd\n"
"::lappend ap $st$creator$sp$wd}\n"
"foreach methodkind {proc instproc} {\n"
"::lappend mp $st$wd${sp}($methodkind)$sp$wd}\n"
"foreach cl [concat ::xotcl::Class [::xotcl::Class info heritage]] {\n"
"eval ::lappend meths [$cl info instcommands]}\n"
"set old [pwd]\n"
"cd $dir\n"
"::append idx \"# Tcl autoload index file, version 2.0\\n\"\n"
"::append idx \"# xotcl additions generated with \"\n"
"::append idx \"\\\"::xotcl::config::mkindex [list $meta] [list $dir] $args\\\"\\n\"\n"
"set oc 0\n"
"set mc 0\n"
"foreach file [eval glob -nocomplain -- $args] {\n"
"if {[catch {set f [open $file]} msg]} then {\n"
"catch {close $f}\n"
"cd $old\n"
"error $msg}\n"
"while {[gets $f line] >= 0} {\n"
"foreach c $cp {\n"
"if {[regexp $c $line x obj]==1 &&\n"
"[string index $obj 0]!={$}} then {\n"
"::incr oc\n"
"::append idx \"set auto_index($obj) \"\n"
"::append idx \"\\\"::xotcl::config::load $obj \\$dir/$file\\\"\\n\"}}\n"
"foreach a $ap {\n"
"if {[regexp $a $line x obj]==1 &&\n"
"[string index $obj 0]!={$} &&\n"
"[lsearch -exact $meths $obj]==-1} {\n"
"::incr oc\n"
"::append idx \"set auto_index($obj) \"\n"
"::append idx \"\\\"::xotcl::config::load $obj \\$dir/$file\\\"\\n\"}}\n"
"foreach m $mp {\n"
"if {[regexp $m $line x obj ty pr]==1 &&\n"
"[string index $obj 0]!={$} &&\n"
"[string index $pr 0]!={$}} then {\n"
"::incr mc\n"
"::append idx \"set \\{auto_index($obj \"\n"
"::append idx \"$ty $pr)\\} \\\"source \\$dir/$file\\\"\\n\"}}}\n"
"close $f}\n"
"set t [open tclIndex a+]\n"
"puts $t $idx nonewline\n"
"close $t\n"
"cd $old\n"
"return \"$oc objects, $mc methods\"}\n"
"Object method extractConfigureArg {al name {cutTheArg 0}} {\n"
"set value \"\"\n"
"upvar $al argList\n"
"set largs [llength $argList]\n"
"for {set i 0} {$i < $largs} {incr i} {\n"
"if {[lindex $argList $i] == $name && $i + 1 < $largs} {\n"
"set startIndex $i\n"
"set endIndex [expr {$i + 1}]\n"
"while {$endIndex < $largs &&\n"
"[string first - [lindex $argList $endIndex]] != 0} {\n"
"lappend value [lindex $argList $endIndex]\n"
"incr endIndex}}}\n"
"if {[info exists startIndex] && $cutTheArg != 0} {\n"
"set argList [lreplace $argList $startIndex [expr {$endIndex - 1}]]}\n"
"return $value}\n"
"Object create ::xotcl::rcs\n"
"rcs method date string {\n"
"lreplace [lreplace $string 0 0] end end}\n"
"rcs method version string {\n"
"lindex $string 2}\n"
"::xotcl::Class method uses list {\n"
"foreach package $list {\n"
"::xotcl::package import -into [::xotcl::self] $package\n"
"puts stderr \"*** using ${package}::* in [::xotcl::self]\"}}\n"
"::xotcl2::Class create ::xotcl::package -superclass ::xotcl::Class -parameter {\n"
"provide\n"
"{version 1.0}\n"
"{autoexport {}}\n"
"{export {}}} {\n"
".method -per-object create {name args} {\n"
"set nq [namespace qualifiers $name]\n"
"if {$nq ne \"\" && ![namespace exists $nq]} {Object create $nq}\n"
"next}\n"
".method -per-object  extend {name args} {\n"
".require $name\n"
"eval $name configure $args}\n"
".method -per-object contains script {\n"
"if {[.exists provide]} {\n"
"package provide [set .provide] [set .version]} else {\n"
"package provide [::xotcl::self] [set .version]}\n"
"namespace eval [::xotcl::self] {namespace import ::xotcl::*}\n"
"namespace eval [::xotcl::self] $script\n"
"foreach e [set .export] {\n"
"set nq [namespace qualifiers $e]\n"
"if {$nq ne \"\"} {\n"
"namespace eval [::xotcl::self]::$nq [list namespace export [namespace tail $e]]} else {\n"
"namespace eval [::xotcl::self] [list namespace export $e]}}\n"
"foreach e [set .autoexport] {\n"
"namespace eval :: [list namespace import [::xotcl::self]::$e]}}\n"
".method -per-object unknown args {\n"
"eval [set .packagecmd] $args}\n"
".method -per-object verbose value {\n"
"set .verbose $value}\n"
".method -per-object present args {\n"
"if {$::tcl_version<8.3} {\n"
"switch -exact -- [lindex $args 0] {\n"
"-exact  {set pkg [lindex $args 1]}\n"
"default {set pkg [lindex $args 0]}}\n"
"if {[info exists .loaded($pkg)]} {\n"
"return ${.loaded}($pkg)} else {\n"
"error \"not found\"}} else {\n"
"eval [set .packagecmd] present $args}}\n"
".method -per-object import {{-into ::} pkg} {\n"
".require $pkg\n"
"namespace eval $into [subst -nocommands {\n"
"namespace import ${pkg}::*}]\n"
"foreach e [$pkg export] {\n"
"set nq [namespace qualifiers $e]\n"
"if {$nq ne \"\"} {\n"
"namespace eval $into$nq [list namespace import ${pkg}::$e]}}}\n"
".method -per-object require args {\n"
"set prevComponent ${.component}\n"
"if {[catch {set v [eval package present $args]} msg]} {\n"
"switch -exact -- [lindex $args 0] {\n"
"-exact  {set pkg [lindex $args 1]}\n"
"default {set pkg [lindex $args 0]}}\n"
"set .component $pkg\n"
"lappend .uses($prevComponent) ${.component}\n"
"set v [uplevel \\#1 [set .packagecmd] require $args]\n"
"if {$v ne \"\" && ${.verbose}} {\n"
"set path [lindex [::package ifneeded $pkg $v] 1]\n"
"puts \"... $pkg $v loaded from '$path'\"\n"
"set .loaded($pkg) $v   ;# loaded stuff needed for Tcl 8.0}}\n"
"set .component $prevComponent\n"
"return $v}\n"
"set .component .\n"
"set .verbose 0\n"
"set .packagecmd ::package}\n"
"namespace export Object Class myproc myvar}\n"
"namespace eval ::xotcl {\n"
"namespace export @ Attribute\n"
"if {![info exists ::env(HOME)]} {set ::env(HOME) /root}\n"
"set ::xotcl::confdir ~/.xotcl\n"
"set ::xotcl::logdir $::xotcl::confdir/log\n"
"proc tmpdir {} {\n"
"foreach e [list TMPDIR TEMP TMP] {\n"
"if {[info exists ::env($e)] \\\n"
"&& [file isdirectory $::env($e)] \\\n"
"&& [file writable $::env($e)]} {\n"
"return $::env($e)}}\n"
"if {$::tcl_platform(platform) eq \"windows\"} {\n"
"foreach d [list \"C:\\\\TEMP\" \"C:\\\\TMP\" \"\\\\TEMP\" \"\\\\TMP\"] {\n"
"if {[file isdirectory $d] && [file writable $d]} {\n"
"return $d}}}\n"
"return /tmp}\n"
"unset bootstrap}\n"
"";