Index: generic/predefined.xotcl
===================================================================
diff -u -r25416326167316f41d0a90ffa53bac3e1104128f -r217d826e64107056ae97176552cae3c776991b9e
--- generic/predefined.xotcl	(.../predefined.xotcl)	(revision 25416326167316f41d0a90ffa53bac3e1104128f)
+++ generic/predefined.xotcl	(.../predefined.xotcl)	(revision 217d826e64107056ae97176552cae3c776991b9e)
@@ -175,7 +175,6 @@
   # initialize exit handler
   ::xotcl::unsetExitHandler
  
-
   namespace export Object Class
 }
 
@@ -877,560 +876,7 @@
 
 
 
-#######################################################
-# 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
-}
 #######################################################################
 
 
@@ -1464,5 +910,19 @@
     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 "::xotcl2"} {uplevel {namespace import -force ::xotcl2::*}}
+      }
+    }
+  }
+
   unset bootstrap
 }