package provide xotcl1 1.0
#######################################################
# 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::*] {
    set cmdName [namespace tail $cmd]
    if {$cmdName in [list "filtersearch" "setter"]} continue
    ::xotcl::alias Object $cmdName $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::*] {
    set cmdName [namespace tail $cmd]
    if {$cmdName in [list "setter"]} continue
    ::xotcl::alias Class $cmdName $cmd
  }

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

  # define instproc and proc
  ::xotcl::method Class instproc {
    name arguments body precondition:optional postcondition:optional
  } {
    set conditions [list]
    if {[info exists precondition]}  {lappend conditions -precondition  $precondition}
    if {[info exists postcondition]} {lappend conditions -postcondition $postcondition}
    ::xotcl::method [self] $name $arguments $body {*}$conditions
  }

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

  # define - like in XOTcl 1 - a minimal implementation of "method"
  Object instproc method {name arguments body} {
    .proc $name $arguments $body                                  
  }
  Class instproc method {-per-object:switch name arguments body} {
    if {${per-object}} {
      .proc $name $arguments $body       
    } else {
      .instproc $name $arguments $body  
    }
  }

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

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

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

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

  Object instproc self {} {::xotcl::self}

  #
  # object-parameter definition, backwards compatible
  #
  ::xotcl::Object instproc 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}
  }

############################################
# system slots
############################################
  proc register_system_slots1 {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 -methodname object-mixin
    ::xotcl::InterceptorSlot create ${os}::Object::slot::filter \
        -type relation  -methodname object-filter \
        -elementtype ""
    ::xotcl::InterceptorSlot create ${os}::Class::slot::instmixin \
        -type relation  -methodname class-mixin
    ::xotcl::InterceptorSlot create ${os}::Class::slot::instfilter \
        -type relation -methodname class-filter \
        -elementtype ""
  }
  ::xotcl::register_system_slots1 ::xotcl

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

  # 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 proc info {obj} {
    set methods [list]
    foreach m [::info commands ::xotcl::objectInfo::*] {
      set name [namespace tail $m]
      if {$name eq "unknown"} continue
      lappend methods $name
    }
    return "valid options are: [join [lsort $methods] {, }]"
  }
  objectInfo proc unknown {method args} {
    error "[::xotcl::self] unknown info option \"$method\"; [.info info]"
  }

  classInfo proc info {cl} {
    set methods [list]
    foreach m [::info commands ::xotcl::classInfo::*] {
      set name [namespace tail $m]
      if {$name eq "unknown"} continue
      lappend methods $name
    }
    return "valid options are: [join [lsort $methods] {, }]"
  }

  classInfo proc 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 method parameter .... replaces
  #     info args
  #     info nonposargs
  #     info default
  #
  #    => info -per-object method parameter .... replaces
  #     info instargs
  #     info instnonposargs
  #     info instdefault
  #
  #    => info method .... replaces
  #     info body
  #     info instbody
  #
  #    => info methods .... replaces
  #     info commands
  #     info instcommands
  #     info procs
  #     info instprocs
  #     info parametercmd
  #     info instparametercmd
  #
  #    => info is (resp. ::xotcl::is) replaces
  #     info isobject
  #     info isclass
  #     info ismetaclass
  #     info ismixin
  #     info istype
  #
  #    => method .... replaces
  #     proc
  #     instproc
  #
  #   => TODO: use "params" in serializer, and all other occurances
  #
  #
  # TODO mark all absolete calls at least as deprecated in library
  #
  # TODO move unknown handler for Class into a library
  #

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

  proc ::xotcl::info_nonposargs {allocation o method} {
    set result [list]
    foreach flag [::xotcl::cmd::${allocation}Info::method $o parameter $method] {
      if {![string match -* $flag]} continue
      lappend result $flag
    }
    #puts stderr "+++ get ${inst}nonposargs for $o $method => $result"
    return $result
  }
  proc ::xotcl::info_default {allocation o method arg varName} {
    foreach \
        argName [::xotcl::cmd::${allocation}Info::method $o args $method] \
        flag    [::xotcl::cmd::${allocation}Info::method $o parameter $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 {
    .proc instargs {o method} {::xotcl::info_args Class $o $method}
    .proc args     {o method} {::xotcl::info_args Object $o $method}
    .proc instnonposargs {o method} {::xotcl::info_nonposargs Class $o $method}
    .proc nonposargs     {o method} {::xotcl::info_nonposargs Object $o $method}
    .proc instdefault {o method arg var} {::xotcl::info_default Class $o $method $arg $var}
    .proc default     {o method arg var} {::xotcl::info_default Object $o $method $arg $var}

    # info options emulated by "info method ..."
    .proc instbody    {o methodName} {::xotcl::cmd::ClassInfo::method $o body $methodName}
    .proc instpre     {o methodName} {::xotcl::cmd::ClassInfo::method $o precondition  $methodName}
    .proc instpost    {o methodName} {::xotcl::cmd::ClassInfo::method $o postcondition $methodName}

    # info options emulated by "info methods"
    .proc instcommands {o {pattern:optional ""}} {
      ::xotcl::cmd::ClassInfo::methods $o {*}$pattern
    }
    .proc instprocs   {o {pattern:optional ""}} {
      ::xotcl::cmd::ClassInfo::methods $o -methodtype scripted {*}$pattern
    }
    .proc parametercmd {o {pattern:optional ""}} {
      ::xotcl::cmd::ClassInfo::methods $o -per-object -methodtype setter {*}$pattern
    }
    .proc instparametercmd {o {pattern:optional ""}} {
      ::xotcl::cmd::ClassInfo::methods $o -methodtype setter {*}$pattern
    }
    # assertion handling
    .proc instinvar   {o} {::xotcl::assertion $o class-invar}
  }

  objectInfo eval {
    .proc args        {o method} {::xotcl::info_args Object $o $method}
    .proc nonposargs  {o method} {::xotcl::info_nonposargs Object $o $method}
    .proc default     {o method arg var} {::xotcl::info_default Object $o $method $arg $var}

    # info options emulated by "info method ..."
    .proc body        {o methodName} {::xotcl::cmd::ObjectInfo::method $o body $methodName}
    .proc pre         {o methodName} {::xotcl::cmd::ObjectInfo::method $o pre $methodName}
    .proc post        {o methodName} {::xotcl::cmd::ObjectInfo::method $o post $methodName}

    # info options emulated by "info methods"
    .proc commands    {o {pattern:optional ""}} {
      ::xotcl::cmd::ObjectInfo::methods $o {*}$pattern
    }
    .proc procs       {o {pattern:optional ""}} {
      ::xotcl::cmd::ObjectInfo::methods $o -methodtype scripted {*}$pattern
    }
    .proc methods {
      o -nocmds:switch -noprocs:switch -incontext:switch pattern:optional
    } {
      set methodtype all
      if {$nocmds} {set methodtype scripted}
      if {$noprocs} {if {$nocmds} {return ""}; set methodtype system}
      set cmd [list ::xotcl::cmd::ObjectInfo::callable $o -methodtype $methodtype]
      if {$incontext} {lappend cmd -incontext}
      if {[::info exists pattern]} {lappend cmd $pattern}
      eval $cmd
    }
    # object filter mapping
    .proc filter {o -order:switch -guards:switch pattern:optional} {
      set guardsFlag [expr {$guards ? "-guards" : ""}]
      set patternArg [expr {[info exists pattern] ? [list $pattern] : ""}]
      if {$order && !$guards} {
        set def [::xotcl::cmd::ObjectInfo::filter $o -order {*}$guardsFlag {*}$patternArg]
        #puts stderr "TO CONVERT: $def"
        set def [filterorder_list_to_xotcl1 $def]
      } else {
        set def [::xotcl::cmd::ObjectInfo::filter $o {*}$guardsFlag {*}$patternArg]
      }
      #puts stderr "  => $def"
      return $def
    }
    # assertion handling
    .proc check {o} {
      ::xotcl::checkoption_internal_to_xotcl1 [::xotcl::assertion $o check]
    }
    .proc invar {o} {::xotcl::assertion $o object-invar}
  }

  foreach cmd [::info command ::xotcl::cmd::ObjectInfo::*] {
    set cmdName [namespace tail $cmd]
    if {$cmdName in [list "callable" "filter" "method" "methods"]} continue
    ::xotcl::alias ::xotcl::objectInfo $cmdName $cmd
    ::xotcl::alias ::xotcl::classInfo $cmdName $cmd
  }
  foreach cmd [::info command ::xotcl::cmd::ClassInfo::*] {
    set cmdName [namespace tail $cmd]
    if {$cmdName in [list "forward" "method" "methods" \
                         "class-mixin-of" "object-mixin-of" \
                         "filter" "filterguard" \
                         "mixin" "mixinguard"]} continue
    ::xotcl::alias ::xotcl::classInfo $cmdName $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
  ::xotcl::alias ::xotcl::classInfo instmixin ::xotcl::cmd::ClassInfo::mixin
  ::xotcl::alias ::xotcl::classInfo instmixinguard ::xotcl::cmd::ClassInfo::mixinguard
  ::xotcl::alias ::xotcl::classInfo instmixinof ::xotcl::cmd::ClassInfo::class-mixin-of
  ::xotcl::alias ::xotcl::classInfo instfilter ::xotcl::cmd::ClassInfo::filter
  ::xotcl::alias ::xotcl::classInfo instfilterguard ::xotcl::cmd::ClassInfo::filterguard
  ::xotcl::alias ::xotcl::classInfo instforward ::xotcl::cmd::ClassInfo::forward
  ::xotcl::alias ::xotcl::classInfo mixinof ::xotcl::cmd::ClassInfo::object-mixin-of
  # assertion handling
  ::xotcl::alias ::xotcl::classInfo invar objectInfo::invar
  ::xotcl::alias ::xotcl::classInfo check objectInfo::check

  # define info methods from objectInfo on classInfo as well
  ::xotcl::alias classInfo body     objectInfo::body
  ::xotcl::alias classInfo commands objectInfo::commands
  ::xotcl::alias classInfo filter   objectInfo::filter
  ::xotcl::alias classInfo methods  objectInfo::methods
  ::xotcl::alias classInfo procs    objectInfo::procs
  ::xotcl::alias classInfo pre      objectInfo::pre
  ::xotcl::alias classInfo post     objectInfo::post


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

  ::xotcl::alias Object contains ::xotcl::classes::xotcl2::Object::contains
  ::xotcl::Class instforward slots %self contains \
      -object {%::xotcl::dispatch [::xotcl::self] -objscope ::subst [::xotcl::self]::slot}
  #
  # define parametercmd and instparametercmd in terms of ::xotcl2 method setter
  # define filterguard and instfilterguard in terms of filterguard
  # define mixinguard and instmixinguard in terms of mixinguard
  #
  ::xotcl::alias Object parametercmd    ::xotcl::classes::xotcl2::Object::setter
  ::xotcl::alias Class instparametercmd ::xotcl::classes::xotcl2::Class::setter

  ::xotcl::alias Class filterguard      ::xotcl::cmd::Object::filterguard
  ::xotcl::alias Class instfilterguard  ::xotcl::cmd::Class::filterguard

  ::xotcl::alias Class mixinguard       ::xotcl::cmd::Object::mixinguard
  ::xotcl::alias Class instmixinguard   ::xotcl::cmd::Class::mixinguard

  # assertion handling
  proc checkoption_xotcl1_to_internal checkoptions {
    set options [list]
    foreach option $checkoptions {
      if {$option eq "invar"} {
        lappend options "object-invar"
      } elseif {$option eq "instinvar"} {
        lappend options "class-invar"
      } else {
        lappend options $option
      }
    }
    return $options
  }
  proc checkoption_internal_to_xotcl1 checkoptions {
    set options [list]
    foreach option $checkoptions {
      if {$option eq "object-invar"} {
        lappend options "invar"
      } elseif {$option eq "class-invar"} {
        lappend options "instinvar"
      } else {
        lappend options $option
      }
    }
    return $options
  }
  proc filterorder_list_to_xotcl1 definitions {
    set defs [list]
    foreach def $definitions {lappend defs [filterorder_to_xotcl1 $def]}
    return $defs
  }
  proc filterorder_to_xotcl1 definition {
    if {$definition ne ""} {
      set modifier [lindex $definition 1]
      if {$modifier eq "object"} {
        set prefix ""
        set kind [lindex $definition 2]
        set name [lindex $definition 3]
      } else {
        set prefix "inst"
        set kind $modifier
        set name [lindex $definition 2]
      }
      if {$kind eq "method"} {
        set kind proc
      } elseif {$kind eq "setter"} {
        set kind parametercmd
      }
      set definition [list [lindex $definition 0] ${prefix}$kind $name]
    }
    return $definition
  }
 

  Object instproc check {checkoptions} {
    ::xotcl::assertion [self] check [::xotcl::checkoption_xotcl1_to_internal $checkoptions]
  }
  Object instforward invar     ::xotcl::assertion %self object-invar
  Class  instforward instinvar ::xotcl::assertion %self class-invar

  Object instproc 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 instproc hasclass cl {
    if {[::xotcl::is [self] mixin $cl]} {return 1}
    ::xotcl::is [self] type $cl
  }
  Object instproc filtersearch {filter} {
    set definition [::xotcl::dispatch [self] ::xotcl::cmd::Object::filtersearch $filter]
    return [filterorder_to_xotcl1 $definition]
  }
  Object instproc procsearch {name} {
    set definition [::xotcl::cmd::ObjectInfo::callable [self] -which $name]
    if {$definition ne ""} {
      foreach {obj modifier kind} $definition break
      if {$modifier ne "object"} {
        set kind $modifier
        set perClass [::xotcl::is $obj class]
      } else {
        set perClass 0
      }
      switch $kind {
        alias   {if {$perClass} {set kind "instcmd"} else {set kind "cmd"}}
        forward {if {$perClass} {set kind "instforward"}}
        method  {if {$perClass} {set kind "instproc"} else {set kind "proc"}}
        setter  {if {$perClass} {set kind "instparametercmd"} else {set kind "parametercmd"}}
        default {error "not handeled: $definition"}
      }
      #puts stderr "return: [list $obj $kind $name]"
      return [list $obj $kind $name]
    }
  }
  Class instproc allinstances {} {
    # TODO: mark it deprecated
    return [.info instances -closure]
  }

  # keep old object interface for xotcl 1.*
  Object proc unsetExitHandler {} {::xotcl::unsetExitHandler $newbody}
  Object proc setExitHandler   {newbody} {::xotcl::setExitHandler $newbody}
  Object proc 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 -per-object __unknown ::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 proc load {obj file} {
    source $file
    foreach i [array names ::auto_index [list $obj *proc *]] {
      set type [lindex $i 1]
      set meth [lindex $i 2]
      if {[$obj info ${type}s $meth] == {}} {
        $obj $type $meth auto $::auto_index($i)
      }
  }
  }
  
  config proc mkindex {meta dir args} {
    set sp {[ 	]+}
    set st {^[ 	]*}
    set wd {([^ 	;]+)}
    foreach creator $meta {
      ::lappend cp $st$creator${sp}create$sp$wd
      ::lappend ap $st$creator$sp$wd
    }
    foreach 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 instproc extractConfigureArg {al name {cutTheArg 0}} {
    set value ""
    upvar $al argList
    set largs [llength $argList]
    for {set i 0} {$i < $largs} {incr i} {
      if {[lindex $argList $i] == $name && $i + 1 < $largs} {
        set startIndex $i
        set endIndex [expr {$i + 1}]
        while {$endIndex < $largs &&
               [string first - [lindex $argList $endIndex]] != 0} {
          lappend value [lindex $argList $endIndex]
          incr endIndex
        }
      }
    }
    if {[info exists startIndex] && $cutTheArg != 0} {
      set argList [lreplace $argList $startIndex [expr {$endIndex - 1}]]
    }
    return $value
  }

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

  #
  # package support
  #
  # puts this for the time being into xotcl 1.*
  #
  ::xotcl::Class instproc 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 {}}
  } {
    
    .public object method create {name args} {
      set nq [namespace qualifiers $name]
      if {$nq ne "" && ![namespace exists $nq]} {Object create $nq}
      next
    }

    .public object method extend {name args} {
      .require $name
      eval $name configure $args
    }
    
    .public object method 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]
      }
    }
    
    .public object method unknown args {
      #puts stderr "unknown: package $args"
      eval [set .packagecmd] $args
    }
    
    .public object method verbose value {
      set .verbose $value
    }
    
    .public object method 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
      }
    }
    
    .public object method 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]
        }
      }
    }
    
    .public object method 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
  }
  
  if {[info exists cmd]} {unset cmd}
  # finally, export contents defined for xotcl 1.*
  namespace export Object Class myproc myvar
}