Index: COMPILE =================================================================== diff -u -rc72f9f638677608fab1502cd696c8f2d6b2952f9 -r81c800c8b9cb42ef6743d9b80ac2be5ca211a69a --- COMPILE (.../COMPILE) (revision c72f9f638677608fab1502cd696c8f2d6b2952f9) +++ COMPILE (.../COMPILE) (revision 81c800c8b9cb42ef6743d9b80ac2be5ca211a69a) @@ -1,4 +1,3 @@ -$Id: COMPILE,v 1.2 2004/08/17 10:12:54 neumann Exp $ ******************************************************** XOTcl Compilation Guide (Unix) ******************************************************** Index: COMPILE.win =================================================================== diff -u -r46f02e4868e118466d888b35d6b281b3f2ba31ac -r81c800c8b9cb42ef6743d9b80ac2be5ca211a69a --- COMPILE.win (.../COMPILE.win) (revision 46f02e4868e118466d888b35d6b281b3f2ba31ac) +++ COMPILE.win (.../COMPILE.win) (revision 81c800c8b9cb42ef6743d9b80ac2be5ca211a69a) @@ -1,4 +1,3 @@ -$Id: COMPILE.win,v 1.1.1.1 2004/05/23 22:50:39 neumann Exp $ ******************************** XOTcl Windows compilation guide: ******************************** Index: Makefile.in =================================================================== diff -u -r399b8ad3f5b8723b9738f1ed1d83ed6f01f3c8d1 -r81c800c8b9cb42ef6743d9b80ac2be5ca211a69a --- Makefile.in (.../Makefile.in) (revision 399b8ad3f5b8723b9738f1ed1d83ed6f01f3c8d1) +++ Makefile.in (.../Makefile.in) (revision 81c800c8b9cb42ef6743d9b80ac2be5ca211a69a) @@ -420,16 +420,16 @@ $(COMPILE) -c `@CYGPATH@ $<` -o $@ #======================================================================== -# xotcl shells +# next shells #======================================================================== pkgIndex.tcl: $(PKG_LIB_FILE) - @echo package ifneeded XOTcl $(PACKAGE_VERSION) [list load [file join \$$dir . $(PKG_LIB_FILE)] XOTcl] > pkgIndex.tcl + @echo package ifneeded next $(PACKAGE_VERSION) [list load [file join \$$dir . $(PKG_LIB_FILE)] next] > pkgIndex.tcl install-pkgIndex: -# @echo package ifneeded XOTcl $(PACKAGE_VERSION) [list load [file join \$$dir .. "$(PKG_LIB_FILE)"] XOTcl] > "$(pkglibdir)/pkgIndex.tcl" +# @echo package ifneeded next $(PACKAGE_VERSION) [list load [file join \$$dir .. "$(PKG_LIB_FILE)"] next] > "$(pkglibdir)/pkgIndex.tcl" -xotclsh: tclAppInit.o $(PKG_OBJECTS) $(CONDITIONAL_STUB_OBJECTS) +nextsh: tclAppInit.o $(PKG_OBJECTS) $(CONDITIONAL_STUB_OBJECTS) $(CC) -rdynamic -o $@ tclAppInit.o \ $(CFLAGS) $(TCL_LIB_SPEC) \ $(DMALLOC_LIB) $(CONDITIONAL_STUB_OBJECTS) @@ -441,8 +441,8 @@ $(DMALLOC_LIB) $(CONDITIONAL_STUB_OBJECTS) install-shells: - @if test -f xotclsh; then \ - $(INSTALL_PROGRAM) xotclsh $(DESTDIR)$(bindir); \ + @if test -f nextsh; then \ + $(INSTALL_PROGRAM) nextsh $(DESTDIR)$(bindir); \ fi @if test -f xowish; then \ $(INSTALL_PROGRAM) xowish $(DESTDIR)$(bindir); \ @@ -636,26 +636,26 @@ end: @echo "" @echo "************************************************************" - @echo " Make completed. In order to test XOTcl, invoke:" + @echo " Make completed. In order to test 'next', invoke:" @echo " make test" @echo "" - @echo " In order install XOTcl, invoke:" + @echo " In order install next, invoke:" @echo " make install" @echo "" - @echo " In order to install XOTcl for AOLserver 4.x, invoke:" + @echo " In order to install next for AOLserver 4.x, invoke:" @echo " make install-aol" @echo "" - @echo " In order to invoke XOTcl interactively (before install), use:" + @echo " In order to invoke next interactively (before install), use:" @echo " export TCLLIBPATH=\"$(TCLLIBPATH)\" or " @echo " setenv TCLLIBPATH \"$(TCLLIBPATH)\"" @echo " and" @if test "x$(XOTCLSH)" = "x" ; then \ echo " @TCLSH_PROG@" ; \ - echo " package require XOTcl; namespace import -force xotcl::*" ; \ + echo " package require next; namespace import -force next::*" ; \ echo " or" ; \ echo " put the 'package require' line into your ~/.tclshrc" ; \ else \ - echo " ./xotclsh" ; \ + echo " ./nextsh" ; \ fi @echo "************************************************************" @@ -672,7 +672,7 @@ bin-tar: (cd ..; tar zcvf xotcl-$(PACKAGE_VERSION)-bin-linux-i686-glibc.tar.gz \ - `find $(exec_prefix)/bin/xotclsh $(exec_prefix)/bin/xowish \ + `find $(exec_prefix)/bin/$(XOTCLSH) $(exec_prefix)/bin/xowish \ $(prefix)/lib/xotcl* \ $(prefix)/lib/libxotcl* \ $(prefix)/include/xotcl*.h \ Index: README =================================================================== diff -u -rc72f9f638677608fab1502cd696c8f2d6b2952f9 -r81c800c8b9cb42ef6743d9b80ac2be5ca211a69a --- README (.../README) (revision c72f9f638677608fab1502cd696c8f2d6b2952f9) +++ README (.../README) (revision 81c800c8b9cb42ef6743d9b80ac2be5ca211a69a) @@ -1,4 +1,4 @@ -***************** $Id: README,v 1.2 2004/08/18 09:31:08 neumann Exp $ +***************** XOTcl README File ***************** Index: apps/comm/webserver.xotcl =================================================================== diff -u -rdf9b12b3347ec6d0aaab6a080619734cd4c45f34 -r81c800c8b9cb42ef6743d9b80ac2be5ca211a69a --- apps/comm/webserver.xotcl (.../webserver.xotcl) (revision df9b12b3347ec6d0aaab6a080619734cd4c45f34) +++ apps/comm/webserver.xotcl (.../webserver.xotcl) (revision 81c800c8b9cb42ef6743d9b80ac2be5ca211a69a) @@ -4,7 +4,7 @@ array set opts $argv lappend auto_path $opts(-pkgdir) #if {$::tcl_platform(platform) eq "windows"} {lappend auto_path .} -package require XOTcl; xotcl::use xotcl1 +package require XOTcl; namespace import -force ::xotcl::* proc ! string { set f [open [::xotcl::tmpdir]/log w+]; Index: configure =================================================================== diff -u -ra16cfab111738c0792b602340bb9f86263206a74 -r81c800c8b9cb42ef6743d9b80ac2be5ca211a69a --- configure (.../configure) (revision a16cfab111738c0792b602340bb9f86263206a74) +++ configure (.../configure) (revision 81c800c8b9cb42ef6743d9b80ac2be5ca211a69a) @@ -1,6 +1,6 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.61 for xotcl 2.0.0. +# Generated by GNU Autoconf 2.61 for next 2.0.0. # # Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, # 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. @@ -570,10 +570,10 @@ SHELL=${CONFIG_SHELL-/bin/sh} # Identity of this package. -PACKAGE_NAME='xotcl' -PACKAGE_TARNAME='xotcl' +PACKAGE_NAME='next' +PACKAGE_TARNAME='next' PACKAGE_VERSION='2.0.0' -PACKAGE_STRING='xotcl 2.0.0' +PACKAGE_STRING='next 2.0.0' PACKAGE_BUGREPORT='' # Factoring default headers for most tests. @@ -1270,7 +1270,7 @@ # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF -\`configure' configures xotcl 2.0.0 to adapt to many kinds of systems. +\`configure' configures next 2.0.0 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... @@ -1318,7 +1318,7 @@ --infodir=DIR info documentation [DATAROOTDIR/info] --localedir=DIR locale-dependent data [DATAROOTDIR/locale] --mandir=DIR man documentation [DATAROOTDIR/man] - --docdir=DIR documentation root [DATAROOTDIR/doc/xotcl] + --docdir=DIR documentation root [DATAROOTDIR/doc/next] --htmldir=DIR html documentation [DOCDIR] --dvidir=DIR dvi documentation [DOCDIR] --pdfdir=DIR pdf documentation [DOCDIR] @@ -1331,7 +1331,7 @@ if test -n "$ac_init_help"; then case $ac_init_help in - short | recursive ) echo "Configuration of xotcl 2.0.0:";; + short | recursive ) echo "Configuration of next 2.0.0:";; esac cat <<\_ACEOF @@ -1447,7 +1447,7 @@ test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF -xotcl configure 2.0.0 +next configure 2.0.0 generated by GNU Autoconf 2.61 Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, @@ -1461,7 +1461,7 @@ This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. -It was created by xotcl $as_me 2.0.0, which was +It was created by next $as_me 2.0.0, which was generated by GNU Autoconf 2.61. Invocation command line was $ $0 $@ @@ -2059,7 +2059,7 @@ if test "$with_tk" = no; then with_xowish="" ; fi -if test "$with_xotclsh" = yes; then XOTCLSH="xotclsh" ; else XOTCLSH=""; fi +if test "$with_xotclsh" = yes; then XOTCLSH="nextsh" ; else XOTCLSH=""; fi if test "$with_xowish" = yes; then XOWISH="xowish" ; else XOWISH=""; fi @@ -2084,7 +2084,7 @@ -echo "Configuring XOTcl Version $PACKAGE_VERSION" +echo "Configuring next Version $PACKAGE_VERSION" #-------------------------------------------------------------------- # Load the tclConfig.sh file @@ -12014,7 +12014,7 @@ # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" -This file was extended by xotcl $as_me 2.0.0, which was +This file was extended by next $as_me 2.0.0, which was generated by GNU Autoconf 2.61. Invocation command line was CONFIG_FILES = $CONFIG_FILES @@ -12057,7 +12057,7 @@ _ACEOF cat >>$CONFIG_STATUS <<_ACEOF ac_cs_version="\\ -xotcl config.status 2.0.0 +next config.status 2.0.0 configured by $0, generated by GNU Autoconf 2.61, with options \\"`echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`\\" Index: configure.in =================================================================== diff -u -ra16cfab111738c0792b602340bb9f86263206a74 -r81c800c8b9cb42ef6743d9b80ac2be5ca211a69a --- configure.in (.../configure.in) (revision a16cfab111738c0792b602340bb9f86263206a74) +++ configure.in (.../configure.in) (revision 81c800c8b9cb42ef6743d9b80ac2be5ca211a69a) @@ -12,7 +12,7 @@ # #-------------------------------------------------------------------- define(XOTclVersion, 2.0.0) -AC_INIT([xotcl], [XOTclVersion]) +AC_INIT([next], [XOTclVersion]) #-------------------------------------------------------------------- # Call TEA_INIT as the first TEA_ macro to set up initial vars. @@ -91,7 +91,7 @@ AC_SUBST(subdirs) if test "$with_tk" = no; then with_xowish="" ; fi -if test "$with_xotclsh" = yes; then XOTCLSH="xotclsh" ; else XOTCLSH=""; fi +if test "$with_xotclsh" = yes; then XOTCLSH="nextsh" ; else XOTCLSH=""; fi if test "$with_xowish" = yes; then XOWISH="xowish" ; else XOWISH=""; fi @@ -116,7 +116,7 @@ AC_SUBST(XOTCL_MINOR_VERSION) AC_SUBST(XOTCL_RELEASE_LEVEL) -echo "Configuring XOTcl Version $PACKAGE_VERSION" +echo "Configuring next Version $PACKAGE_VERSION" #-------------------------------------------------------------------- # Load the tclConfig.sh file Index: generic/gentclAPI.decls =================================================================== diff -u -r9474936bd01f25c80caa91f9b3164a3072457f66 -r81c800c8b9cb42ef6743d9b80ac2be5ca211a69a --- generic/gentclAPI.decls (.../gentclAPI.decls) (revision 9474936bd01f25c80caa91f9b3164a3072457f66) +++ generic/gentclAPI.decls (.../gentclAPI.decls) (revision 81c800c8b9cb42ef6743d9b80ac2be5ca211a69a) @@ -5,12 +5,12 @@ # namespaces for types of methods array set ns { - xotclCmd "::xotcl" - objectMethod "::xotcl::cmd::Object" - classMethod "::xotcl::cmd::Class" - checkMethod "::xotcl::cmd::ParameterType" - infoClassMethod "::xotcl::cmd::ClassInfo" - infoObjectMethod "::xotcl::cmd::ObjectInfo" + xotclCmd "::next::core" + objectMethod "::next::core::cmd::Object" + classMethod "::next::core::cmd::Class" + checkMethod "::next::core::cmd::ParameterType" + infoClassMethod "::next::core::cmd::ClassInfo" + infoObjectMethod "::next::core::cmd::ObjectInfo" } # Index: generic/gentclAPI.tcl =================================================================== diff -u -r533853e3ec6ac529b38d1d48e2fdb82ff7135429 -r81c800c8b9cb42ef6743d9b80ac2be5ca211a69a --- generic/gentclAPI.tcl (.../gentclAPI.tcl) (revision 533853e3ec6ac529b38d1d48e2fdb82ff7135429) +++ generic/gentclAPI.tcl (.../gentclAPI.tcl) (revision 81c800c8b9cb42ef6743d9b80ac2be5ca211a69a) @@ -295,9 +295,9 @@ } set namespaces [list] - foreach {key value} [array get ::ns] { - # no need to create the ::xotcl namespace - if {$value eq "::xotcl"} continue + foreach {key value} [array get ::ns] { + # no need to create the ::next::core namespace + if {$value eq "::next::core"} continue lappend namespaces "\"$value\"" } set namespaceString [join $namespaces ",\n "] Index: generic/predefined.h =================================================================== diff -u -r9474936bd01f25c80caa91f9b3164a3072457f66 -r81c800c8b9cb42ef6743d9b80ac2be5ca211a69a --- generic/predefined.h (.../predefined.h) (revision 9474936bd01f25c80caa91f9b3164a3072457f66) +++ generic/predefined.h (.../predefined.h) (revision 81c800c8b9cb42ef6743d9b80ac2be5ca211a69a) @@ -1,9 +1,8 @@ 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" +"\n" +"namespace eval ::next {\n" +"set bootstrap 1\n" +"::next::core::createobjectsystem ::next::Object ::next::Class {\n" "-class.alloc alloc\n" "-class.create create\n" "-class.dealloc dealloc\n" @@ -17,113 +16,117 @@ "-object.objectparameter objectparameter\n" "-object.residualargs residualargs\n" "-object.unknown unknown}\n" -"foreach cmd [info command ::xotcl::cmd::Object::*] {\n" +"namespace eval ::next::core {\n" +"namespace export next self \\\n" +"my is relation interp}\n" +"namespace import ::next::core::next ::next::core::self\n" +"foreach cmd [info command ::next::core::cmd::Object::*] {\n" "set cmdName [namespace tail $cmd]\n" "if {$cmdName in [list \"instvar\"]} continue\n" -"::xotcl::alias Object $cmdName $cmd}\n" -"::xotcl::alias Object eval -nonleaf ::eval\n" -"foreach cmd [info command ::xotcl::cmd::Class::*] {\n" +"::next::core::alias Object $cmdName $cmd}\n" +"::next::core::alias Object eval -nonleaf ::eval\n" +"foreach cmd [info command ::next::core::cmd::Class::*] {\n" "set cmdName [namespace tail $cmd]\n" -"::xotcl::alias Class $cmdName $cmd}\n" +"::next::core::alias Class $cmdName $cmd}\n" "foreach cmd [list __next cleanup noinit residualargs uplevel upvar] {\n" -"::xotcl::methodproperty Object $cmd protected 1}\n" +"::next::core::methodproperty Object $cmd protected 1}\n" "foreach cmd [list recreate] {\n" -"::xotcl::methodproperty Class $cmd protected 1}\n" -"::xotcl::methodproperty Object destroy redefine-protected true\n" -"::xotcl::methodproperty Class alloc redefine-protected true\n" -"::xotcl::methodproperty Class dealloc redefine-protected true\n" -"::xotcl::methodproperty Class create redefine-protected true\n" -"::xotcl::method Class method {\n" +"::next::core::methodproperty Class $cmd protected 1}\n" +"::next::core::methodproperty Object destroy redefine-protected true\n" +"::next::core::methodproperty Class alloc redefine-protected true\n" +"::next::core::methodproperty Class dealloc redefine-protected true\n" +"::next::core::methodproperty Class create redefine-protected true\n" +"::next::core::method Class method {\n" "name arguments body -precondition -postcondition} {\n" "set conditions [list]\n" "if {[info exists precondition]} {lappend conditions -precondition $precondition}\n" "if {[info exists postcondition]} {lappend conditions -postcondition $postcondition}\n" -"::xotcl::method [::xotcl::current object] $name $arguments $body {*}$conditions}\n" -"::xotcl::method Object method {\n" +"::next::core::method [::next::core::current object] $name $arguments $body {*}$conditions}\n" +"::next::core::method Object method {\n" "name arguments body -precondition -postcondition} {\n" "set conditions [list]\n" "if {[info exists precondition]} {lappend conditions -precondition $precondition}\n" "if {[info exists postcondition]} {lappend conditions -postcondition $postcondition}\n" -"::xotcl::method [::xotcl::current object] -per-object $name $arguments $body {*}$conditions}\n" +"::next::core::method [::next::core::current object] -per-object $name $arguments $body {*}$conditions}\n" "Class eval {\n" ":method object {what args} {\n" "if {$what in [list \"alias\" \"attribute\" \"forward\" \"method\" \"setter\"]} {\n" -"return [::xotcl::dispatch [::xotcl::current object] ::xotcl::classes::xotcl2::Object::$what {*}$args]}\n" +"return [::next::core::dispatch [::next::core::current object] ::next::core::classes::next::Object::$what {*}$args]}\n" "if {$what in [list \"info\"]} {\n" -"return [::xotcl2::objectInfo [lindex $args 0] [::xotcl::current object] {*}[lrange $args 1 end]]}\n" +"return [::next::objectInfo [lindex $args 0] [::next::core::current object] {*}[lrange $args 1 end]]}\n" "if {$what in [list \"filter\" \"mixin\"]} {\n" "return [:object-$what {*}$args]}\n" "if {$what in [list \"filterguard\" \"mixinguard\"]} {\n" -"return [::xotcl::dispatch [::xotcl::current object] ::xotcl::cmd::Object::$what {*}$args]}}\n" +"return [::next::core::dispatch [::next::core::current object] ::next::core::cmd::Object::$what {*}$args]}}\n" ":method unknown {m args} {\n" -"error \"Method '$m' unknown for [::xotcl::current object].\\\n" -"Consider '[::xotcl::current object] create $m $args' instead of '[::xotcl::current object] $m $args'\"}\n" -"::xotcl::methodproperty [::xotcl::current object] unknown protected 1}\n" +"error \"Method '$m' unknown for [::next::core::current object].\\\n" +"Consider '[::next::core::current object] create $m $args' instead of '[::next::core::current object] $m $args'\"}\n" +"::next::core::methodproperty [::next::core::current object] unknown protected 1}\n" "Object eval {\n" ":method public {args} {\n" "set p [lsearch -regexp $args {^(method|alias|attribute|forward|setter)$}]\n" "if {$p == -1} {error \"$args is not a method defining method\"}\n" "set r [{*}:$args]\n" -"::xotcl::methodproperty [::xotcl::current object] $r protected false\n" +"::next::core::methodproperty [::next::core::current object] $r protected false\n" "return $r}\n" ":method protected {args} {\n" "set p [lsearch -regexp $args {^(method|alias|attribute|forward|setter)$}]\n" "if {$p == -1} {error \"$args is not a method defining command\"}\n" "set r [{*}:$args]\n" -"::xotcl::methodproperty [::xotcl::current object] $r [::xotcl::current method] true\n" +"::next::core::methodproperty [::next::core::current object] $r [::next::core::current method] true\n" "return $r}\n" ":protected method unknown {m args} {\n" -"if {![::xotcl::current isnext]} {\n" -"error \"[::xotcl::current object]: unable to dispatch method '$m'\"}}\n" +"if {![::next::core::current isnext]} {\n" +"error \"[::next::core::current object]: unable to dispatch method '$m'\"}}\n" ":protected method init args {}\n" -":protected method defaultmethod {} {::xotcl::current object}\n" +":protected method defaultmethod {} {::next::core::current object}\n" ":protected method objectparameter {} {;}}\n" -"::xotcl::forward Object forward ::xotcl::forward %self -per-object\n" -"::xotcl::forward Class forward ::xotcl::forward %self\n" +"::next::core::forward Object forward ::next::core::forward %self -per-object\n" +"::next::core::forward Class forward ::next::core::forward %self\n" "Class protected object method __unknown {name} {}\n" "Object public method alias {-nonleaf:switch -objscope:switch methodName cmd} {\n" -"::xotcl::alias [::xotcl::current object] -per-object $methodName \\\n" +"::next::core::alias [::next::core::current object] -per-object $methodName \\\n" "{*}[expr {${objscope} ? \"-objscope\" : \"\"}] \\\n" "{*}[expr {${nonleaf} ? \"-nonleaf\" : \"\"}] \\\n" "$cmd}\n" "Class public method alias {-nonleaf:switch -objscope:switch methodName cmd} {\n" -"::xotcl::alias [::xotcl::current object] $methodName \\\n" +"::next::core::alias [::next::core::current object] $methodName \\\n" "{*}[expr {${objscope} ? \"-objscope\" : \"\"}] \\\n" "{*}[expr {${nonleaf} ? \"-nonleaf\" : \"\"}] \\\n" "$cmd}\n" "Object public method setter {methodName} {\n" -"::xotcl::setter [::xotcl::current object] -per-object $methodName}\n" +"::next::core::setter [::next::core::current object] -per-object $methodName}\n" "Class public method setter {methodName} {\n" -"::xotcl::setter [::xotcl::current object] $methodName}\n" -"Object create ::xotcl2::objectInfo\n" -"Object create ::xotcl2::classInfo\n" +"::next::core::setter [::next::core::current object] $methodName}\n" +"Object create ::next::objectInfo\n" +"Object create ::next::classInfo\n" "objectInfo eval {\n" -":alias is ::xotcl::objectproperty\n" +":alias is ::next::core::objectproperty\n" ":public method info {obj} {\n" "set methods [list]\n" -"foreach name [::xotcl::cmd::ObjectInfo::methods [::xotcl::current object]] {\n" +"foreach name [::next::core::cmd::ObjectInfo::methods [::next::core::current object]] {\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::current object] unknown info option \\\"$method\\\"; [$obj info info]\"}}\n" +"error \"[::next::core::current object] unknown info option \\\"$method\\\"; [$obj info info]\"}}\n" "classInfo eval {\n" -":alias is ::xotcl::objectproperty\n" -":alias classparent ::xotcl::cmd::ObjectInfo::parent\n" -":alias classchildren ::xotcl::cmd::ObjectInfo::children\n" -":alias info [::xotcl::cmd::ObjectInfo::method objectInfo name info]\n" -":alias unknown [::xotcl::cmd::ObjectInfo::method objectInfo name info]}\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" +":alias is ::next::core::objectproperty\n" +":alias classparent ::next::core::cmd::ObjectInfo::parent\n" +":alias classchildren ::next::core::cmd::ObjectInfo::children\n" +":alias info [::next::core::cmd::ObjectInfo::method objectInfo name info]\n" +":alias unknown [::next::core::cmd::ObjectInfo::method objectInfo name info]}\n" +"foreach cmd [info command ::next::core::cmd::ObjectInfo::*] {\n" +"::next::core::alias ::next::objectInfo [namespace tail $cmd] $cmd\n" +"::next::core::alias ::next::classInfo [namespace tail $cmd] $cmd}\n" +"foreach cmd [info command ::next::core::cmd::ClassInfo::*] {\n" "set cmdName [namespace tail $cmd]\n" "if {$cmdName in [list \"object-mixin-of\" \"class-mixin-of\"]} continue\n" -"::xotcl::alias ::xotcl2::classInfo $cmdName $cmd}\n" +"::next::core::alias ::next::classInfo $cmdName $cmd}\n" "unset cmd\n" -"Object forward info -onerror ::xotcl::infoError ::xotcl2::objectInfo %1 {%@2 %self}\n" -"Class forward info -onerror ::xotcl::infoError ::xotcl2::classInfo %1 {%@2 %self}\n" -"proc ::xotcl::infoError msg {\n" +"Object forward info -onerror ::next::core::infoError ::next::objectInfo %1 {%@2 %self}\n" +"Class forward info -onerror ::next::core::infoError ::next::classInfo %1 {%@2 %self}\n" +"proc ::next::core::infoError msg {\n" "regsub -all \" \" $msg \"\" msg\n" "regsub -all \" \" $msg \"\" msg\n" "regsub {\\\"} $msg \"\\\"info \" msg\n" @@ -132,27 +135,27 @@ "if {$methtype ne \"method\"} {\n" "error \"invalid method type '$methtype', must be 'method'\"}\n" "set body \"\n" -"if {!\\[::xotcl::current isnextcall\\]} {\n" -"error \\\"Abstract method $methname $arglist called\\\"} else {::xotcl::next}\n" +"if {!\\[::next::core::current isnextcall\\]} {\n" +"error \\\"Abstract method $methname $arglist called\\\"} else {::next::core::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" -"namespace eval ::xotcl {\n" -"::xotcl2::Class create ::xotcl::MetaSlot\n" -"::xotcl::relation ::xotcl::MetaSlot superclass ::xotcl2::Class\n" -"::xotcl::MetaSlot public method slotName {name baseObject} {\n" +"proc ::next::core::unsetExitHandler {} {\n" +"proc ::next::core::__exitHandler {} {}}\n" +"proc ::next::core::setExitHandler {newbody} {::proc ::next::core::__exitHandler {} $newbody}\n" +"proc ::next::core::getExitHandler {} {::info body ::next::core::__exitHandler}\n" +"::next::core::unsetExitHandler\n" +"namespace export Object Class next self}\n" +"namespace eval ::next {\n" +"::next::Class create ::next::MetaSlot\n" +"::next::core::relation ::next::MetaSlot superclass ::next::Class\n" +"::next::MetaSlot public method slotName {name baseObject} {\n" "set slotParent ${baseObject}::slot\n" -"if {![::xotcl::objectproperty ${slotParent} object]} {\n" -"::xotcl2::Object create ${slotParent}}\n" +"if {![::next::core::objectproperty ${slotParent} object]} {\n" +"::next::Object create ${slotParent}}\n" "return ${slotParent}::$name}\n" -"::xotcl::MetaSlot method createFromParameterSyntax {target -per-object:switch\n" +"::next::MetaSlot method createFromParameterSyntax {target -per-object:switch\n" "{-initblock \"\"}\n" "value default:optional} {\n" "set opts [list]\n" @@ -179,87 +182,87 @@ "set info ObjectInfo} else {\n" "set info ClassInfo}\n" ":create [:slotName $name $target] {*}$opts $initblock\n" -"return [::xotcl::cmd::${info}::method $target name $name]}\n" -"::xotcl::MetaSlot create ::xotcl::Slot\n" -"::xotcl::MetaSlot create ::xotcl::ObjectParameterSlot\n" -"::xotcl::relation ::xotcl::ObjectParameterSlot superclass ::xotcl::Slot\n" -"::xotcl::MetaSlot create ::xotcl::MethodParameterSlot\n" -"::xotcl::relation ::xotcl::MethodParameterSlot superclass ::xotcl::Slot\n" -"::xotcl::MethodParameterSlot create ::xotcl::methodParameterSlot\n" +"return [::next::core::cmd::${info}::method $target name $name]}\n" +"::next::MetaSlot create ::next::Slot\n" +"::next::MetaSlot create ::next::ObjectParameterSlot\n" +"::next::core::relation ::next::ObjectParameterSlot superclass ::next::Slot\n" +"::next::MetaSlot create ::next::MethodParameterSlot\n" +"::next::core::relation ::next::MethodParameterSlot superclass ::next::Slot\n" +"::next::MethodParameterSlot create ::next::methodParameterSlot\n" "proc createBootstrapAttributeSlots {class definitions} {\n" "foreach att $definitions {\n" "if {[llength $att]>1} {foreach {att default} $att break}\n" -"set slotObj [::xotcl::ObjectParameterSlot slotName $att $class]\n" -"::xotcl::ObjectParameterSlot create $slotObj\n" +"set slotObj [::next::ObjectParameterSlot slotName $att $class]\n" +"::next::ObjectParameterSlot create $slotObj\n" "if {[info exists default]} {\n" -"::xotcl::setvar $slotObj default $default\n" +"::next::core::setvar $slotObj default $default\n" "unset default}\n" -"::xotcl::setter $class $att}\n" +"::next::core::setter $class $att}\n" "foreach att $definitions {\n" "if {[llength $att]>1} {foreach {att default} $att break}\n" "if {[info exists default]} {\n" -"foreach i [::xotcl::cmd::ClassInfo::instances $class] {\n" +"foreach i [::next::core::cmd::ClassInfo::instances $class] {\n" "if {![$i exists $att]} {\n" "if {[string match {*\\[*\\]*} $default]} {\n" -"set value [::xotcl::dispatch $i -objscope ::eval subst $default]} else {\n" +"set value [::next::core::dispatch $i -objscope ::eval subst $default]} else {\n" "set value $default}\n" -"::xotcl::setvar $i $att $value}}\n" +"::next::core::setvar $i $att $value}}\n" "unset default}}\n" "$class __invalidateobjectparameter}\n" -"createBootstrapAttributeSlots ::xotcl::Slot {\n" +"createBootstrapAttributeSlots ::next::Slot {\n" "{name}\n" "{multivalued false}\n" "{required false}\n" "default\n" "type}\n" -"createBootstrapAttributeSlots ::xotcl::ObjectParameterSlot {\n" -"{name \"[namespace tail [::xotcl::current object]]\"}\n" +"createBootstrapAttributeSlots ::next::ObjectParameterSlot {\n" +"{name \"[namespace tail [::next::core::current object]]\"}\n" "{methodname}\n" -"{domain \"[lindex [regexp -inline {^(.*)::slot::[^:]+$} [::xotcl::current object]] 1]\"}\n" +"{domain \"[lindex [regexp -inline {^(.*)::slot::[^:]+$} [::next::core::current object]] 1]\"}\n" "{defaultmethods {get assign}}\n" -"{manager \"[::xotcl::current object]\"}\n" +"{manager \"[::next::core::current object]\"}\n" "{per-object false}}\n" -"::xotcl::alias ::xotcl::ObjectParameterSlot get ::xotcl::setvar\n" -"::xotcl::alias ::xotcl::ObjectParameterSlot assign ::xotcl::setvar\n" -"::xotcl::ObjectParameterSlot public method add {obj prop value {pos 0}} {\n" +"::next::core::alias ::next::ObjectParameterSlot get ::next::core::setvar\n" +"::next::core::alias ::next::ObjectParameterSlot assign ::next::core::setvar\n" +"::next::ObjectParameterSlot public 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::setvar $obj $prop [linsert [::xotcl::setvar $obj $prop] $pos $value]} else {\n" -"::xotcl::setvar $obj $prop [list $value]}}\n" -"::xotcl::ObjectParameterSlot public method delete {-nocomplain:switch obj prop value} {\n" -"set old [::xotcl::setvar $obj $prop]\n" +"::next::core::setvar $obj $prop [linsert [::next::core::setvar $obj $prop] $pos $value]} else {\n" +"::next::core::setvar $obj $prop [list $value]}}\n" +"::next::ObjectParameterSlot public method delete {-nocomplain:switch obj prop value} {\n" +"set old [::next::core::setvar $obj $prop]\n" "set p [lsearch -glob $old $value]\n" -"if {$p>-1} {::xotcl::setvar $obj $prop [lreplace $old $p $p]} else {\n" +"if {$p>-1} {::next::core::setvar $obj $prop [lreplace $old $p $p]} else {\n" "error \"$value is not a $prop of $obj (valid are: $old)\"}}\n" -"::xotcl::ObjectParameterSlot method unknown {method args} {\n" +"::next::ObjectParameterSlot method unknown {method args} {\n" "set methods [list]\n" "foreach m [:info callable] {\n" -"if {[::xotcl2::Object info callable $m] ne \"\"} continue\n" +"if {[::next::Object info callable $m] ne \"\"} continue\n" "if {[string match __* $m]} continue\n" "lappend methods $m}\n" -"error \"Method '$method' unknown for slot [::xotcl::current object]; valid are: {[lsort $methods]}\"}\n" -"::xotcl::ObjectParameterSlot public method destroy {} {\n" -"if {${:domain} ne \"\" && [::xotcl::objectproperty ${:domain} class]} {\n" +"error \"Method '$method' unknown for slot [::next::core::current object]; valid are: {[lsort $methods]}\"}\n" +"::next::ObjectParameterSlot public method destroy {} {\n" +"if {${:domain} ne \"\" && [::next::core::objectproperty ${:domain} class]} {\n" "${:domain} __invalidateobjectparameter}\n" -"next}\n" -"::xotcl::ObjectParameterSlot protected method init {args} {\n" +"::next::core::next}\n" +"::next::ObjectParameterSlot protected method init {args} {\n" "if {${:domain} eq \"\"} {\n" -"set :domain [::xotcl::current callingobject]}\n" +"set :domain [::next::core::current callingobject]}\n" "if {${:domain} ne \"\"} {\n" "if {![info exists :methodname]} {\n" "set :methodname ${:name}}\n" -"if {[::xotcl::objectproperty ${:domain} class]} {\n" +"if {[::next::core::objectproperty ${:domain} class]} {\n" "${:domain} __invalidateobjectparameter}\n" "if {${:per-object} && [info exists :default] } {\n" -"::xotcl::setvar ${:domain} ${:name} ${:default}}\n" +"::next::core::setvar ${:domain} ${:name} ${:default}}\n" "set cl [expr {${:per-object} ? \"Object\" : \"Class\"}]\n" -"::xotcl::forward ${:domain} ${:name} \\\n" +"::next::core::forward ${:domain} ${:name} \\\n" "${:manager} \\\n" "[list %1 [${:manager} defaultmethods]] %self \\\n" "${:methodname}}}\n" -"::xotcl::MetaSlot __invalidateobjectparameter\n" -"::xotcl::ObjectParameterSlot method toParameterSyntax {{name:substdefault ${:name}}} {\n" +"::next::MetaSlot __invalidateobjectparameter\n" +"::next::ObjectParameterSlot method toParameterSyntax {{name:substdefault ${:name}}} {\n" "set objparamdefinition $name\n" "set methodparamdefinition \"\"\n" "set objopts [list]\n" @@ -270,7 +273,7 @@ "lappend methodopts required}\n" "if {[info exists :type]} {\n" "if {[string match ::* ${:type}]} {\n" -"set type [expr {[::xotcl::objectproperty ${:type} metaclass] ? \"class\" : \"object\"}]\n" +"set type [expr {[::next::core::objectproperty ${:type} metaclass] ? \"class\" : \"object\"}]\n" "lappend objopts type=${:type}\n" "lappend methodopts type=${:type}} else {\n" "set type ${:type}}}\n" @@ -294,123 +297,126 @@ "if {$type ne \"\"} {\n" "set objopts [linsert $objopts 0 $type]\n" "set methodopts [linsert $methodopts 0 $type]}\n" -"lappend objopts slot=[::xotcl::current object]\n" +"lappend objopts slot=[::next::core::current object]\n" "if {[llength $objopts] > 0} {\n" "append objparamdefinition :[join $objopts ,]}\n" "if {[llength $methodopts] > 0} {\n" "set methodparamdefinition [join $methodopts ,]}\n" "if {[info exists arg]} {\n" "lappend objparamdefinition $arg}\n" "return [list oparam $objparamdefinition mparam $methodparamdefinition]}\n" -"proc ::xotcl::parametersFromSlots {obj} {\n" +"proc ::next::core::parametersFromSlots {obj} {\n" "set parameterdefinitions [list]\n" -"foreach slot [::xotcl2::objectInfo slotobjects $obj] {\n" -"if {[::xotcl::objectproperty $obj type ::xotcl::Object] &&\n" +"foreach slot [::next::objectInfo slotobjects $obj] {\n" +"if {[::next::core::objectproperty $obj type ::xotcl::Object] &&\n" "([$slot name] eq \"mixin\" || [$slot name] eq \"filter\")} continue\n" "array set \"\" [$slot toParameterSyntax]\n" "lappend parameterdefinitions -$(oparam)}\n" "return $parameterdefinitions}\n" -"::xotcl2::Object protected method objectparameter {{lastparameter __initcmd:initcmd,optional}} {\n" -"set parameterdefinitions [::xotcl::parametersFromSlots [::xotcl::current object]]\n" -"if {[::xotcl::objectproperty [::xotcl::current object] class]} {\n" +"::next::Object protected method objectparameter {{lastparameter __initcmd:initcmd,optional}} {\n" +"set parameterdefinitions [::next::core::parametersFromSlots [::next::core::current object]]\n" +"if {[::next::core::objectproperty [::next::core::current object] class]} {\n" "lappend parameterdefinitions -parameter:method,optional}\n" "lappend parameterdefinitions \\\n" "-noinit:method,optional,noarg \\\n" "-volatile:method,optional,noarg \\\n" "{*}$lastparameter\n" "return $parameterdefinitions}\n" -"::xotcl::MetaSlot create ::xotcl::RelationSlot\n" -"createBootstrapAttributeSlots ::xotcl::RelationSlot {\n" +"::next::MetaSlot create ::next::RelationSlot\n" +"createBootstrapAttributeSlots ::next::RelationSlot {\n" "{multivalued true}\n" "{type relation}\n" -"{elementtype ::xotcl2::Class}}\n" -"::xotcl::relation ::xotcl::RelationSlot superclass ::xotcl::ObjectParameterSlot\n" -"::xotcl::alias ::xotcl::RelationSlot assign ::xotcl::relation\n" -"::xotcl::RelationSlot protected method init {} {\n" +"{elementtype ::next::Class}}\n" +"::next::core::relation ::next::RelationSlot superclass ::next::ObjectParameterSlot\n" +"::next::core::alias ::next::RelationSlot assign ::next::core::relation\n" +"::next::RelationSlot protected method init {} {\n" "if {${:type} ne \"relation\"} {\n" "error \"RelationSlot requires type == \\\"relation\\\"\"}\n" -"next}\n" -"::xotcl::RelationSlot protected method delete_value {obj prop old value} {\n" +"::next::core::next}\n" +"::next::RelationSlot protected method delete_value {obj prop old value} {\n" "if {[string first * $value] > -1 || [string first \\[ $value] > -1} {\n" "if {${:elementtype} ne \"\" && ![string match ::* $value]} {\n" "set value ::$value}\n" "return [lsearch -all -not -glob -inline $old $value]} elseif {${:elementtype} ne \"\"} {\n" "if {[string first :: $value] == -1} {\n" -"if {![::xotcl::objectproperty $value object]} {\n" +"if {![::next::core::objectproperty $value object]} {\n" "error \"$value does not appear to be an object\"}\n" -"set value [::xotcl::dispatch $value -objscope ::xotcl::current object]}\n" -"if {![::xotcl::objectproperty ${:elementtype} class]} {\n" +"set value [::next::core::dispatch $value -objscope ::next::core::current object]}\n" +"if {![::next::core::objectproperty ${: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" "return [lreplace $old $p $p]} else {\n" "error \"$value is not a $prop of $obj (valid are: $old)\"}}\n" -"::xotcl::RelationSlot public method delete {-nocomplain:switch obj prop value} {\n" +"::next::RelationSlot public method delete {-nocomplain:switch obj prop value} {\n" "$obj $prop [:delete_value $obj $prop [$obj info $prop] $value]}\n" -"::xotcl::RelationSlot public method get {obj prop} {\n" -"::xotcl::relation $obj $prop}\n" -"::xotcl::RelationSlot public method add {obj prop value {pos 0}} {\n" +"::next::RelationSlot public method get {obj prop} {\n" +"::next::core::relation $obj $prop}\n" +"::next::RelationSlot public method add {obj prop value {pos 0}} {\n" "if {![set :multivalued]} {\n" "error \"Property $prop of ${:domain}->$obj ist not multivalued\"}\n" -"set oldSetting [::xotcl::relation $obj $prop]\n" -"uplevel [list ::xotcl::relation $obj $prop [linsert $oldSetting $pos $value]]}\n" -"::xotcl::RelationSlot public method delete {-nocomplain:switch obj prop value} {\n" -"uplevel [list ::xotcl::relation $obj $prop [:delete_value $obj $prop [::xotcl::relation $obj $prop] $value]]}\n" -"proc ::xotcl::register_system_slots {os} {\n" +"set oldSetting [::next::core::relation $obj $prop]\n" +"uplevel [list ::next::core::relation $obj $prop [linsert $oldSetting $pos $value]]}\n" +"::next::RelationSlot public method delete {-nocomplain:switch obj prop value} {\n" +"uplevel [list ::next::core::relation $obj $prop [:delete_value $obj $prop [::next::core::relation $obj $prop] $value]]}\n" +"proc ::next::core::register_system_slots {os} {\n" "${os}::Object alloc ${os}::Class::slot\n" "${os}::Object alloc ${os}::Object::slot\n" -"::xotcl::RelationSlot create ${os}::Class::slot::superclass\n" -"::xotcl::alias ${os}::Class::slot::superclass assign ::xotcl::relation\n" -"::xotcl::RelationSlot create ${os}::Object::slot::class -multivalued false\n" -"::xotcl::alias ${os}::Object::slot::class assign ::xotcl::relation\n" -"::xotcl::RelationSlot create ${os}::Object::slot::mixin -methodname object-mixin\n" -"::xotcl::RelationSlot create ${os}::Object::slot::filter -elementtype \"\"\n" -"::xotcl::RelationSlot create ${os}::Class::slot::mixin -methodname class-mixin\n" -"::xotcl::RelationSlot create ${os}::Class::slot::filter -elementtype \"\" \\\n" +"::next::RelationSlot create ${os}::Class::slot::superclass\n" +"::next::core::alias ${os}::Class::slot::superclass assign ::next::core::relation\n" +"::next::RelationSlot create ${os}::Object::slot::class -multivalued false\n" +"::next::core::alias ${os}::Object::slot::class assign ::next::core::relation\n" +"::next::RelationSlot create ${os}::Object::slot::mixin -methodname object-mixin\n" +"::next::RelationSlot create ${os}::Object::slot::filter -elementtype \"\"\n" +"::next::RelationSlot create ${os}::Class::slot::mixin -methodname class-mixin\n" +"::next::RelationSlot create ${os}::Class::slot::filter -elementtype \"\" \\\n" "-methodname class-filter\n" -"::xotcl::RelationSlot create ${os}::Class::slot::object-mixin\n" -"::xotcl::RelationSlot create ${os}::Class::slot::object-filter -elementtype \"\"}\n" -"::xotcl::register_system_slots ::xotcl2\n" -"proc ::xotcl::register_system_slots {} {}\n" -"::xotcl::MetaSlot __invalidateobjectparameter\n" -"::xotcl::MetaSlot create ::xotcl::Attribute -superclass ::xotcl::ObjectParameterSlot\n" -"createBootstrapAttributeSlots ::xotcl::Attribute {\n" +"::next::RelationSlot create ${os}::Class::slot::object-mixin\n" +"::next::RelationSlot create ${os}::Class::slot::object-filter -elementtype \"\"}\n" +"::next::core::register_system_slots ::next\n" +"proc ::next::core::register_system_slots {} {}\n" +"::next::MetaSlot __invalidateobjectparameter\n" +"::next::MetaSlot create ::next::Attribute -superclass ::next::ObjectParameterSlot\n" +"createBootstrapAttributeSlots ::next::Attribute {\n" "{value_check once}\n" "incremental\n" "initcmd\n" "valuecmd\n" "valuechangedcmd\n" "arg}\n" -"::xotcl::Attribute method __default_from_cmd {obj cmd var sub op} {\n" -"$obj trace remove variable $var $op [list [::xotcl::current object] [::xotcl::current method] $obj $cmd]\n" -"::xotcl::setvar $obj $var [$obj eval $cmd]}\n" -"::xotcl::Attribute method __value_from_cmd {obj cmd var sub op} {\n" -"::xotcl::setvar $obj $var [$obj eval $cmd]}\n" -"::xotcl::Attribute method __value_changed_cmd {obj cmd var sub op} {\n" +"::next::Attribute method __default_from_cmd {obj cmd var sub op} {\n" +"$obj trace remove variable $var $op [list [::next::core::current object] [::next::core::current method] $obj $cmd]\n" +"::next::core::setvar $obj $var [$obj eval $cmd]}\n" +"::next::Attribute method __value_from_cmd {obj cmd var sub op} {\n" +"::next::core::setvar $obj $var [$obj eval $cmd]}\n" +"::next::Attribute method __value_changed_cmd {obj cmd var sub op} {\n" "eval $cmd}\n" -"::xotcl::Attribute protected method init {} {\n" -"next ;# do first ordinary slot initialization\n" +"::next::Attribute protected method init {} {\n" +"::next::core::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::current object] __default_from_cmd \\[::xotcl::current object\\] [list [set :initcmd]]\\]\\n\"} elseif [:exists valuecmd] {\n" +"\\[list [::next::core::current object] __default_from_cmd \\[::next::core::current object\\] [list [set :initcmd]]\\]\\n\"} elseif [:exists valuecmd] {\n" "append __initcmd \":trace add variable [list ${:name}] read \\\n" -"\\[list [::xotcl::current object] __value_from_cmd \\[::xotcl::current object\\] [list [set :valuecmd]]\\]\"}\n" +"\\[list [::next::core::current object] __value_from_cmd \\[::next::core::current object\\] [list [set :valuecmd]]\\]\"}\n" "array set \"\" [:toParameterSyntax ${:name}]\n" "if {$(mparam) ne \"\"} {\n" "if {[info exists :multivalued] && ${:multivalued}} {\n" -":method assign [list obj var value:$(mparam),multivalued,slot=[::xotcl::current object]] {::xotcl::setvar $obj $var $value}\n" -":method add [list obj prop value:$(mparam),slot=[::xotcl::current object] {pos 0}] {next}} else {\n" -":method assign [list obj var value:$(mparam),slot=[::xotcl::current object]] {::xotcl::setvar $obj $var $value}}}\n" +":method assign [list obj var value:$(mparam),multivalued,slot=[::next::core::current object]] {\n" +"::next::core::setvar $obj $var $value}\n" +":method add [list obj prop value:$(mparam),slot=[::next::core::current object] {pos 0}] {\n" +"::next::core::next}} else {\n" +":method assign [list obj var value:$(mparam),slot=[::next::core::current object]] {\n" +"::next::core::setvar $obj $var $value}}}\n" "if {[:exists valuechangedcmd]} {\n" "append __initcmd \":trace add variable [list ${:name}] write \\\n" -"\\[list [::xotcl::current object] __value_changed_cmd \\[::xotcl::current object\\] [list [set :valuechangedcmd]]\\]\"}\n" +"\\[list [::next::core::current object] __value_changed_cmd \\[::next::core::current object\\] [list [set :valuechangedcmd]]\\]\"}\n" "if {$__initcmd ne \"\"} {\n" "set :initcmd $__initcmd}}\n" -"::xotcl2::Class create ::xotcl::Attribute::Optimizer {\n" -":method method args {::xotcl::next; :optimize}\n" -":method forward args {::xotcl::next; :optimize}\n" -":protected method init args {::xotcl::next; :optimize}\n" +"::next::Class create ::next::Attribute::Optimizer {\n" +":method method args {::next::core::next; :optimize}\n" +":method forward args {::next::core::next; :optimize}\n" +":protected method init args {::next::core::next; :optimize}\n" ":public method optimize {} {\n" "if {![info exists :methodname]} {return}\n" "set object [expr {${:per-object} ? {object} : {}}]\n" @@ -419,163 +425,157 @@ "set infokind Object} else {\n" "set perObject \"\"\n" "set infokind Class}\n" -"if {[::xotcl::cmd::${infokind}Info::method ${:domain} name ${:name}] ne \"\"} {\n" -"::xotcl::forward ${:domain} {*}$perObject ${:name} \\\n" +"if {[::next::core::cmd::${infokind}Info::method ${:domain} name ${:name}] ne \"\"} {\n" +"::next::core::forward ${:domain} {*}$perObject ${:name} \\\n" "${:manager} \\\n" "[list %1 [${:manager} defaultmethods]] %self \\\n" "${:methodname}}\n" "if {[info exists :incremental] && ${:incremental}} return\n" "if {[set :defaultmethods] ne {get assign}} return\n" "set assignInfo [:info callable -which assign]\n" -"if {$assignInfo ne \"::xotcl::ObjectParameterSlot alias assign ::xotcl::setvar\" &&\n" -"[lindex $assignInfo {end 0}] ne \"::xotcl::setvar\" } return\n" -"if {[:info callable -which get] ne \"::xotcl::ObjectParameterSlot alias get ::xotcl::setvar\"} return\n" +"if {$assignInfo ne \"::next::ObjectParameterSlot alias assign ::next::core::setvar\" &&\n" +"[lindex $assignInfo {end 0}] ne \"::next::core::setvar\" } return\n" +"if {[:info callable -which get] ne \"::next::ObjectParameterSlot alias get ::next::core::setvar\"} return\n" "array set \"\" [:toParameterSyntax ${:name}]\n" "if {$(mparam) ne \"\"} {\n" "set setterParam [lindex $(oparam) 0]} else {\n" "set setterParam ${:name}}\n" -"::xotcl::setter ${:domain} {*}$perObject $setterParam}}\n" -"::xotcl::Attribute mixin add ::xotcl::Attribute::Optimizer\n" -"::xotcl2::Class method attribute {spec {-slotclass ::xotcl::Attribute} {initblock \"\"}} {\n" -"$slotclass createFromParameterSyntax [::xotcl::current object] -initblock $initblock {*}$spec}\n" -"::xotcl2::Object method attribute {spec {-slotclass ::xotcl::Attribute} {initblock \"\"}} {\n" -"$slotclass createFromParameterSyntax [::xotcl::current object] -per-object -initblock $initblock {*}$spec}\n" -"::xotcl2::Class public method parameter arglist {\n" +"::next::core::setter ${:domain} {*}$perObject $setterParam}}\n" +"::next::Attribute mixin add ::next::Attribute::Optimizer\n" +"::next::Class method attribute {spec {-slotclass ::next::Attribute} {initblock \"\"}} {\n" +"$slotclass createFromParameterSyntax [::next::core::current object] -initblock $initblock {*}$spec}\n" +"::next::Object method attribute {spec {-slotclass ::next::Attribute} {initblock \"\"}} {\n" +"$slotclass createFromParameterSyntax [::next::core::current object] -per-object -initblock $initblock {*}$spec}\n" +"::next::Class public method parameter arglist {\n" "foreach arg $arglist {\n" -"::xotcl::Attribute createFromParameterSyntax [::xotcl::current object] {*}$arg}\n" -"set slot [::xotcl::current object]::slot\n" -"if {![::xotcl::objectproperty $slot object]} {::xotcl2::Object create $slot}\n" -"::xotcl::setvar $slot __parameter $arglist}\n" +"::next::Attribute createFromParameterSyntax [::next::core::current object] {*}$arg}\n" +"set slot [::next::core::current object]::slot\n" +"if {![::next::core::objectproperty $slot object]} {::next::Object create $slot}\n" +"::next::core::setvar $slot __parameter $arglist}\n" "proc createBootstrapAttributeSlots {} {}\n" -"::xotcl::Slot method type=hasmixin {name value arg} {\n" -"if {![::xotcl::objectproperty $value hasmixin $arg]} {\n" +"::next::Slot method type=hasmixin {name value arg} {\n" +"if {![::next::core::objectproperty $value hasmixin $arg]} {\n" "error \"expected object with mixin $arg but got \\\"$value\\\" for parameter $name\"}\n" "return $value}\n" -"::xotcl::Slot method type=baseclass {name value} {\n" -"if {![::xotcl::objectproperty $value baseclass]} {\n" +"::next::Slot method type=baseclass {name value} {\n" +"if {![::next::core::objectproperty $value baseclass]} {\n" "error \"expected baseclass but got \\\"$value\\\" for parameter $name\"}\n" "return $value}\n" -"::xotcl::Slot method type=metaclass {name value} {\n" -"if {![::xotcl::objectproperty $value metaclass]} {\n" +"::next::Slot method type=metaclass {name value} {\n" +"if {![::next::core::objectproperty $value metaclass]} {\n" "error \"expected metaclass but got \\\"$value\\\" for parameter $name\"}\n" "return $value}}\n" -"::xotcl2::Class create ::xotcl::ScopedNew -superclass ::xotcl2::Class {\n" -":attribute {withclass ::xotcl2::Object}\n" +"::next::Class create ::next::ScopedNew -superclass ::next::Class {\n" +":attribute {withclass ::next::Object}\n" ":attribute container\n" ":protected method init {} {\n" ":public method new {-childof args} {\n" -"::xotcl::importvar [::xotcl::current class] {container object} withclass\n" -"if {![::xotcl::objectproperty $object object]} {\n" +"::next::core::importvar [::next::core::current class] {container object} withclass\n" +"if {![::next::core::objectproperty $object object]} {\n" "$withclass create $object}\n" -"eval ::xotcl::next -childof $object $args}}}\n" -"::xotcl2::Object public method contains {\n" +"eval ::next::core::next -childof $object $args}}}\n" +"::next::Object public method contains {\n" "{-withnew:boolean true}\n" "-object\n" -"{-class ::xotcl2::Object}\n" +"{-class ::next::Object}\n" "cmds} {\n" -"if {![info exists object]} {set object [::xotcl::current object]}\n" -"if {![::xotcl::objectproperty $object object]} {$class create $object}\n" +"if {![info exists object]} {set object [::next::core::current object]}\n" +"if {![::next::core::objectproperty $object object]} {$class create $object}\n" "$object requireNamespace\n" "if {$withnew} {\n" -"set m [::xotcl::ScopedNew new -volatile \\\n" +"set m [::next::ScopedNew new -volatile \\\n" "-container $object -withclass $class]\n" -"::xotcl2::Class mixin add $m end\n" -"if {[::xotcl::objectproperty ::xotcl::Class class]} {::xotcl::Class instmixin add $m end}\n" +"::next::Class mixin add $m end\n" +"if {[::next::core::objectproperty ::xotcl::Class class]} {::xotcl::Class instmixin add $m end}\n" "namespace eval $object $cmds\n" -"::xotcl2::Class mixin delete $m\n" -"if {[::xotcl::objectproperty ::xotcl::Class class]} {::xotcl::Class instmixin delete $m}} else {\n" +"::next::Class mixin delete $m\n" +"if {[::next::core::objectproperty ::xotcl::Class class]} {::xotcl::Class instmixin delete $m}} else {\n" "namespace eval $object $cmds}}\n" -"::xotcl2::Class forward slots %self contains \\\n" -"-object {%::xotcl::dispatch [::xotcl::current object] -objscope ::subst [::xotcl::current object]::slot}\n" -"::xotcl2::Class create ::xotcl::CopyHandler {\n" +"::next::Class forward slots %self contains \\\n" +"-object {%::next::core::dispatch [::next::core::current object] -objscope ::subst [::next::core::current object]::slot}\n" +"::next::Class create ::next::CopyHandler {\n" ":attribute {targetList \"\"}\n" ":attribute {dest \"\"}\n" ":attribute objLength\n" ":method makeTargetList {t} {\n" "lappend :targetList $t\n" -"if {[::xotcl::objectproperty $t object]} {\n" +"if {[::next::core::objectproperty $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::objectproperty $c object]} {\n" +"if {![::next::core::objectproperty $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" +"::next::core::namespace_copyvars $orig $dest\n" +"::next::core::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::objectproperty $origin object]} {\n" -"if {[::xotcl::objectproperty $origin class]} {\n" +"if {[::next::core::objectproperty $origin object]} {\n" +"if {[::next::core::objectproperty $origin class]} {\n" "set cl [[$origin info class] create $dest -noinit]\n" "set obj $cl\n" "$cl superclass [$origin info superclass]\n" -"::xotcl::assertion $cl class-invar [::xotcl::assertion $origin class-invar]\n" -"::xotcl::relation $cl class-filter [::xotcl::relation $origin class-filter]\n" -"::xotcl::relation $cl class-mixin [::xotcl::relation $origin class-mixin]\n" -":copyNSVarsAndCmds ::xotcl::classes$origin ::xotcl::classes$dest} else {\n" +"::next::core::assertion $cl class-invar [::next::core::assertion $origin class-invar]\n" +"::next::core::relation $cl class-filter [::next::core::relation $origin class-filter]\n" +"::next::core::relation $cl class-mixin [::next::core::relation $origin class-mixin]\n" +":copyNSVarsAndCmds ::next::core::classes$origin ::next::core::classes$dest} else {\n" "set obj [[$origin info class] create $dest -noinit]}\n" -"::xotcl::assertion $obj check [::xotcl::assertion $origin check]\n" -"::xotcl::assertion $obj object-invar [::xotcl::assertion $origin object-invar]\n" -"::xotcl::relation $obj object-filter [::xotcl::relation $origin object-filter]\n" -"::xotcl::relation $obj object-mixin [::xotcl::relation $origin object-mixin]\n" +"::next::core::assertion $obj check [::next::core::assertion $origin check]\n" +"::next::core::assertion $obj object-invar [::next::core::assertion $origin object-invar]\n" +"::next::core::relation $obj object-filter [::next::core::relation $origin object-filter]\n" +"::next::core::relation $obj object-mixin [::next::core::relation $origin object-mixin]\n" "if {[$origin info hasnamespace]} {\n" "$obj requireNamespace}} else {\n" "namespace eval $dest {}}\n" ":copyNSVarsAndCmds $origin $dest\n" -"foreach i [::xotcl::cmd::ObjectInfo::forward $origin] {\n" -"eval [concat ::xotcl::forward $dest -per-object $i [::xotcl::cmd::ObjectInfo::forward $origin -definition $i]]}\n" -"if {[::xotcl::objectproperty $origin class]} {\n" -"foreach i [::xotcl::cmd::ClassInfo::forward $origin] {\n" -"eval [concat ::xotcl::forward $dest $i [::xotcl::cmd::ClassInfo::forward $origin -definition $i]]}}\n" +"foreach i [::next::core::cmd::ObjectInfo::forward $origin] {\n" +"eval [concat ::next::core::forward $dest -per-object $i [::next::core::cmd::ObjectInfo::forward $origin -definition $i]]}\n" +"if {[::next::core::objectproperty $origin class]} {\n" +"foreach i [::next::core::cmd::ClassInfo::forward $origin] {\n" +"eval [concat ::next::core::forward $dest $i [::next::core::cmd::ClassInfo::forward $origin -definition $i]]}}\n" "set traces [list]\n" "foreach var [$origin info vars] {\n" -"set cmds [::xotcl::dispatch $origin -objscope ::trace info variable $var]\n" +"set cmds [::next::core::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::objectproperty $origin class]} {\n" +"if {[::next::core::objectproperty $origin class]} {\n" "set dest [:getDest $origin]\n" "foreach oldslot [$origin info slots] {\n" -"set newslot [::xotcl::Slot slotName [namespace tail $oldslot] $dest]\n" +"set newslot [::next::Slot slotName [namespace tail $oldslot] $dest]\n" "if {[$oldslot domain] eq $origin} {$newslot domain $cl}\n" "if {[$oldslot manager] eq $oldslot} {$newslot manager $newslot}}}}}\n" ":public method copy {obj dest} {\n" "set :objLength [string length $obj]\n" "set :dest $dest\n" ":makeTargetList $obj\n" ":copyTargets}}\n" -"::xotcl2::Object public method copy newName {\n" -"if {[string compare [string trimleft $newName :] [string trimleft [::xotcl::current object] :]]} {\n" -"[::xotcl::CopyHandler new -volatile] copy [::xotcl::current object] $newName}}\n" -"::xotcl2::Object public method move newName {\n" -"if {[string trimleft $newName :] ne [string trimleft [::xotcl::current object] :]} {\n" +"::next::Object public method copy newName {\n" +"if {[string compare [string trimleft $newName :] [string trimleft [::next::core::current object] :]]} {\n" +"[::next::CopyHandler new -volatile] copy [::next::core::current object] $newName}}\n" +"::next::Object public method move newName {\n" +"if {[string trimleft $newName :] ne [string trimleft [::next::core::current object] :]} {\n" "if {$newName ne \"\"} {\n" ":copy $newName}\n" -"if {[::xotcl::objectproperty [::xotcl::current object] class] && $newName ne \"\"} {\n" +"if {[::next::core::objectproperty [::next::core::current object] class] && $newName ne \"\"} {\n" "foreach subclass [:info subclass] {\n" "set scl [$subclass info superclass]\n" -"if {[set index [lsearch -exact $scl [::xotcl::current object]]] != -1} {\n" +"if {[set index [lsearch -exact $scl [::next::core::current object]]] != -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" -"namespace export @ Attribute current\n" -"if {![info exists ::env(HOME)]} {set ::env(HOME) /root}\n" -"set ::xotcl::confdir ~/.xotcl\n" -"set ::xotcl::logdir $::xotcl::confdir/log\n" +"namespace eval ::next::core {\n" "proc tmpdir {} {\n" "foreach e [list TMPDIR TEMP TMP] {\n" "if {[info exists ::env($e)] \\\n" @@ -590,12 +590,19 @@ "proc use {version} {\n" "set callingNs [uplevel {namespace current}]\n" "switch -exact $version {\n" +"xotcl -\n" "xotcl1 {\n" -"package require xotcl1\n" +"package require XOTcl\n" "if {$callingNs ne \"::xotcl\"} {uplevel {namespace import -force ::xotcl::*}}}\n" "default {\n" "if {$callingNs ne \"::xotcl\"} {uplevel {namespace import -force ::xotcl::*}}\n" -"if {$callingNs ne \"::xotcl2\"} {uplevel {namespace import -force ::xotcl2::*}}}}}\n" +"if {$callingNs ne \"::next\"} {uplevel {namespace import -force ::next::*}}}}}\n" +"namespace export tmpdir use}\n" +"namespace eval ::next {\n" +"namespace export Attribute current\n" +"if {![info exists ::env(HOME)]} {set ::env(HOME) /root}\n" +"set ::next::confdir ~/.xotcl\n" +"set ::next::logdir $::next::confdir/log\n" "unset bootstrap}\n" ""; Index: generic/predefined.xotcl =================================================================== diff -u -r9474936bd01f25c80caa91f9b3164a3072457f66 -r81c800c8b9cb42ef6743d9b80ac2be5ca211a69a --- generic/predefined.xotcl (.../predefined.xotcl) (revision 9474936bd01f25c80caa91f9b3164a3072457f66) +++ generic/predefined.xotcl (.../predefined.xotcl) (revision 81c800c8b9cb42ef6743d9b80ac2be5ca211a69a) @@ -1,18 +1,17 @@ -namespace eval ::xotcl { + +namespace eval ::next { # # 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 path ::xotcl -namespace eval xotcl2 { - namespace path ::xotcl - ::xotcl::createobjectsystem ::xotcl2::Object ::xotcl2::Class { + # + # First create the ::next object system. + # + ::next::core::createobjectsystem ::next::Object ::next::Class { -class.alloc alloc -class.create create -class.dealloc dealloc @@ -28,54 +27,65 @@ -object.unknown unknown } - # provide the standard command set for ::xotcl2::Object - foreach cmd [info command ::xotcl::cmd::Object::*] { + # + # get frequenly used primitiva into the ::next namespace + # + namespace eval ::next::core { + namespace export next self \ + my is relation interp + } + namespace import ::next::core::next ::next::core::self + + # + # provide the standard command set for ::next::Object + # + foreach cmd [info command ::next::core::cmd::Object::*] { set cmdName [namespace tail $cmd] if {$cmdName in [list "instvar"]} continue - ::xotcl::alias Object $cmdName $cmd + ::next::core::alias Object $cmdName $cmd } - # provide ::eval as method for ::xotcl2::Object - ::xotcl::alias Object eval -nonleaf ::eval + # provide ::eval as method for ::next::Object + ::next::core::alias Object eval -nonleaf ::eval # provide the standard command set for Class - foreach cmd [info command ::xotcl::cmd::Class::*] { + foreach cmd [info command ::next::core::cmd::Class::*] { set cmdName [namespace tail $cmd] - ::xotcl::alias Class $cmdName $cmd + ::next::core::alias Class $cmdName $cmd } # set a few aliases as protected foreach cmd [list __next cleanup noinit residualargs uplevel upvar] { - ::xotcl::methodproperty Object $cmd protected 1 + ::next::core::methodproperty Object $cmd protected 1 } foreach cmd [list recreate] { - ::xotcl::methodproperty Class $cmd protected 1 + ::next::core::methodproperty Class $cmd protected 1 } # TODO: info methods shows finally "slots" and "slot". Wanted? # protect some methods against redefinition - ::xotcl::methodproperty Object destroy redefine-protected true - ::xotcl::methodproperty Class alloc redefine-protected true - ::xotcl::methodproperty Class dealloc redefine-protected true - ::xotcl::methodproperty Class create redefine-protected true + ::next::core::methodproperty Object destroy redefine-protected true + ::next::core::methodproperty Class alloc redefine-protected true + ::next::core::methodproperty Class dealloc redefine-protected true + ::next::core::methodproperty Class create redefine-protected true # define method "method" for Class and Object - ::xotcl::method Class method { + ::next::core::method Class method { name arguments body -precondition -postcondition } { set conditions [list] if {[info exists precondition]} {lappend conditions -precondition $precondition} if {[info exists postcondition]} {lappend conditions -postcondition $postcondition} - ::xotcl::method [::xotcl::current object] $name $arguments $body {*}$conditions + ::next::core::method [::next::core::current object] $name $arguments $body {*}$conditions } - ::xotcl::method Object method { + ::next::core::method Object method { name arguments body -precondition -postcondition } { set conditions [list] if {[info exists precondition]} {lappend conditions -precondition $precondition} if {[info exists postcondition]} {lappend conditions -postcondition $postcondition} - ::xotcl::method [::xotcl::current object] -per-object $name $arguments $body {*}$conditions + ::next::core::method [::next::core::current object] -per-object $name $arguments $body {*}$conditions } # define method modifiers "object", "public" and "protected" @@ -84,26 +94,26 @@ # method-modifier for object specific methos :method object {what args} { if {$what in [list "alias" "attribute" "forward" "method" "setter"]} { - return [::xotcl::dispatch [::xotcl::current object] ::xotcl::classes::xotcl2::Object::$what {*}$args] + return [::next::core::dispatch [::next::core::current object] ::next::core::classes::next::Object::$what {*}$args] } if {$what in [list "info"]} { - return [::xotcl2::objectInfo [lindex $args 0] [::xotcl::current object] {*}[lrange $args 1 end]] + return [::next::objectInfo [lindex $args 0] [::next::core::current object] {*}[lrange $args 1 end]] } if {$what in [list "filter" "mixin"]} { return [:object-$what {*}$args] } if {$what in [list "filterguard" "mixinguard"]} { - return [::xotcl::dispatch [::xotcl::current object] ::xotcl::cmd::Object::$what {*}$args] + return [::next::core::dispatch [::next::core::current object] ::next::core::cmd::Object::$what {*}$args] } } # define unknown handler for class :method unknown {m args} { - error "Method '$m' unknown for [::xotcl::current object].\ - Consider '[::xotcl::current object] create $m $args' instead of '[::xotcl::current object] $m $args'" + error "Method '$m' unknown for [::next::core::current object].\ + Consider '[::next::core::current object] create $m $args' instead of '[::next::core::current object] $m $args'" } # protected is not jet defined - ::xotcl::methodproperty [::xotcl::current object] unknown protected 1 + ::next::core::methodproperty [::next::core::current object] unknown protected 1 } @@ -114,7 +124,7 @@ set p [lsearch -regexp $args {^(method|alias|attribute|forward|setter)$}] if {$p == -1} {error "$args is not a method defining method"} set r [{*}:$args] - ::xotcl::methodproperty [::xotcl::current object] $r protected false + ::next::core::methodproperty [::next::core::current object] $r protected false return $r } @@ -123,31 +133,31 @@ set p [lsearch -regexp $args {^(method|alias|attribute|forward|setter)$}] if {$p == -1} {error "$args is not a method defining command"} set r [{*}:$args] - ::xotcl::methodproperty [::xotcl::current object] $r [::xotcl::current method] true + ::next::core::methodproperty [::next::core::current object] $r [::next::core::current method] true return $r } # unknown handler for Object :protected method unknown {m args} { - if {![::xotcl::current isnext]} { - error "[::xotcl::current object]: unable to dispatch method '$m'" + if {![::next::core::current isnext]} { + error "[::next::core::current object]: unable to dispatch method '$m'" } } # "init" must exist on Object. per default it is empty. :protected method init args {} # this method is called on calls to object without a specified method - :protected method defaultmethod {} {::xotcl::current object} + :protected method defaultmethod {} {::next::core::current object} # provide a placeholder for the bootup process. The real definition # is based on slots, which are not available at this point. :protected method objectparameter {} {;} } # define forward methods - ::xotcl::forward Object forward ::xotcl::forward %self -per-object - ::xotcl::forward Class forward ::xotcl::forward %self + ::next::core::forward Object forward ::next::core::forward %self -per-object + ::next::core::forward Class forward ::next::core::forward %self # The method __unknown is called in cases, where we try to resolve # an unkown class. one could define a custom resolver with this name @@ -164,13 +174,13 @@ # -objscope implies -nonleaf # Object public method alias {-nonleaf:switch -objscope:switch methodName cmd} { - ::xotcl::alias [::xotcl::current object] -per-object $methodName \ + ::next::core::alias [::next::core::current object] -per-object $methodName \ {*}[expr {${objscope} ? "-objscope" : ""}] \ {*}[expr {${nonleaf} ? "-nonleaf" : ""}] \ $cmd } Class public method alias {-nonleaf:switch -objscope:switch methodName cmd} { - ::xotcl::alias [::xotcl::current object] $methodName \ + ::next::core::alias [::next::core::current object] $methodName \ {*}[expr {${objscope} ? "-objscope" : ""}] \ {*}[expr {${nonleaf} ? "-nonleaf" : ""}] \ $cmd @@ -179,64 +189,64 @@ # Add setter methods. # Object public method setter {methodName} { - ::xotcl::setter [::xotcl::current object] -per-object $methodName + ::next::core::setter [::next::core::current object] -per-object $methodName } Class public method setter {methodName} { - ::xotcl::setter [::xotcl::current object] $methodName + ::next::core::setter [::next::core::current object] $methodName } ######################## # Info definition ######################## - Object create ::xotcl2::objectInfo - Object create ::xotcl2::classInfo + Object create ::next::objectInfo + Object create ::next::classInfo # # It would be nice to do here "objectInfo configure {alias ..}", but # we have no working objectparameter yet due to bootstrapping # objectInfo eval { - :alias is ::xotcl::objectproperty + :alias is ::next::core::objectproperty # info info :public method info {obj} { set methods [list] - foreach name [::xotcl::cmd::ObjectInfo::methods [::xotcl::current object]] { + foreach name [::next::core::cmd::ObjectInfo::methods [::next::core::current object]] { if {$name eq "unknown"} continue lappend methods $name } return "valid options are: [join [lsort $methods] {, }]" } :method unknown {method obj args} { - error "[::xotcl::current object] unknown info option \"$method\"; [$obj info info]" + error "[::next::core::current object] unknown info option \"$method\"; [$obj info info]" } } classInfo eval { - :alias is ::xotcl::objectproperty - :alias classparent ::xotcl::cmd::ObjectInfo::parent - :alias classchildren ::xotcl::cmd::ObjectInfo::children - :alias info [::xotcl::cmd::ObjectInfo::method objectInfo name info] - :alias unknown [::xotcl::cmd::ObjectInfo::method objectInfo name info] + :alias is ::next::core::objectproperty + :alias classparent ::next::core::cmd::ObjectInfo::parent + :alias classchildren ::next::core::cmd::ObjectInfo::children + :alias info [::next::core::cmd::ObjectInfo::method objectInfo name info] + :alias unknown [::next::core::cmd::ObjectInfo::method objectInfo name info] } - foreach cmd [info command ::xotcl::cmd::ObjectInfo::*] { - ::xotcl::alias ::xotcl2::objectInfo [namespace tail $cmd] $cmd - ::xotcl::alias ::xotcl2::classInfo [namespace tail $cmd] $cmd + foreach cmd [info command ::next::core::cmd::ObjectInfo::*] { + ::next::core::alias ::next::objectInfo [namespace tail $cmd] $cmd + ::next::core::alias ::next::classInfo [namespace tail $cmd] $cmd } - foreach cmd [info command ::xotcl::cmd::ClassInfo::*] { + foreach cmd [info command ::next::core::cmd::ClassInfo::*] { set cmdName [namespace tail $cmd] if {$cmdName in [list "object-mixin-of" "class-mixin-of"]} continue - ::xotcl::alias ::xotcl2::classInfo $cmdName $cmd + ::next::core::alias ::next::classInfo $cmdName $cmd } unset cmd # register method "info" on Object and Class - Object forward info -onerror ::xotcl::infoError ::xotcl2::objectInfo %1 {%@2 %self} - Class forward info -onerror ::xotcl::infoError ::xotcl2::classInfo %1 {%@2 %self} + Object forward info -onerror ::next::core::infoError ::next::objectInfo %1 {%@2 %self} + Class forward info -onerror ::next::core::infoError ::next::classInfo %1 {%@2 %self} - proc ::xotcl::infoError msg { + proc ::next::core::infoError msg { #puts stderr "INFO ERROR: <$msg>\n$::errorInfo" regsub -all " " $msg "" msg regsub -all " " $msg "" msg @@ -252,9 +262,9 @@ error "invalid method type '$methtype', must be 'method'" } set body " - if {!\[::xotcl::current isnextcall\]} { + if {!\[::next::core::current isnextcall\]} { error \"Abstract method $methname $arglist called\" - } else {::xotcl::next} + } else {::next::core::next} " if {${per-object}} { :method -per-object $methname $arglist $body @@ -266,43 +276,43 @@ # # exit handlers # - proc ::xotcl::unsetExitHandler {} { - proc ::xotcl::__exitHandler {} { + proc ::next::core::unsetExitHandler {} { + proc ::next::core::__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} + proc ::next::core::setExitHandler {newbody} {::proc ::next::core::__exitHandler {} $newbody} + proc ::next::core::getExitHandler {} {::info body ::next::core::__exitHandler} # initialize exit handler - ::xotcl::unsetExitHandler + ::next::core::unsetExitHandler - namespace export Object Class + namespace export Object Class next self } ######################################## # Slot definitions ######################################## -namespace eval ::xotcl { +namespace eval ::next { # # We are in bootstrap code; we cannot use slots/parameter to define # slots, so the code is a little low level. After the defintion of # the slots, we can use slot-based code such as "-parameter" or # "objectparameter". # - ::xotcl2::Class create ::xotcl::MetaSlot - ::xotcl::relation ::xotcl::MetaSlot superclass ::xotcl2::Class + ::next::Class create ::next::MetaSlot + ::next::core::relation ::next::MetaSlot superclass ::next::Class - ::xotcl::MetaSlot public method slotName {name baseObject} { + ::next::MetaSlot public method slotName {name baseObject} { # Create slot parent object if needed set slotParent ${baseObject}::slot - if {![::xotcl::objectproperty ${slotParent} object]} { - ::xotcl2::Object create ${slotParent} + if {![::next::core::objectproperty ${slotParent} object]} { + ::next::Object create ${slotParent} } return ${slotParent}::$name } - ::xotcl::MetaSlot method createFromParameterSyntax {target -per-object:switch + ::next::MetaSlot method createFromParameterSyntax {target -per-object:switch {-initblock ""} value default:optional} { set opts [list] @@ -343,40 +353,34 @@ } :create [:slotName $name $target] {*}$opts $initblock - return [::xotcl::cmd::${info}::method $target name $name] + return [::next::core::cmd::${info}::method $target name $name] } - - # ::xotcl::MetaSlot public method new args { - # set slotobject [::xotcl::current callingobject]::slot - # if {![::xotcl::objectproperty $slotobject object]} {::xotcls::Object create $slotobject} - # eval next -childof $slotobject $args - # } - ::xotcl::MetaSlot create ::xotcl::Slot - ::xotcl::MetaSlot create ::xotcl::ObjectParameterSlot - ::xotcl::relation ::xotcl::ObjectParameterSlot superclass ::xotcl::Slot + ::next::MetaSlot create ::next::Slot + ::next::MetaSlot create ::next::ObjectParameterSlot + ::next::core::relation ::next::ObjectParameterSlot superclass ::next::Slot # # create class and object for method parameter slots - ::xotcl::MetaSlot create ::xotcl::MethodParameterSlot - ::xotcl::relation ::xotcl::MethodParameterSlot superclass ::xotcl::Slot + ::next::MetaSlot create ::next::MethodParameterSlot + ::next::core::relation ::next::MethodParameterSlot superclass ::next::Slot # create an object for dispatching - ::xotcl::MethodParameterSlot create ::xotcl::methodParameterSlot + ::next::MethodParameterSlot create ::next::methodParameterSlot # use low level interface for defining slot values. Normally, this is # done via slot objects, which are defined later. proc createBootstrapAttributeSlots {class definitions} { foreach att $definitions { if {[llength $att]>1} {foreach {att default} $att break} - set slotObj [::xotcl::ObjectParameterSlot slotName $att $class] - ::xotcl::ObjectParameterSlot create $slotObj + set slotObj [::next::ObjectParameterSlot slotName $att $class] + ::next::ObjectParameterSlot create $slotObj if {[info exists default]} { - ::xotcl::setvar $slotObj default $default + ::next::core::setvar $slotObj default $default unset default } - ::xotcl::setter $class $att + ::next::core::setter $class $att } # @@ -388,14 +392,14 @@ if {[info exists default]} { # checking subclasses is not required during bootstrap - foreach i [::xotcl::cmd::ClassInfo::instances $class] { + foreach i [::next::core::cmd::ClassInfo::instances $class] { if {![$i exists $att]} { if {[string match {*\[*\]*} $default]} { - set value [::xotcl::dispatch $i -objscope ::eval subst $default] + set value [::next::core::dispatch $i -objscope ::eval subst $default] } else { set value $default } - ::xotcl::setvar $i $att $value + ::next::core::setvar $i $att $value } } unset default @@ -410,82 +414,82 @@ ############################################ # Define slots for slots ############################################ - createBootstrapAttributeSlots ::xotcl::Slot { + createBootstrapAttributeSlots ::next::Slot { {name} {multivalued false} {required false} default type } - createBootstrapAttributeSlots ::xotcl::ObjectParameterSlot { - {name "[namespace tail [::xotcl::current object]]"} + createBootstrapAttributeSlots ::next::ObjectParameterSlot { + {name "[namespace tail [::next::core::current object]]"} {methodname} - {domain "[lindex [regexp -inline {^(.*)::slot::[^:]+$} [::xotcl::current object]] 1]"} + {domain "[lindex [regexp -inline {^(.*)::slot::[^:]+$} [::next::core::current object]] 1]"} {defaultmethods {get assign}} - {manager "[::xotcl::current object]"} + {manager "[::next::core::current object]"} {per-object false} } # maybe add the following slots at some later time here # initcmd # valuecmd # valuechangedcmd - ::xotcl::alias ::xotcl::ObjectParameterSlot get ::xotcl::setvar - ::xotcl::alias ::xotcl::ObjectParameterSlot assign ::xotcl::setvar + ::next::core::alias ::next::ObjectParameterSlot get ::next::core::setvar + ::next::core::alias ::next::ObjectParameterSlot assign ::next::core::setvar - ::xotcl::ObjectParameterSlot public method add {obj prop value {pos 0}} { + ::next::ObjectParameterSlot public method add {obj prop value {pos 0}} { if {![set :multivalued]} { error "Property $prop of [set :domain]->$obj ist not multivalued" } if {[$obj exists $prop]} { - ::xotcl::setvar $obj $prop [linsert [::xotcl::setvar $obj $prop] $pos $value] + ::next::core::setvar $obj $prop [linsert [::next::core::setvar $obj $prop] $pos $value] } else { - ::xotcl::setvar $obj $prop [list $value] + ::next::core::setvar $obj $prop [list $value] } } - ::xotcl::ObjectParameterSlot public method delete {-nocomplain:switch obj prop value} { - set old [::xotcl::setvar $obj $prop] + ::next::ObjectParameterSlot public method delete {-nocomplain:switch obj prop value} { + set old [::next::core::setvar $obj $prop] set p [lsearch -glob $old $value] - if {$p>-1} {::xotcl::setvar $obj $prop [lreplace $old $p $p]} else { + if {$p>-1} {::next::core::setvar $obj $prop [lreplace $old $p $p]} else { error "$value is not a $prop of $obj (valid are: $old)" } } - ::xotcl::ObjectParameterSlot method unknown {method args} { + ::next::ObjectParameterSlot method unknown {method args} { set methods [list] foreach m [:info callable] { - if {[::xotcl2::Object info callable $m] ne ""} continue + if {[::next::Object info callable $m] ne ""} continue if {[string match __* $m]} continue lappend methods $m } - error "Method '$method' unknown for slot [::xotcl::current object]; valid are: {[lsort $methods]}" + error "Method '$method' unknown for slot [::next::core::current object]; valid are: {[lsort $methods]}" } - ::xotcl::ObjectParameterSlot public method destroy {} { - if {${:domain} ne "" && [::xotcl::objectproperty ${:domain} class]} { + ::next::ObjectParameterSlot public method destroy {} { + if {${:domain} ne "" && [::next::core::objectproperty ${:domain} class]} { ${:domain} __invalidateobjectparameter } - next + ::next::core::next } - ::xotcl::ObjectParameterSlot protected method init {args} { + ::next::ObjectParameterSlot protected method init {args} { if {${:domain} eq ""} { - set :domain [::xotcl::current callingobject] + set :domain [::next::core::current callingobject] } if {${:domain} ne ""} { if {![info exists :methodname]} { set :methodname ${:name} } - if {[::xotcl::objectproperty ${:domain} class]} { + if {[::next::core::objectproperty ${:domain} class]} { ${:domain} __invalidateobjectparameter } if {${:per-object} && [info exists :default] } { - ::xotcl::setvar ${:domain} ${:name} ${:default} + ::next::core::setvar ${:domain} ${:name} ${:default} } set cl [expr {${:per-object} ? "Object" : "Class"}] - #puts stderr "Slot [::xotcl::current object] init, forwarder on ${:domain}" - ::xotcl::forward ${:domain} ${:name} \ + #puts stderr "Slot [::next::core::current object] init, forwarder on ${:domain}" + ::next::core::forward ${:domain} ${:name} \ ${:manager} \ [list %1 [${:manager} defaultmethods]] %self \ ${:methodname} @@ -499,11 +503,11 @@ # definition here before we refine the slot definitions. # # Invalidate previously defined object parameter. - ::xotcl::MetaSlot __invalidateobjectparameter + ::next::MetaSlot __invalidateobjectparameter # Provide the a slot based mechanism for building an object # configuration interface from slot definitions - ::xotcl::ObjectParameterSlot method toParameterSyntax {{name:substdefault ${:name}}} { + ::next::ObjectParameterSlot method toParameterSyntax {{name:substdefault ${:name}}} { set objparamdefinition $name set methodparamdefinition "" set objopts [list] @@ -515,7 +519,7 @@ } if {[info exists :type]} { if {[string match ::* ${:type}]} { - set type [expr {[::xotcl::objectproperty ${:type} metaclass] ? "class" : "object"}] + set type [expr {[::next::core::objectproperty ${:type} metaclass] ? "class" : "object"}] lappend objopts type=${:type} lappend methodopts type=${:type} } else { @@ -550,14 +554,14 @@ if {${:methodname} ne ${:name}} { lappend objopts arg=${:methodname} lappend methodopts arg=${:methodname} - #puts stderr "..... setting arg for methodname: [::xotcl::current object] has arg arg=${:methodname}" + #puts stderr "..... setting arg for methodname: [::next::core::current object] has arg arg=${:methodname}" } } if {$type ne ""} { set objopts [linsert $objopts 0 $type] set methodopts [linsert $methodopts 0 $type] } - lappend objopts slot=[::xotcl::current object] + lappend objopts slot=[::next::core::current object] if {[llength $objopts] > 0} { append objparamdefinition :[join $objopts ,] @@ -568,16 +572,16 @@ if {[info exists arg]} { lappend objparamdefinition $arg } - #puts stderr "[::xotcl::current method] ${name} returns [list oparam $objparamdefinition mparam $methodparamdefinition]" + #puts stderr "[::next::core::current method] ${name} returns [list oparam $objparamdefinition mparam $methodparamdefinition]" return [list oparam $objparamdefinition mparam $methodparamdefinition] } - proc ::xotcl::parametersFromSlots {obj} { + proc ::next::core::parametersFromSlots {obj} { set parameterdefinitions [list] - foreach slot [::xotcl2::objectInfo slotobjects $obj] { - # Skip some slots for xotcl1; - # TODO: maybe different parameterFromSlots for xotcl1? - if {[::xotcl::objectproperty $obj type ::xotcl::Object] && + foreach slot [::next::objectInfo slotobjects $obj] { + # Skip some slots for xotcl; + # TODO: maybe different parameterFromSlots for xotcl? + if {[::next::core::objectproperty $obj type ::xotcl::Object] && ([$slot name] eq "mixin" || [$slot name] eq "filter") } continue array set "" [$slot toParameterSyntax] @@ -586,40 +590,40 @@ return $parameterdefinitions } - ::xotcl2::Object protected method objectparameter {{lastparameter __initcmd:initcmd,optional}} { - #puts stderr "... objectparameter [::xotcl::current object]" - set parameterdefinitions [::xotcl::parametersFromSlots [::xotcl::current object]] - if {[::xotcl::objectproperty [::xotcl::current object] class]} { + ::next::Object protected method objectparameter {{lastparameter __initcmd:initcmd,optional}} { + #puts stderr "... objectparameter [::next::core::current object]" + set parameterdefinitions [::next::core::parametersFromSlots [::next::core::current object]] + if {[::next::core::objectproperty [::next::core::current object] class]} { lappend parameterdefinitions -parameter:method,optional } lappend parameterdefinitions \ -noinit:method,optional,noarg \ -volatile:method,optional,noarg \ {*}$lastparameter - #puts stderr "*** parameter definition for [::xotcl::current object]: $parameterdefinitions" + #puts stderr "*** parameter definition for [::next::core::current object]: $parameterdefinitions" return $parameterdefinitions } ############################################ # RelationSlot ############################################ - ::xotcl::MetaSlot create ::xotcl::RelationSlot - createBootstrapAttributeSlots ::xotcl::RelationSlot { + ::next::MetaSlot create ::next::RelationSlot + createBootstrapAttributeSlots ::next::RelationSlot { {multivalued true} {type relation} - {elementtype ::xotcl2::Class} + {elementtype ::next::Class} } - ::xotcl::relation ::xotcl::RelationSlot superclass ::xotcl::ObjectParameterSlot - ::xotcl::alias ::xotcl::RelationSlot assign ::xotcl::relation + ::next::core::relation ::next::RelationSlot superclass ::next::ObjectParameterSlot + ::next::core::alias ::next::RelationSlot assign ::next::core::relation - ::xotcl::RelationSlot protected method init {} { + ::next::RelationSlot protected method init {} { if {${:type} ne "relation"} { error "RelationSlot requires type == \"relation\"" } - next + ::next::core::next } - ::xotcl::RelationSlot protected method delete_value {obj prop old value} { + ::next::RelationSlot protected method delete_value {obj prop old value} { if {[string first * $value] > -1 || [string first \[ $value] > -1} { # value contains globbing meta characters if {${:elementtype} ne "" && ![string match ::* $value]} { @@ -631,12 +635,12 @@ # value contains no globbing meta characters, but elementtype is given if {[string first :: $value] == -1} { # get fully qualified name - if {![::xotcl::objectproperty $value object]} { + if {![::next::core::objectproperty $value object]} { error "$value does not appear to be an object" } - set value [::xotcl::dispatch $value -objscope ::xotcl::current object] + set value [::next::core::dispatch $value -objscope ::next::core::current object] } - if {![::xotcl::objectproperty ${:elementtype} class]} { + if {![::next::core::objectproperty ${:elementtype} class]} { error "$value does not appear to be of type ${:elementtype}" } } @@ -648,61 +652,61 @@ } } - ::xotcl::RelationSlot public method delete {-nocomplain:switch obj prop value} { - #puts stderr RelationSlot-delete-[::xotcl::current args] + ::next::RelationSlot public method delete {-nocomplain:switch obj prop value} { + #puts stderr RelationSlot-delete-[::next::core::current args] $obj $prop [:delete_value $obj $prop [$obj info $prop] $value] } - ::xotcl::RelationSlot public method get {obj prop} { - ::xotcl::relation $obj $prop + ::next::RelationSlot public method get {obj prop} { + ::next::core::relation $obj $prop } - ::xotcl::RelationSlot public method add {obj prop value {pos 0}} { + ::next::RelationSlot public method add {obj prop value {pos 0}} { if {![set :multivalued]} { error "Property $prop of ${:domain}->$obj ist not multivalued" } - set oldSetting [::xotcl::relation $obj $prop] + set oldSetting [::next::core::relation $obj $prop] # use uplevel to avoid namespace surprises - uplevel [list ::xotcl::relation $obj $prop [linsert $oldSetting $pos $value]] + uplevel [list ::next::core::relation $obj $prop [linsert $oldSetting $pos $value]] } - ::xotcl::RelationSlot public method delete {-nocomplain:switch obj prop value} { - uplevel [list ::xotcl::relation $obj $prop [:delete_value $obj $prop [::xotcl::relation $obj $prop] $value]] + ::next::RelationSlot public method delete {-nocomplain:switch obj prop value} { + uplevel [list ::next::core::relation $obj $prop [:delete_value $obj $prop [::next::core::relation $obj $prop] $value]] } ############################################ # system slots ############################################ - proc ::xotcl::register_system_slots {os} { + proc ::next::core::register_system_slots {os} { ${os}::Object alloc ${os}::Class::slot ${os}::Object alloc ${os}::Object::slot - ::xotcl::RelationSlot create ${os}::Class::slot::superclass - ::xotcl::alias ${os}::Class::slot::superclass assign ::xotcl::relation - ::xotcl::RelationSlot create ${os}::Object::slot::class -multivalued false - ::xotcl::alias ${os}::Object::slot::class assign ::xotcl::relation + ::next::RelationSlot create ${os}::Class::slot::superclass + ::next::core::alias ${os}::Class::slot::superclass assign ::next::core::relation + ::next::RelationSlot create ${os}::Object::slot::class -multivalued false + ::next::core::alias ${os}::Object::slot::class assign ::next::core::relation - ::xotcl::RelationSlot create ${os}::Object::slot::mixin -methodname object-mixin - ::xotcl::RelationSlot create ${os}::Object::slot::filter -elementtype "" + ::next::RelationSlot create ${os}::Object::slot::mixin -methodname object-mixin + ::next::RelationSlot create ${os}::Object::slot::filter -elementtype "" - ::xotcl::RelationSlot create ${os}::Class::slot::mixin -methodname class-mixin - ::xotcl::RelationSlot create ${os}::Class::slot::filter -elementtype "" \ + ::next::RelationSlot create ${os}::Class::slot::mixin -methodname class-mixin + ::next::RelationSlot create ${os}::Class::slot::filter -elementtype "" \ -methodname class-filter # Create two conveniance slots to allow configuration of # object-slots for classes via object-mixin - ::xotcl::RelationSlot create ${os}::Class::slot::object-mixin - ::xotcl::RelationSlot create ${os}::Class::slot::object-filter -elementtype "" + ::next::RelationSlot create ${os}::Class::slot::object-mixin + ::next::RelationSlot create ${os}::Class::slot::object-filter -elementtype "" } - ::xotcl::register_system_slots ::xotcl2 - proc ::xotcl::register_system_slots {} {} + ::next::core::register_system_slots ::next + proc ::next::core::register_system_slots {} {} ############################################ # Attribute slots ############################################ - ::xotcl::MetaSlot __invalidateobjectparameter - ::xotcl::MetaSlot create ::xotcl::Attribute -superclass ::xotcl::ObjectParameterSlot + ::next::MetaSlot __invalidateobjectparameter + ::next::MetaSlot create ::next::Attribute -superclass ::next::ObjectParameterSlot - createBootstrapAttributeSlots ::xotcl::Attribute { + createBootstrapAttributeSlots ::next::Attribute { {value_check once} incremental initcmd @@ -711,62 +715,69 @@ arg } - ::xotcl::Attribute method __default_from_cmd {obj cmd var sub op} { - #puts "GETVAR [::xotcl::current method] obj=$obj cmd=$cmd, var=$var, op=$op" - $obj trace remove variable $var $op [list [::xotcl::current object] [::xotcl::current method] $obj $cmd] - ::xotcl::setvar $obj $var [$obj eval $cmd] + ::next::Attribute method __default_from_cmd {obj cmd var sub op} { + #puts "GETVAR [::next::core::current method] obj=$obj cmd=$cmd, var=$var, op=$op" + $obj trace remove variable $var $op [list [::next::core::current object] [::next::core::current method] $obj $cmd] + ::next::core::setvar $obj $var [$obj eval $cmd] } - ::xotcl::Attribute method __value_from_cmd {obj cmd var sub op} { - #puts "GETVAR [::xotcl::current method] obj=$obj cmd=$cmd, var=$var, op=$op" - ::xotcl::setvar $obj $var [$obj eval $cmd] + ::next::Attribute method __value_from_cmd {obj cmd var sub op} { + #puts "GETVAR [::next::core::current method] obj=$obj cmd=$cmd, var=$var, op=$op" + ::next::core::setvar $obj $var [$obj eval $cmd] } - ::xotcl::Attribute method __value_changed_cmd {obj cmd var sub op} { + ::next::Attribute method __value_changed_cmd {obj cmd var sub op} { # puts stderr "**************************" - # puts "valuechanged obj=$obj cmd=$cmd, var=$var, op=$op, ...\n$obj exists $var -> [::xotcl::setvar $obj $var]" + # puts "valuechanged obj=$obj cmd=$cmd, var=$var, op=$op, ...\n$obj exists $var -> [::next::core::setvar $obj $var]" eval $cmd } - ::xotcl::Attribute protected method init {} { - next ;# do first ordinary slot initialization + ::next::Attribute protected method init {} { + ::next::core::next ;# do first ordinary slot initialization # there might be already default values registered on the class set __initcmd "" if {[:exists default]} { } elseif [:exists initcmd] { append __initcmd ":trace add variable [list ${:name}] read \ - \[list [::xotcl::current object] __default_from_cmd \[::xotcl::current object\] [list [set :initcmd]]\]\n" + \[list [::next::core::current object] __default_from_cmd \[::next::core::current object\] [list [set :initcmd]]\]\n" } elseif [:exists valuecmd] { append __initcmd ":trace add variable [list ${:name}] read \ - \[list [::xotcl::current object] __value_from_cmd \[::xotcl::current object\] [list [set :valuecmd]]\]" + \[list [::next::core::current object] __value_from_cmd \[::next::core::current object\] [list [set :valuecmd]]\]" } array set "" [:toParameterSyntax ${:name}] - #puts stderr "Attribute.init valueParam for [::xotcl::current object] is $(mparam)" + #puts stderr "Attribute.init valueParam for [::next::core::current object] is $(mparam)" if {$(mparam) ne ""} { if {[info exists :multivalued] && ${:multivalued}} { - #puts stderr "adding assign [list obj var value:$(mparam),multivalued] // for [::xotcl::current object] with $(mparam)" - :method assign [list obj var value:$(mparam),multivalued,slot=[::xotcl::current object]] {::xotcl::setvar $obj $var $value} - #puts stderr "adding add method for [::xotcl::current object] with value:$(mparam)" - :method add [list obj prop value:$(mparam),slot=[::xotcl::current object] {pos 0}] {next} + #puts stderr "adding assign [list obj var value:$(mparam),multivalued] // for [::next::core::current object] with $(mparam)" + :method assign [list obj var value:$(mparam),multivalued,slot=[::next::core::current object]] { + ::next::core::setvar $obj $var $value + } + #puts stderr "adding add method for [::next::core::current object] with value:$(mparam)" + :method add [list obj prop value:$(mparam),slot=[::next::core::current object] {pos 0}] { + ::next::core::next + } } else { - #puts stderr "SV adding assign [list obj var value:$(mparam)] // for [::xotcl::current object] with $(mparam)" - :method assign [list obj var value:$(mparam),slot=[::xotcl::current object]] {::xotcl::setvar $obj $var $value} - #::xotcl::setter ${:domain} ${:name}:$(mparam),slot=[::xotcl::current object] - #puts stderr "::xotcl::setter ${:domain} ${:name}:$(mparam),slot=[::xotcl::current object]" + #puts stderr "SV adding assign [list obj var value:$(mparam)] // for [::next::core::current object] with $(mparam)" + :method assign [list obj var value:$(mparam),slot=[::next::core::current object]] { + ::next::core::setvar $obj $var $value + } + } } if {[:exists valuechangedcmd]} { append __initcmd ":trace add variable [list ${:name}] write \ - \[list [::xotcl::current object] __value_changed_cmd \[::xotcl::current object\] [list [set :valuechangedcmd]]\]" + \[list [::next::core::current object] __value_changed_cmd \[::next::core::current object\] [list [set :valuechangedcmd]]\]" } if {$__initcmd ne ""} { set :initcmd $__initcmd } } # mixin class for optimizing slots - ::xotcl2::Class create ::xotcl::Attribute::Optimizer { - :method method args {::xotcl::next; :optimize} - :method forward args {::xotcl::next; :optimize} - :protected method init args {::xotcl::next; :optimize} + ::next::Class create ::next::Attribute::Optimizer { + + :method method args {::next::core::next; :optimize} + :method forward args {::next::core::next; :optimize} + :protected method init args {::next::core::next; :optimize} + :public method optimize {} { #puts stderr OPTIMIZER-[info exists :incremental] if {![info exists :methodname]} {return} @@ -778,58 +789,59 @@ set perObject "" set infokind Class } - if {[::xotcl::cmd::${infokind}Info::method ${:domain} name ${:name}] ne ""} { - #puts stderr "RESETTING ${:domain} slot ${:name}" - ::xotcl::forward ${:domain} {*}$perObject ${:name} \ + if {[::next::core::cmd::${infokind}Info::method ${:domain} name ${:name}] ne ""} { + #puts stderr "OPTIMIZER RESETTING ${:domain} slot ${:name}" + ::next::core::forward ${:domain} {*}$perObject ${:name} \ ${:manager} \ [list %1 [${:manager} defaultmethods]] %self \ ${:methodname} } - #if {[set :multivalued]} return + #puts stderr "OPTIMIZER incremental [info exists :incremental] def '[set :defaultmethods]'" if {[info exists :incremental] && ${:incremental}} return if {[set :defaultmethods] ne {get assign}} return set assignInfo [:info callable -which assign] - #puts stderr assign=$assignInfo//[lindex $assignInfo {end 0}] - if {$assignInfo ne "::xotcl::ObjectParameterSlot alias assign ::xotcl::setvar" && - [lindex $assignInfo {end 0}] ne "::xotcl::setvar" } return - if {[:info callable -which get] ne "::xotcl::ObjectParameterSlot alias get ::xotcl::setvar"} return + #puts stderr "OPTIMIZER assign=$assignInfo//[lindex $assignInfo {end 0}]//[:info precedence]" + if {$assignInfo ne "::next::ObjectParameterSlot alias assign ::next::core::setvar" && + [lindex $assignInfo {end 0}] ne "::next::core::setvar" } return + if {[:info callable -which get] ne "::next::ObjectParameterSlot alias get ::next::core::setvar"} return + array set "" [:toParameterSyntax ${:name}] if {$(mparam) ne ""} { set setterParam [lindex $(oparam) 0] #puts stderr "setterParam=$setterParam, op=$(oparam)" } else { set setterParam ${:name} } - ::xotcl::setter ${:domain} {*}$perObject $setterParam - #puts stderr "::xotcl::setter ${:domain} {*}$perObject $setterParam" + ::next::core::setter ${:domain} {*}$perObject $setterParam + #puts stderr "::next::core::setter ${:domain} {*}$perObject $setterParam" } } # register the optimizer per default - ::xotcl::Attribute mixin add ::xotcl::Attribute::Optimizer + ::next::Attribute mixin add ::next::Attribute::Optimizer ############################################ # Define method "attribute" for convenience ############################################ - ::xotcl2::Class method attribute {spec {-slotclass ::xotcl::Attribute} {initblock ""}} { - $slotclass createFromParameterSyntax [::xotcl::current object] -initblock $initblock {*}$spec + ::next::Class method attribute {spec {-slotclass ::next::Attribute} {initblock ""}} { + $slotclass createFromParameterSyntax [::next::core::current object] -initblock $initblock {*}$spec } - ::xotcl2::Object method attribute {spec {-slotclass ::xotcl::Attribute} {initblock ""}} { - $slotclass createFromParameterSyntax [::xotcl::current object] -per-object -initblock $initblock {*}$spec + ::next::Object method attribute {spec {-slotclass ::next::Attribute} {initblock ""}} { + $slotclass createFromParameterSyntax [::next::core::current object] -per-object -initblock $initblock {*}$spec } ############################################ # Define method "parameter" for backward # compatibility and convenience ############################################ - ::xotcl2::Class public method parameter arglist { + ::next::Class public method parameter arglist { foreach arg $arglist { - ::xotcl::Attribute createFromParameterSyntax [::xotcl::current object] {*}$arg + ::next::Attribute createFromParameterSyntax [::next::core::current object] {*}$arg } # todo needed? - set slot [::xotcl::current object]::slot - if {![::xotcl::objectproperty $slot object]} {::xotcl2::Object create $slot} - ::xotcl::setvar $slot __parameter $arglist + set slot [::next::core::current object]::slot + if {![::next::core::objectproperty $slot object]} {::next::Object create $slot} + ::next::core::setvar $slot __parameter $arglist } ################################################################## @@ -841,25 +853,25 @@ proc createBootstrapAttributeSlots {} {} ################################################################## - # create user-level converter/checker based on ::xotcl::ls + # create user-level converter/checker based on ::next::core primitves ################################################################## - ::xotcl::Slot method type=hasmixin {name value arg} { - if {![::xotcl::objectproperty $value hasmixin $arg]} { + ::next::Slot method type=hasmixin {name value arg} { + if {![::next::core::objectproperty $value hasmixin $arg]} { error "expected object with mixin $arg but got \"$value\" for parameter $name" } return $value } - ::xotcl::Slot method type=baseclass {name value} { - if {![::xotcl::objectproperty $value baseclass]} { + ::next::Slot method type=baseclass {name value} { + if {![::next::core::objectproperty $value baseclass]} { error "expected baseclass but got \"$value\" for parameter $name" } return $value } - ::xotcl::Slot method type=metaclass {name value} { - if {![::xotcl::objectproperty $value metaclass]} { + ::next::Slot method type=metaclass {name value} { + if {![::next::core::objectproperty $value metaclass]} { error "expected metaclass but got \"$value\" for parameter $name" } return $value @@ -869,22 +881,22 @@ ################################################################## # Create a mixin class to overload method "new" such it does not -# allocate new objects in ::xotcl::*, but in the specified object +# allocate new objects in ::next::*, but in the specified object # (without syntactic overhead). ################################################################## -::xotcl2::Class create ::xotcl::ScopedNew -superclass ::xotcl2::Class { +::next::Class create ::next::ScopedNew -superclass ::next::Class { - :attribute {withclass ::xotcl2::Object} + :attribute {withclass ::next::Object} :attribute container :protected method init {} { :public method new {-childof args} { - ::xotcl::importvar [::xotcl::current class] {container object} withclass - if {![::xotcl::objectproperty $object object]} { + ::next::core::importvar [::next::core::current class] {container object} withclass + if {![::next::core::objectproperty $object object]} { $withclass create $object } - eval ::xotcl::next -childof $object $args + eval ::next::core::next -childof $object $args } } } @@ -896,36 +908,36 @@ # creating new objects in the specified scope can be turned off. ################################################################## -::xotcl2::Object public method contains { +::next::Object public method contains { {-withnew:boolean true} -object - {-class ::xotcl2::Object} + {-class ::next::Object} cmds } { - if {![info exists object]} {set object [::xotcl::current object]} - if {![::xotcl::objectproperty $object object]} {$class create $object} + if {![info exists object]} {set object [::next::core::current object]} + if {![::next::core::objectproperty $object object]} {$class create $object} $object requireNamespace if {$withnew} { - set m [::xotcl::ScopedNew new -volatile \ + set m [::next::ScopedNew new -volatile \ -container $object -withclass $class] - ::xotcl2::Class mixin add $m end - # TODO: the following is not pretty; however, contains might build xotcl1 and xotcl2 objects. - if {[::xotcl::objectproperty ::xotcl::Class class]} {::xotcl::Class instmixin add $m end} + ::next::Class mixin add $m end + # TODO: the following is not pretty; however, contains might build xotcl1 and next objects. + if {[::next::core::objectproperty ::xotcl::Class class]} {::xotcl::Class instmixin add $m end} namespace eval $object $cmds - ::xotcl2::Class mixin delete $m - if {[::xotcl::objectproperty ::xotcl::Class class]} {::xotcl::Class instmixin delete $m} + ::next::Class mixin delete $m + if {[::next::core::objectproperty ::xotcl::Class class]} {::xotcl::Class instmixin delete $m} } else { namespace eval $object $cmds } } -::xotcl2::Class forward slots %self contains \ - -object {%::xotcl::dispatch [::xotcl::current object] -objscope ::subst [::xotcl::current object]::slot} +::next::Class forward slots %self contains \ + -object {%::next::core::dispatch [::next::core::current object] -objscope ::subst [::next::core::current object]::slot} ################################################################## # copy/move implementation ################################################################## -::xotcl2::Class create ::xotcl::CopyHandler { +::next::Class create ::next::CopyHandler { :attribute {targetList ""} :attribute {dest ""} @@ -935,7 +947,7 @@ lappend :targetList $t #puts stderr "COPY makeTargetList $t target= ${:targetList}" # if it is an object without namespace, it is a leaf - if {[::xotcl::objectproperty $t object]} { + if {[::next::core::objectproperty $t object]} { if {[$t info hasnamespace]} { # make target list from all children set children [$t info children] @@ -947,7 +959,7 @@ # now append all namespaces that are in the obj, but that # are not objects foreach c [namespace children $t] { - if {![::xotcl::objectproperty $c object]} { + if {![::next::core::objectproperty $c object]} { lappend children [namespace children $t] } } @@ -961,8 +973,8 @@ :method copyNSVarsAndCmds {orig dest} { - ::xotcl::namespace_copyvars $orig $dest - ::xotcl::namespace_copycmds $orig $dest + ::next::core::namespace_copyvars $orig $dest + ::next::core::namespace_copycmds $orig $dest } # construct destination obj name from old qualified ns name @@ -975,44 +987,44 @@ #puts stderr "COPY will copy targetList = [set :targetList]" foreach origin [set :targetList] { set dest [:getDest $origin] - if {[::xotcl::objectproperty $origin object]} { + if {[::next::core::objectproperty $origin object]} { # copy class information - if {[::xotcl::objectproperty $origin class]} { + if {[::next::core::objectproperty $origin class]} { set cl [[$origin info class] create $dest -noinit] # class object set obj $cl $cl superclass [$origin info superclass] - ::xotcl::assertion $cl class-invar [::xotcl::assertion $origin class-invar] - ::xotcl::relation $cl class-filter [::xotcl::relation $origin class-filter] - ::xotcl::relation $cl class-mixin [::xotcl::relation $origin class-mixin] - :copyNSVarsAndCmds ::xotcl::classes$origin ::xotcl::classes$dest + ::next::core::assertion $cl class-invar [::next::core::assertion $origin class-invar] + ::next::core::relation $cl class-filter [::next::core::relation $origin class-filter] + ::next::core::relation $cl class-mixin [::next::core::relation $origin class-mixin] + :copyNSVarsAndCmds ::next::core::classes$origin ::next::core::classes$dest } else { # create obj set obj [[$origin info class] create $dest -noinit] } # copy object -> may be a class obj - ::xotcl::assertion $obj check [::xotcl::assertion $origin check] - ::xotcl::assertion $obj object-invar [::xotcl::assertion $origin object-invar] - ::xotcl::relation $obj object-filter [::xotcl::relation $origin object-filter] - ::xotcl::relation $obj object-mixin [::xotcl::relation $origin object-mixin] + ::next::core::assertion $obj check [::next::core::assertion $origin check] + ::next::core::assertion $obj object-invar [::next::core::assertion $origin object-invar] + ::next::core::relation $obj object-filter [::next::core::relation $origin object-filter] + ::next::core::relation $obj object-mixin [::next::core::relation $origin object-mixin] if {[$origin info hasnamespace]} { $obj requireNamespace } } else { namespace eval $dest {} } :copyNSVarsAndCmds $origin $dest - foreach i [::xotcl::cmd::ObjectInfo::forward $origin] { - eval [concat ::xotcl::forward $dest -per-object $i [::xotcl::cmd::ObjectInfo::forward $origin -definition $i]] + foreach i [::next::core::cmd::ObjectInfo::forward $origin] { + eval [concat ::next::core::forward $dest -per-object $i [::next::core::cmd::ObjectInfo::forward $origin -definition $i]] } - if {[::xotcl::objectproperty $origin class]} { - foreach i [::xotcl::cmd::ClassInfo::forward $origin] { - eval [concat ::xotcl::forward $dest $i [::xotcl::cmd::ClassInfo::forward $origin -definition $i]] + if {[::next::core::objectproperty $origin class]} { + foreach i [::next::core::cmd::ClassInfo::forward $origin] { + eval [concat ::next::core::forward $dest $i [::next::core::cmd::ClassInfo::forward $origin -definition $i]] } } set traces [list] foreach var [$origin info vars] { - set cmds [::xotcl::dispatch $origin -objscope ::trace info variable $var] + set cmds [::next::core::dispatch $origin -objscope ::trace info variable $var] if {$cmds ne ""} { foreach cmd $cmds { foreach {op def} $cmd break @@ -1028,10 +1040,10 @@ } # alter 'domain' and 'manager' in slot objects for classes foreach origin [set :targetList] { - if {[::xotcl::objectproperty $origin class]} { + if {[::next::core::objectproperty $origin class]} { set dest [:getDest $origin] foreach oldslot [$origin info slots] { - set newslot [::xotcl::Slot slotName [namespace tail $oldslot] $dest] + set newslot [::next::Slot slotName [namespace tail $oldslot] $dest] if {[$oldslot domain] eq $origin} {$newslot domain $cl} if {[$oldslot manager] eq $oldslot} {$newslot manager $newslot} } @@ -1040,7 +1052,7 @@ } :public method copy {obj dest} { - #puts stderr "[::xotcl::current object] copy <$obj> <$dest>" + #puts stderr "[::next::core::current object] copy <$obj> <$dest>" set :objLength [string length $obj] set :dest $dest :makeTargetList $obj @@ -1049,22 +1061,22 @@ } -::xotcl2::Object public method copy newName { - if {[string compare [string trimleft $newName :] [string trimleft [::xotcl::current object] :]]} { - [::xotcl::CopyHandler new -volatile] copy [::xotcl::current object] $newName +::next::Object public method copy newName { + if {[string compare [string trimleft $newName :] [string trimleft [::next::core::current object] :]]} { + [::next::CopyHandler new -volatile] copy [::next::core::current object] $newName } } -::xotcl2::Object public method move newName { - if {[string trimleft $newName :] ne [string trimleft [::xotcl::current object] :]} { +::next::Object public method move newName { + if {[string trimleft $newName :] ne [string trimleft [::next::core::current object] :]} { if {$newName ne ""} { :copy $newName } ### let all subclasses get the copied class as superclass - if {[::xotcl::objectproperty [::xotcl::current object] class] && $newName ne ""} { + if {[::next::core::objectproperty [::next::core::current object] class] && $newName ne ""} { foreach subclass [:info subclass] { set scl [$subclass info superclass] - if {[set index [lsearch -exact $scl [::xotcl::current object]]] != -1} { + if {[set index [lsearch -exact $scl [::next::core::current object]]] != -1} { set scl [lreplace $scl $index $index $newName] $subclass superclass $scl } @@ -1078,31 +1090,10 @@ # some utilities ####################################################### -# documentation stub object -> just ignore per default. -# if xoDoc is loaded, documentation will be activated -::xotcl2::Object create ::xotcl::@ { - :method unknown args {} -} - - - - - -####################################################################### - - -# common code for all xotcl versions -namespace eval ::xotcl { - - # export the contents for all xotcl versions - namespace export @ Attribute current - - # if HOME is not set, and ~ is resolved, Tcl chokes on that - if {![info exists ::env(HOME)]} {set ::env(HOME) /root} - set ::xotcl::confdir ~/.xotcl - set ::xotcl::logdir $::xotcl::confdir/log - - # return platform aware temp directory +namespace eval ::next::core { + # + # determine platform aware temp directory + # proc tmpdir {} { foreach e [list TMPDIR TEMP TMP] { if {[info exists ::env($e)] \ @@ -1119,23 +1110,50 @@ } } return /tmp - } + } proc use {version} { set callingNs [uplevel {namespace current}] switch -exact $version { + xotcl - xotcl1 { - package require xotcl1 + package require XOTcl #puts stderr "current=[namespace current], ul=[uplevel {namespace current}]" if {$callingNs ne "::xotcl"} {uplevel {namespace import -force ::xotcl::*}} } default { if {$callingNs ne "::xotcl"} {uplevel {namespace import -force ::xotcl::*}} - if {$callingNs ne "::xotcl2"} {uplevel {namespace import -force ::xotcl2::*}} + if {$callingNs ne "::next"} {uplevel {namespace import -force ::next::*}} } } } + + namespace export tmpdir use +} + +####################################################################### +# common code for all xotcl versions +namespace eval ::next { + + # export the contents for all xotcl versions + namespace export Attribute current + + # if HOME is not set, and ~ is resolved, Tcl chokes on that + if {![info exists ::env(HOME)]} {set ::env(HOME) /root} + + set ::next::confdir ~/.xotcl + set ::next::logdir $::next::confdir/log + unset bootstrap } +# +# The following will go away +# +#namespace eval ::xotcl { +# namespace import ::next::core::use +#} +#foreach ns {::next ::next::core} { +# puts stderr "$ns exports [namespace eval $ns {lsort [namespace export]}]" +#} Index: generic/tclAPI.h =================================================================== diff -u -r9474936bd01f25c80caa91f9b3164a3072457f66 -r81c800c8b9cb42ef6743d9b80ac2be5ca211a69a --- generic/tclAPI.h (.../tclAPI.h) (revision 9474936bd01f25c80caa91f9b3164a3072457f66) +++ generic/tclAPI.h (.../tclAPI.h) (revision 81c800c8b9cb42ef6743d9b80ac2be5ca211a69a) @@ -139,11 +139,11 @@ static methodDefinition method_definitions[]; static CONST char *method_command_namespace_names[] = { - "::xotcl::cmd::ObjectInfo", - "::xotcl::cmd::Object", - "::xotcl::cmd::ClassInfo", - "::xotcl::cmd::ParameterType", - "::xotcl::cmd::Class" + "::next::core::cmd::ObjectInfo", + "::next::core::cmd::Object", + "::next::core::cmd::ClassInfo", + "::next::core::cmd::ParameterType", + "::next::core::cmd::Class" }; static int XOTclCAllocMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclCCreateMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); @@ -1978,104 +1978,104 @@ } static methodDefinition method_definitions[] = { -{"::xotcl::cmd::Class::alloc", XOTclCAllocMethodStub, 1, { +{"::next::core::cmd::Class::alloc", XOTclCAllocMethodStub, 1, { {"name", 1, 0, convertToTclobj}} }, -{"::xotcl::cmd::Class::create", XOTclCCreateMethodStub, 2, { +{"::next::core::cmd::Class::create", XOTclCCreateMethodStub, 2, { {"name", 1, 0, convertToString}, {"args", 0, 0, convertToNothing}} }, -{"::xotcl::cmd::Class::dealloc", XOTclCDeallocMethodStub, 1, { +{"::next::core::cmd::Class::dealloc", XOTclCDeallocMethodStub, 1, { {"object", 1, 0, convertToTclobj}} }, -{"::xotcl::cmd::Class::filterguard", XOTclCFilterGuardMethodStub, 2, { +{"::next::core::cmd::Class::filterguard", XOTclCFilterGuardMethodStub, 2, { {"filter", 1, 0, convertToString}, {"guard", 1, 0, convertToTclobj}} }, -{"::xotcl::cmd::Class::__invalidateobjectparameter", XOTclCInvalidateObjectParameterMethodStub, 0, { +{"::next::core::cmd::Class::__invalidateobjectparameter", XOTclCInvalidateObjectParameterMethodStub, 0, { } }, -{"::xotcl::cmd::Class::mixinguard", XOTclCMixinGuardMethodStub, 2, { +{"::next::core::cmd::Class::mixinguard", XOTclCMixinGuardMethodStub, 2, { {"mixin", 1, 0, convertToString}, {"guard", 1, 0, convertToTclobj}} }, -{"::xotcl::cmd::Class::new", XOTclCNewMethodStub, 2, { +{"::next::core::cmd::Class::new", XOTclCNewMethodStub, 2, { {"-childof", 0, 1, convertToObject}, {"args", 0, 0, convertToNothing}} }, -{"::xotcl::cmd::Class::recreate", XOTclCRecreateMethodStub, 2, { +{"::next::core::cmd::Class::recreate", XOTclCRecreateMethodStub, 2, { {"name", 1, 0, convertToTclobj}, {"args", 0, 0, convertToNothing}} }, -{"::xotcl::cmd::ClassInfo::filter", XOTclClassInfoFilterMethodStub, 3, { +{"::next::core::cmd::ClassInfo::filter", XOTclClassInfoFilterMethodStub, 3, { {"class", 1, 0, convertToClass}, {"-guards", 0, 0, convertToString}, {"pattern", 0, 0, convertToString}} }, -{"::xotcl::cmd::ClassInfo::filterguard", XOTclClassInfoFilterguardMethodStub, 2, { +{"::next::core::cmd::ClassInfo::filterguard", XOTclClassInfoFilterguardMethodStub, 2, { {"class", 1, 0, convertToClass}, {"filter", 1, 0, convertToString}} }, -{"::xotcl::cmd::ClassInfo::forward", XOTclClassInfoForwardMethodStub, 3, { +{"::next::core::cmd::ClassInfo::forward", XOTclClassInfoForwardMethodStub, 3, { {"class", 1, 0, convertToClass}, {"-definition", 0, 0, convertToString}, {"name", 0, 0, convertToString}} }, -{"::xotcl::cmd::ClassInfo::heritage", XOTclClassInfoHeritageMethodStub, 2, { +{"::next::core::cmd::ClassInfo::heritage", XOTclClassInfoHeritageMethodStub, 2, { {"class", 1, 0, convertToClass}, {"pattern", 0, 0, convertToString}} }, -{"::xotcl::cmd::ClassInfo::instances", XOTclClassInfoInstancesMethodStub, 3, { +{"::next::core::cmd::ClassInfo::instances", XOTclClassInfoInstancesMethodStub, 3, { {"class", 1, 0, convertToClass}, {"-closure", 0, 0, convertToString}, {"pattern", 0, 0, convertToObjpattern}} }, -{"::xotcl::cmd::ClassInfo::method", XOTclClassInfoMethodMethodStub, 3, { +{"::next::core::cmd::ClassInfo::method", XOTclClassInfoMethodMethodStub, 3, { {"class", 0, 0, convertToClass}, {"infomethodsubcmd", 0, 0, convertToInfomethodsubcmd}, {"name", 0, 0, convertToString}} }, -{"::xotcl::cmd::ClassInfo::methods", XOTclClassInfoMethodsMethodStub, 6, { +{"::next::core::cmd::ClassInfo::methods", XOTclClassInfoMethodsMethodStub, 6, { {"object", 0, 0, convertToClass}, {"-methodtype", 0, 1, convertToMethodtype}, {"-callprotection", 0, 1, convertToCallprotection}, {"-nomixins", 0, 0, convertToString}, {"-incontext", 0, 0, convertToString}, {"pattern", 0, 0, convertToString}} }, -{"::xotcl::cmd::ClassInfo::mixin", XOTclClassInfoMixinMethodStub, 4, { +{"::next::core::cmd::ClassInfo::mixin", XOTclClassInfoMixinMethodStub, 4, { {"class", 1, 0, convertToClass}, {"-closure", 0, 0, convertToString}, {"-guards", 0, 0, convertToString}, {"pattern", 0, 0, convertToObjpattern}} }, -{"::xotcl::cmd::ClassInfo::mixinof", XOTclClassInfoMixinOfMethodStub, 4, { +{"::next::core::cmd::ClassInfo::mixinof", XOTclClassInfoMixinOfMethodStub, 4, { {"class", 1, 0, convertToClass}, {"-closure", 0, 0, convertToString}, {"-scope", 0, 1, convertToScope}, {"pattern", 0, 0, convertToObjpattern}} }, -{"::xotcl::cmd::ClassInfo::mixinguard", XOTclClassInfoMixinguardMethodStub, 2, { +{"::next::core::cmd::ClassInfo::mixinguard", XOTclClassInfoMixinguardMethodStub, 2, { {"class", 1, 0, convertToClass}, {"mixin", 1, 0, convertToString}} }, -{"::xotcl::cmd::ClassInfo::parameter", XOTclClassInfoParameterMethodStub, 1, { +{"::next::core::cmd::ClassInfo::parameter", XOTclClassInfoParameterMethodStub, 1, { {"class", 1, 0, convertToClass}} }, -{"::xotcl::cmd::ClassInfo::slots", XOTclClassInfoSlotsMethodStub, 1, { +{"::next::core::cmd::ClassInfo::slots", XOTclClassInfoSlotsMethodStub, 1, { {"class", 1, 0, convertToClass}} }, -{"::xotcl::cmd::ClassInfo::subclass", XOTclClassInfoSubclassMethodStub, 3, { +{"::next::core::cmd::ClassInfo::subclass", XOTclClassInfoSubclassMethodStub, 3, { {"class", 1, 0, convertToClass}, {"-closure", 0, 0, convertToString}, {"pattern", 0, 0, convertToObjpattern}} }, -{"::xotcl::cmd::ClassInfo::superclass", XOTclClassInfoSuperclassMethodStub, 3, { +{"::next::core::cmd::ClassInfo::superclass", XOTclClassInfoSuperclassMethodStub, 3, { {"class", 1, 0, convertToClass}, {"-closure", 0, 0, convertToString}, {"pattern", 0, 0, convertToTclobj}} }, -{"::xotcl::cmd::ObjectInfo::callable", XOTclObjInfoCallableMethodStub, 8, { +{"::next::core::cmd::ObjectInfo::callable", XOTclObjInfoCallableMethodStub, 8, { {"object", 0, 0, convertToObject}, {"-which", 0, 0, convertToString}, {"-methodtype", 0, 1, convertToMethodtype}, @@ -2085,172 +2085,172 @@ {"-incontext", 0, 0, convertToString}, {"pattern", 0, 0, convertToString}} }, -{"::xotcl::cmd::ObjectInfo::children", XOTclObjInfoChildrenMethodStub, 2, { +{"::next::core::cmd::ObjectInfo::children", XOTclObjInfoChildrenMethodStub, 2, { {"object", 1, 0, convertToObject}, {"pattern", 0, 0, convertToString}} }, -{"::xotcl::cmd::ObjectInfo::class", XOTclObjInfoClassMethodStub, 1, { +{"::next::core::cmd::ObjectInfo::class", XOTclObjInfoClassMethodStub, 1, { {"object", 1, 0, convertToObject}} }, -{"::xotcl::cmd::ObjectInfo::filter", XOTclObjInfoFilterMethodStub, 4, { +{"::next::core::cmd::ObjectInfo::filter", XOTclObjInfoFilterMethodStub, 4, { {"object", 1, 0, convertToObject}, {"-order", 0, 0, convertToString}, {"-guards", 0, 0, convertToString}, {"pattern", 0, 0, convertToString}} }, -{"::xotcl::cmd::ObjectInfo::filterguard", XOTclObjInfoFilterguardMethodStub, 2, { +{"::next::core::cmd::ObjectInfo::filterguard", XOTclObjInfoFilterguardMethodStub, 2, { {"object", 1, 0, convertToObject}, {"filter", 1, 0, convertToString}} }, -{"::xotcl::cmd::ObjectInfo::forward", XOTclObjInfoForwardMethodStub, 3, { +{"::next::core::cmd::ObjectInfo::forward", XOTclObjInfoForwardMethodStub, 3, { {"object", 1, 0, convertToObject}, {"-definition", 0, 0, convertToString}, {"name", 0, 0, convertToString}} }, -{"::xotcl::cmd::ObjectInfo::hasnamespace", XOTclObjInfoHasnamespaceMethodStub, 1, { +{"::next::core::cmd::ObjectInfo::hasnamespace", XOTclObjInfoHasnamespaceMethodStub, 1, { {"object", 1, 0, convertToObject}} }, -{"::xotcl::cmd::ObjectInfo::method", XOTclObjInfoMethodMethodStub, 3, { +{"::next::core::cmd::ObjectInfo::method", XOTclObjInfoMethodMethodStub, 3, { {"object", 0, 0, convertToObject}, {"infomethodsubcmd", 0, 0, convertToInfomethodsubcmd}, {"name", 0, 0, convertToString}} }, -{"::xotcl::cmd::ObjectInfo::methods", XOTclObjInfoMethodsMethodStub, 6, { +{"::next::core::cmd::ObjectInfo::methods", XOTclObjInfoMethodsMethodStub, 6, { {"object", 0, 0, convertToObject}, {"-methodtype", 0, 1, convertToMethodtype}, {"-callprotection", 0, 1, convertToCallprotection}, {"-nomixins", 0, 0, convertToString}, {"-incontext", 0, 0, convertToString}, {"pattern", 0, 0, convertToString}} }, -{"::xotcl::cmd::ObjectInfo::mixin", XOTclObjInfoMixinMethodStub, 4, { +{"::next::core::cmd::ObjectInfo::mixin", XOTclObjInfoMixinMethodStub, 4, { {"object", 1, 0, convertToObject}, {"-guards", 0, 0, convertToString}, {"-order", 0, 0, convertToString}, {"pattern", 0, 0, convertToObjpattern}} }, -{"::xotcl::cmd::ObjectInfo::mixinguard", XOTclObjInfoMixinguardMethodStub, 2, { +{"::next::core::cmd::ObjectInfo::mixinguard", XOTclObjInfoMixinguardMethodStub, 2, { {"object", 1, 0, convertToObject}, {"mixin", 1, 0, convertToString}} }, -{"::xotcl::cmd::ObjectInfo::parent", XOTclObjInfoParentMethodStub, 1, { +{"::next::core::cmd::ObjectInfo::parent", XOTclObjInfoParentMethodStub, 1, { {"object", 1, 0, convertToObject}} }, -{"::xotcl::cmd::ObjectInfo::precedence", XOTclObjInfoPrecedenceMethodStub, 3, { +{"::next::core::cmd::ObjectInfo::precedence", XOTclObjInfoPrecedenceMethodStub, 3, { {"object", 1, 0, convertToObject}, {"-intrinsic", 0, 0, convertToString}, {"pattern", 0, 0, convertToString}} }, -{"::xotcl::cmd::ObjectInfo::slotobjects", XOTclObjInfoSlotObjectsMethodStub, 2, { +{"::next::core::cmd::ObjectInfo::slotobjects", XOTclObjInfoSlotObjectsMethodStub, 2, { {"object", 1, 0, convertToObject}, {"pattern", 0, 0, convertToString}} }, -{"::xotcl::cmd::ObjectInfo::vars", XOTclObjInfoVarsMethodStub, 2, { +{"::next::core::cmd::ObjectInfo::vars", XOTclObjInfoVarsMethodStub, 2, { {"object", 1, 0, convertToObject}, {"pattern", 0, 0, convertToString}} }, -{"::xotcl::cmd::Object::autoname", XOTclOAutonameMethodStub, 3, { +{"::next::core::cmd::Object::autoname", XOTclOAutonameMethodStub, 3, { {"-instance", 0, 0, convertToString}, {"-reset", 0, 0, convertToString}, {"name", 1, 0, convertToTclobj}} }, -{"::xotcl::cmd::Object::cleanup", XOTclOCleanupMethodStub, 0, { +{"::next::core::cmd::Object::cleanup", XOTclOCleanupMethodStub, 0, { } }, -{"::xotcl::cmd::Object::configure", XOTclOConfigureMethodStub, 1, { +{"::next::core::cmd::Object::configure", XOTclOConfigureMethodStub, 1, { {"args", 0, 0, convertToNothing}} }, -{"::xotcl::cmd::Object::destroy", XOTclODestroyMethodStub, 0, { +{"::next::core::cmd::Object::destroy", XOTclODestroyMethodStub, 0, { } }, -{"::xotcl::cmd::Object::exists", XOTclOExistsMethodStub, 1, { +{"::next::core::cmd::Object::exists", XOTclOExistsMethodStub, 1, { {"var", 1, 0, convertToString}} }, -{"::xotcl::cmd::Object::filterguard", XOTclOFilterGuardMethodStub, 2, { +{"::next::core::cmd::Object::filterguard", XOTclOFilterGuardMethodStub, 2, { {"filter", 1, 0, convertToString}, {"guard", 1, 0, convertToTclobj}} }, -{"::xotcl::cmd::Object::filtersearch", XOTclOFilterSearchMethodStub, 1, { +{"::next::core::cmd::Object::filtersearch", XOTclOFilterSearchMethodStub, 1, { {"filter", 1, 0, convertToString}} }, -{"::xotcl::cmd::Object::instvar", XOTclOInstVarMethodStub, 1, { +{"::next::core::cmd::Object::instvar", XOTclOInstVarMethodStub, 1, { {"args", 0, 0, convertToNothing}} }, -{"::xotcl::cmd::Object::mixinguard", XOTclOMixinGuardMethodStub, 2, { +{"::next::core::cmd::Object::mixinguard", XOTclOMixinGuardMethodStub, 2, { {"mixin", 1, 0, convertToString}, {"guard", 1, 0, convertToTclobj}} }, -{"::xotcl::cmd::Object::__next", XOTclONextMethodStub, 1, { +{"::next::core::cmd::Object::__next", XOTclONextMethodStub, 1, { {"args", 0, 0, convertToNothing}} }, -{"::xotcl::cmd::Object::noinit", XOTclONoinitMethodStub, 0, { +{"::next::core::cmd::Object::noinit", XOTclONoinitMethodStub, 0, { } }, -{"::xotcl::cmd::Object::requireNamespace", XOTclORequireNamespaceMethodStub, 0, { +{"::next::core::cmd::Object::requireNamespace", XOTclORequireNamespaceMethodStub, 0, { } }, -{"::xotcl::cmd::Object::residualargs", XOTclOResidualargsMethodStub, 1, { +{"::next::core::cmd::Object::residualargs", XOTclOResidualargsMethodStub, 1, { {"args", 0, 0, convertToNothing}} }, -{"::xotcl::cmd::Object::uplevel", XOTclOUplevelMethodStub, 1, { +{"::next::core::cmd::Object::uplevel", XOTclOUplevelMethodStub, 1, { {"args", 0, 0, convertToNothing}} }, -{"::xotcl::cmd::Object::upvar", XOTclOUpvarMethodStub, 1, { +{"::next::core::cmd::Object::upvar", XOTclOUpvarMethodStub, 1, { {"args", 0, 0, convertToNothing}} }, -{"::xotcl::cmd::Object::volatile", XOTclOVolatileMethodStub, 0, { +{"::next::core::cmd::Object::volatile", XOTclOVolatileMethodStub, 0, { } }, -{"::xotcl::cmd::Object::vwait", XOTclOVwaitMethodStub, 1, { +{"::next::core::cmd::Object::vwait", XOTclOVwaitMethodStub, 1, { {"varname", 1, 0, convertToString}} }, -{"::xotcl::alias", XOTclAliasCmdStub, 6, { +{"::next::core::alias", XOTclAliasCmdStub, 6, { {"object", 0, 0, convertToObject}, {"-per-object", 0, 0, convertToString}, {"methodName", 0, 0, convertToString}, {"-nonleaf", 0, 0, convertToString}, {"-objscope", 0, 0, convertToString}, {"cmdName", 1, 0, convertToTclobj}} }, -{"::xotcl::assertion", XOTclAssertionCmdStub, 3, { +{"::next::core::assertion", XOTclAssertionCmdStub, 3, { {"object", 0, 0, convertToObject}, {"assertionsubcmd", 1, 0, convertToAssertionsubcmd}, {"arg", 0, 0, convertToTclobj}} }, -{"::xotcl::colon", XOTclColonCmdStub, 1, { +{"::next::core::colon", XOTclColonCmdStub, 1, { {"args", 0, 0, convertToNothing}} }, -{"::xotcl::configure", XOTclConfigureCmdStub, 2, { +{"::next::core::configure", XOTclConfigureCmdStub, 2, { {"configureoption", 1, 0, convertToConfigureoption}, {"value", 0, 0, convertToTclobj}} }, -{"::xotcl::createobjectsystem", XOTclCreateObjectSystemCmdStub, 3, { +{"::next::core::createobjectsystem", XOTclCreateObjectSystemCmdStub, 3, { {"rootClass", 1, 0, convertToTclobj}, {"rootMetaClass", 1, 0, convertToTclobj}, {"systemMethods", 0, 0, convertToTclobj}} }, -{"::xotcl::current", XOTclCurrentCmdStub, 1, { +{"::next::core::current", XOTclCurrentCmdStub, 1, { {"currentoption", 0, 0, convertToCurrentoption}} }, -{"::xotcl::deprecated", XOTclDeprecatedCmdStub, 3, { +{"::next::core::deprecated", XOTclDeprecatedCmdStub, 3, { {"what", 1, 0, convertToString}, {"oldCmd", 1, 0, convertToString}, {"newCmd", 0, 0, convertToString}} }, -{"::xotcl::dispatch", XOTclDispatchCmdStub, 4, { +{"::next::core::dispatch", XOTclDispatchCmdStub, 4, { {"object", 1, 0, convertToObject}, {"-objscope", 0, 0, convertToString}, {"command", 1, 0, convertToTclobj}, {"args", 0, 0, convertToNothing}} }, -{"::xotcl::existsvar", XOTclExistsVarCmdStub, 2, { +{"::next::core::existsvar", XOTclExistsVarCmdStub, 2, { {"object", 1, 0, convertToObject}, {"var", 1, 0, convertToString}} }, -{"::xotcl::finalize", XOTclFinalizeObjCmdStub, 0, { +{"::next::core::finalize", XOTclFinalizeObjCmdStub, 0, { } }, -{"::xotcl::forward", XOTclForwardCmdStub, 11, { +{"::next::core::forward", XOTclForwardCmdStub, 11, { {"object", 1, 0, convertToObject}, {"-per-object", 0, 0, convertToString}, {"method", 1, 0, convertToTclobj}, @@ -2263,22 +2263,22 @@ {"target", 0, 0, convertToTclobj}, {"args", 0, 0, convertToNothing}} }, -{"::xotcl::importvar", XOTclImportvarCmdStub, 2, { +{"::next::core::importvar", XOTclImportvarCmdStub, 2, { {"object", 0, 0, convertToObject}, {"args", 0, 0, convertToNothing}} }, -{"::xotcl::interp", XOTclInterpObjCmdStub, 2, { +{"::next::core::interp", XOTclInterpObjCmdStub, 2, { {"name", 0, 0, convertToString}, {"args", 0, 0, convertToNothing}} }, -{"::xotcl::is", XOTclIsCmdStub, 5, { +{"::next::core::is", XOTclIsCmdStub, 5, { {"value", 1, 0, convertToTclobj}, {"constraint", 1, 0, convertToTclobj}, {"-hasmixin", 0, 1, convertToTclobj}, {"-type", 0, 1, convertToTclobj}, {"arg", 0, 0, convertToTclobj}} }, -{"::xotcl::method", XOTclMethodCmdStub, 9, { +{"::next::core::method", XOTclMethodCmdStub, 9, { {"object", 1, 0, convertToObject}, {"-inner-namespace", 0, 0, convertToString}, {"-per-object", 0, 0, convertToString}, @@ -2289,53 +2289,53 @@ {"-precondition", 0, 1, convertToTclobj}, {"-postcondition", 0, 1, convertToTclobj}} }, -{"::xotcl::methodproperty", XOTclMethodPropertyCmdStub, 5, { +{"::next::core::methodproperty", XOTclMethodPropertyCmdStub, 5, { {"object", 1, 0, convertToObject}, {"-per-object", 0, 0, convertToString}, {"methodName", 1, 0, convertToTclobj}, {"methodproperty", 1, 0, convertToMethodproperty}, {"value", 0, 0, convertToTclobj}} }, -{"::xotcl::my", XOTclMyCmdStub, 3, { +{"::next::core::my", XOTclMyCmdStub, 3, { {"-local", 0, 0, convertToString}, {"method", 1, 0, convertToTclobj}, {"args", 0, 0, convertToNothing}} }, -{"::xotcl::namespace_copycmds", XOTclNSCopyCmdsStub, 2, { +{"::next::core::namespace_copycmds", XOTclNSCopyCmdsStub, 2, { {"fromNs", 1, 0, convertToTclobj}, {"toNs", 1, 0, convertToTclobj}} }, -{"::xotcl::namespace_copyvars", XOTclNSCopyVarsStub, 2, { +{"::next::core::namespace_copyvars", XOTclNSCopyVarsStub, 2, { {"fromNs", 1, 0, convertToTclobj}, {"toNs", 1, 0, convertToTclobj}} }, -{"::xotcl::objectproperty", XOTclObjectpropertyCmdStub, 3, { +{"::next::core::objectproperty", XOTclObjectpropertyCmdStub, 3, { {"object", 1, 0, convertToTclobj}, {"objectkind", 0, 0, convertToObjectkind}, {"value", 0, 0, convertToTclobj}} }, -{"::xotcl::parametercheck", XOTclParametercheckCmdStub, 3, { +{"::next::core::parametercheck", XOTclParametercheckCmdStub, 3, { {"-nocomplain", 0, 0, convertToString}, {"param", 0, 0, convertToTclobj}, {"value", 0, 0, convertToTclobj}} }, -{"::xotcl::__qualify", XOTclQualifyObjCmdStub, 1, { +{"::next::core::__qualify", XOTclQualifyObjCmdStub, 1, { {"name", 1, 0, convertToTclobj}} }, -{"::xotcl::relation", XOTclRelationCmdStub, 3, { +{"::next::core::relation", XOTclRelationCmdStub, 3, { {"object", 0, 0, convertToObject}, {"relationtype", 1, 0, convertToRelationtype}, {"value", 0, 0, convertToTclobj}} }, -{"::xotcl::self", XOTclSelfCmdStub, 1, { +{"::next::core::self", XOTclSelfCmdStub, 1, { {"selfoption", 0, 0, convertToSelfoption}} }, -{"::xotcl::setvar", XOTclSetVarCmdStub, 3, { +{"::next::core::setvar", XOTclSetVarCmdStub, 3, { {"object", 1, 0, convertToObject}, {"variable", 1, 0, convertToTclobj}, {"value", 0, 0, convertToTclobj}} }, -{"::xotcl::setter", XOTclSetterCmdStub, 3, { +{"::next::core::setter", XOTclSetterCmdStub, 3, { {"object", 1, 0, convertToObject}, {"-per-object", 0, 0, convertToString}, {"parameter", 0, 0, convertToTclobj}} Index: generic/xotcl.c =================================================================== diff -u -r9474936bd01f25c80caa91f9b3164a3072457f66 -r81c800c8b9cb42ef6743d9b80ac2be5ca211a69a --- generic/xotcl.c (.../xotcl.c) (revision 9474936bd01f25c80caa91f9b3164a3072457f66) +++ generic/xotcl.c (.../xotcl.c) (revision 81c800c8b9cb42ef6743d9b80ac2be5ca211a69a) @@ -347,7 +347,7 @@ #if 0 static int duringBootstrap(Tcl_Interp *interp) { - Tcl_Obj *bootstrap = Tcl_GetVar2Ex(interp, "::xotcl::bootstrap", NULL, TCL_GLOBAL_ONLY); + Tcl_Obj *bootstrap = Tcl_GetVar2Ex(interp, "::next::core::bootstrap", NULL, TCL_GLOBAL_ONLY); return (bootstrap != NULL); } #endif @@ -486,14 +486,14 @@ XOTCLINLINE static int isClassName(CONST char *string) { - return (strncmp((string), "::xotcl::classes", 16) == 0); + return (strncmp((string), "::next::core::classes", 21) == 0); } -/* removes preceding ::xotcl::classes from a string */ +/* removes preceding ::next::core::classes from a string */ XOTCLINLINE static CONST char * NSCutXOTclClasses(CONST char *string) { - assert(strncmp((string), "::xotcl::classes", 16) == 0); - return string+16; + assert(strncmp((string), "::next::core::classes", 21) == 0); + return string+21; } XOTCLINLINE static char * @@ -5524,18 +5524,6 @@ #endif /* - * In case, we have Tcl 8.5.* or better, we can avoid calling the - * standard TclObjInterpProc() and ::xotcl::initProcNS defined in - * the method, since Tcl 8.5 has a separate functions - * PushProcCallFrame() and TclObjInterpProcCore(), where the - * latter is callable from the outside (e.g. from XOTcl). This new - * interface allows us to setup the XOTcl callframe before the - * bytecode of the method body (provisioned by PushProcCallFrame) - * is executed for tcl 8.4 versions. - */ - /*fprintf(stderr, "\tproc=%s cp=%p %d\n", Tcl_GetCommandName(interp, cmd), cp, isTclProc);*/ - - /* If the method to be invoked hasparamDefs, we have to call the argument parser with the argument definitions obtained from the proc context from the cmdPtr. @@ -6105,7 +6093,7 @@ INCR_REF_COUNT(resultBody); if (paramDefs && paramPtr->possibleUnknowns > 0) - Tcl_AppendStringsToObj(resultBody, "::xotcl::unsetUnknownArgs\n", (char *) NULL); + Tcl_AppendStringsToObj(resultBody, "::next::core::unsetUnknownArgs\n", (char *) NULL); Tcl_AppendStringsToObj(resultBody, ObjStr(body), (char *) NULL); return resultBody; @@ -7016,7 +7004,7 @@ static CONST char * StripBodyPrefix(CONST char *body) { - if (strncmp(body, "::xotcl::unsetUnknownArgs\n", 26) == 0) + if (strncmp(body, "::next::core::unsetUnknownArgs\n", 30) == 0) body += 26; return body; } @@ -7955,13 +7943,11 @@ /* Reclass all instances of the current class the the appropriate most general class ("baseClass"). The most general class of a - metaclass is ::xotcl::Class, the most general class of an - object is ::xotcl::Object. Instances of metaclasses can be only - reset to ::xotcl::Class (and not to ::xotcl::Object as in - earlier versions), since otherwise their instances can't be - deleted, because ::xotcl::Object has no method "dealloc". + metaclass is the root meta class, the most general class of an + object is the root class. Instances of metaclasses can be only + reset to the root meta class (and not to to the root base class). - We do not have to reclassing in case, cl == ::xotcl::Object + We do not have to reclassing in case, cl is a root class */ if ((cl->object.flags & XOTCL_IS_ROOT_CLASS) == 0) { XOTclClass *baseClass = IsMetaClass(interp, cl, 1) ? @@ -9317,9 +9303,9 @@ /* * Find last incovation outside the XOTcl system namespaces. For * example, the pre defined slot handlers for relations (defined in - * the ::xotcl namespace) handle mixin and class - * registration. etc. If we would use this namespace, we would - * resolve non-fully-qualified names against ::xotcl). + * the too namespace) handle mixin and class registration. etc. If we + * would use this namespace, we would resolve non-fully-qualified + * names against the root namespace). */ for (framePtr = activeProcFrame((Tcl_CallFrame *)Tcl_Interp_varFramePtr(interp)); framePtr; @@ -9916,7 +9902,7 @@ static int ListMethodName(Tcl_Interp *interp, XOTclObject *object, int withPer_object, CONST char *methodName) { - Tcl_Obj *resultObj = Tcl_NewStringObj(withPer_object ? "" : "::xotcl::classes", -1); + Tcl_Obj *resultObj = Tcl_NewStringObj(withPer_object ? "" : "::next::core::classes", -1); Tcl_AppendObjToObj(resultObj, object->cmdName); Tcl_AppendStringsToObj(resultObj, "::", methodName, (char *) NULL); Tcl_SetObjResult(interp, resultObj); @@ -10432,7 +10418,7 @@ AliasIndex(dsPtr, cmdName, methodName, withPer_object), Tcl_NewStringObj(cmd,-1), TCL_GLOBAL_ONLY); - /*fprintf(stderr, "aliasAdd ::xotcl::alias(%s) '%s' returned %p\n", + /*fprintf(stderr, "aliasAdd ::next::core::alias(%s) '%s' returned %p\n", AliasIndex(dsPtr, cmdName, methodName, withPer_object), cmd, 1);*/ Tcl_DStringFree(dsPtr); return TCL_OK; @@ -10443,7 +10429,7 @@ int result = Tcl_UnsetVar2(interp, XOTclGlobalStrings[XOTE_ALIAS_ARRAY], AliasIndex(dsPtr, cmdName, methodName, withPer_object), TCL_GLOBAL_ONLY); - /*fprintf(stderr, "aliasDelete ::xotcl::alias(%s) returned %d (%d)\n", + /*fprintf(stderr, "aliasDelete ::next::core::alias(%s) returned %d (%d)\n", AliasIndex(dsPtr, cmdName, methodName, withPer_object), result);*/ Tcl_DStringFree(dsPtr); return result; @@ -10505,7 +10491,7 @@ 4. XOTclSetterMethod: an XOTcl setter - 5. arbitrary Tcl commands (e.g. set, ..., ::xotcl::relation, ...) + 5. arbitrary Tcl commands (e.g. set, ..., ::next::core::relation, ...) TODO GN: i think, we should use XOTclProcAliasMethod, whenever the clientData is not 0. These are the cases, where the clientData will be freed, @@ -10619,7 +10605,7 @@ {-argName "arg" -required 0 -type tclobj} } - Make "::xotcl::assertion" a cmd rather than a method, otherwise we + Make "::next::core::assertion" a cmd rather than a method, otherwise we cannot define e.g. a "method check options {...}" to reset the check options in case of a failed option, since assertion checking would be applied on the sketched method already. @@ -10844,7 +10830,7 @@ /* * If the specified method is a fully qualified cmd name like - * e.g. ::xotcl::cmd::Class::alloc, this method is called on the + * e.g. ::next::core::cmd::Class::alloc, this method is called on the * specified , no matter whether it was registered on * it. */ @@ -10967,7 +10953,7 @@ } */ /* - * ::xotcl::finalize command + * ::next::core::finalize command */ static int XOTclFinalizeObjCmd(Tcl_Interp *interp) { @@ -10981,7 +10967,7 @@ /* * evaluate user-defined exit handler */ - result = Tcl_Eval(interp, "::xotcl::__exitHandler"); + result = Tcl_Eval(interp, "::next::core::__exitHandler"); if (result != TCL_OK) { fprintf(stderr, "User defined exit handler contains errors!\n" @@ -11113,14 +11099,14 @@ if (isCreateString(name)) { /* - * The command was an interp create, so perform an Xotcl_Init() on + * The command was an interp create, so perform an Next_Init() on * the new interpreter */ slave = Tcl_GetSlave(interp, ObjStr(objv[2])); if (!slave) { return XOTclVarErrMsg(interp, "Creation of slave interpreter failed", (char *) NULL); } - if (Xotcl_Init(slave) == TCL_ERROR) { + if (Next_Init(slave) == TCL_ERROR) { return TCL_ERROR; } #ifdef XOTCL_MEM_COUNT @@ -11472,7 +11458,7 @@ procs = cl->opt ? AssertionFindProcs(cl->opt->assertions, name) : 0; DSTRING_INIT(dsPtr); - Tcl_DStringAppendElement(dsPtr, "::xotcl::method"); + Tcl_DStringAppendElement(dsPtr, "::next::core::method"); Tcl_DStringAppendElement(dsPtr, NSCutXOTclClasses(toNsPtr->fullName)); Tcl_DStringAppendElement(dsPtr, name); Tcl_DStringAppendElement(dsPtr, ObjStr(arglistObj)); @@ -11499,7 +11485,7 @@ } DSTRING_INIT(dsPtr); - Tcl_DStringAppendElement(dsPtr, "::xotcl::method"); + Tcl_DStringAppendElement(dsPtr, "::next::core::method"); Tcl_DStringAppendElement(dsPtr, toNsPtr->fullName); Tcl_DStringAppendElement(dsPtr, "-per-object"); Tcl_DStringAppendElement(dsPtr, name); @@ -11528,7 +11514,7 @@ if (objProc) { clientData = Tcl_Command_objClientData(cmd); if (clientData == NULL || clientData == (ClientData)XOTCL_CMD_NONLEAF_METHOD) { - /* if client data not null, we would have to copy + /* if client data is not null, we would have to copy the client data; we don't know its size...., so rely on introspection for copying */ Tcl_CreateObjCommand(interp, newName, objProc, @@ -13291,7 +13277,7 @@ Tcl_DStringAppend(dsPtr, objectName(withChildof), -1); Tcl_DStringAppend(dsPtr, "::__#", 5); } else { - Tcl_DStringAppend(dsPtr, "::xotcl::__#", 12); + Tcl_DStringAppend(dsPtr, "::next::core::__#", 17); } prefixLength = dsPtr->length; @@ -13594,6 +13580,7 @@ if (withWhich) { XOTclClass *pcl = NULL; Tcl_Command cmd = ObjectFindMethod(interp, object, pattern, &pcl); + if (cmd) { XOTclObject *pobj = pcl ? &pcl->object : object; int perObject = (pcl == NULL); @@ -14326,7 +14313,7 @@ */ extern int -Xotcl_Init(Tcl_Interp *interp) { +Next_Init(Tcl_Interp *interp) { ClientData runtimeState; int result, i; #ifdef XOTCL_BYTECODE @@ -14376,7 +14363,7 @@ /* create xotcl namespace */ RUNTIME_STATE(interp)->XOTclNS = - Tcl_CreateNamespace(interp, "::xotcl", (ClientData)NULL, (Tcl_NamespaceDeleteProc*)NULL); + Tcl_CreateNamespace(interp, "::next::core", (ClientData)NULL, (Tcl_NamespaceDeleteProc*)NULL); MEM_COUNT_ALLOC("TclNamespace", RUNTIME_STATE(interp)->XOTclNS); @@ -14394,7 +14381,7 @@ /* XOTclClasses in separate Namespace / Objects */ RUNTIME_STATE(interp)->XOTclClassesNS = - Tcl_CreateNamespace(interp, "::xotcl::classes", (ClientData)NULL, + Tcl_CreateNamespace(interp, "::next::core::classes", (ClientData)NULL, (Tcl_NamespaceDeleteProc*)NULL); MEM_COUNT_ALLOC("TclNamespace", RUNTIME_STATE(interp)->XOTclClassesNS); @@ -14414,7 +14401,7 @@ } /* create namespaces for the different command types */ - Tcl_CreateNamespace(interp, "::xotcl::cmd", 0, (Tcl_NamespaceDeleteProc*)NULL); + Tcl_CreateNamespace(interp, "::next::core::cmd", 0, (Tcl_NamespaceDeleteProc*)NULL); for (i=0; i < nr_elements(method_command_namespace_names); i++) { Tcl_CreateNamespace(interp, method_command_namespace_names[i], 0, (Tcl_NamespaceDeleteProc*)NULL); } @@ -14437,13 +14424,13 @@ #ifdef XOTCL_BYTECODE instructions[INST_NEXT].cmdPtr = (Command *) #endif - Tcl_CreateObjCommand(interp, "::xotcl::next", XOTclNextObjCmd, 0, 0); + Tcl_CreateObjCommand(interp, "::next::core::next", XOTclNextObjCmd, 0, 0); #ifdef XOTCL_BYTECODE - instructions[INST_SELF].cmdPtr = (Command *)Tcl_FindCommand(interp, "::xotcl::self", 0, 0); + instructions[INST_SELF].cmdPtr = (Command *)Tcl_FindCommand(interp, "::next::core::self", 0, 0); #endif - /*Tcl_CreateObjCommand(interp, "::xotcl::K", XOTclKObjCmd, 0, 0);*/ + /*Tcl_CreateObjCommand(interp, "::next::core::K", XOTclKObjCmd, 0, 0);*/ - Tcl_CreateObjCommand(interp, "::xotcl::unsetUnknownArgs", XOTclUnsetUnknownArgsCmd, 0, 0); + Tcl_CreateObjCommand(interp, "::next::core::unsetUnknownArgs", XOTclUnsetUnknownArgsCmd, 0, 0); Tcl_Export(interp, RUNTIME_STATE(interp)->XOTclNS, "self", 0); Tcl_Export(interp, RUNTIME_STATE(interp)->XOTclNS, "next", 0); Tcl_Export(interp, RUNTIME_STATE(interp)->XOTclNS, "my", 0); @@ -14453,14 +14440,14 @@ XOTclBytecodeInit(); #endif - Tcl_SetVar(interp, "::xotcl::version", XOTCLVERSION, TCL_GLOBAL_ONLY); - Tcl_SetVar(interp, "::xotcl::patchlevel", XOTCLPATCHLEVEL, TCL_GLOBAL_ONLY); + Tcl_SetVar(interp, "::next::core::version", XOTCLVERSION, TCL_GLOBAL_ONLY); + Tcl_SetVar(interp, "::next::core::patchlevel", XOTCLPATCHLEVEL, TCL_GLOBAL_ONLY); - Tcl_AddInterpResolvers(interp,"xotcl", + Tcl_AddInterpResolvers(interp,"next", (Tcl_ResolveCmdProc*)InterpColonCmdResolver, InterpColonVarResolver, (Tcl_ResolveCompiledVarProc*)InterpCompiledColonVarResolver); - RUNTIME_STATE(interp)->colonCmd = Tcl_FindCommand(interp, "::xotcl::colon", 0, 0); + RUNTIME_STATE(interp)->colonCmd = Tcl_FindCommand(interp, "::next::core::colon", 0, 0); /* * with some methods and library procs in tcl - they could go in a @@ -14485,12 +14472,12 @@ /* the AOL server uses a different package loading mechanism */ # ifdef COMPILE_XOTCL_STUBS # if defined(PRE86) - Tcl_PkgProvideEx(interp, "XOTcl", PACKAGE_VERSION, (ClientData)&xotclStubs); + Tcl_PkgProvideEx(interp, "next", PACKAGE_VERSION, (ClientData)&xotclStubs); # else - Tcl_PkgProvideEx(interp, "XOTcl", PACKAGE_VERSION, (ClientData)&xotclConstStubPtr); + Tcl_PkgProvideEx(interp, "next", PACKAGE_VERSION, (ClientData)&xotclConstStubPtr); # endif # else - Tcl_PkgProvide(interp, "XOTcl", PACKAGE_VERSION); + Tcl_PkgProvide(interp, "next", PACKAGE_VERSION); # endif #endif @@ -14509,8 +14496,8 @@ extern int -Xotcl_SafeInit(Tcl_Interp *interp) { +Next_SafeInit(Tcl_Interp *interp) { /*** dummy for now **/ - return Xotcl_Init(interp); + return Next_Init(interp); } Index: generic/xotcl.decls =================================================================== diff -u -r78e6c23b4195221aba2a75be9e813382d74f20fb -r81c800c8b9cb42ef6743d9b80ac2be5ca211a69a --- generic/xotcl.decls (.../xotcl.decls) (revision 78e6c23b4195221aba2a75be9e813382d74f20fb) +++ generic/xotcl.decls (.../xotcl.decls) (revision 81c800c8b9cb42ef6743d9b80ac2be5ca211a69a) @@ -21,11 +21,11 @@ # to preserve backwards compatibility. declare 0 generic { - int Xotcl_Init(Tcl_Interp *interp) + int Next_Init(Tcl_Interp *interp) } # 1 is reserved for safe init #declare 1 generic { -# int Xotcl_SafeInit(Tcl_Interp *interp) +# int Next_SafeInit(Tcl_Interp *interp) #} declare 2 generic { struct XOTcl_Class *XOTclIsClass(Tcl_Interp *interp, ClientData cd) Index: generic/xotclDecls.h =================================================================== diff -u -r46968ac6fcde3c5046aa0ede9a0e4c349e868de4 -r81c800c8b9cb42ef6743d9b80ac2be5ca211a69a --- generic/xotclDecls.h (.../xotclDecls.h) (revision 46968ac6fcde3c5046aa0ede9a0e4c349e868de4) +++ generic/xotclDecls.h (.../xotclDecls.h) (revision 81c800c8b9cb42ef6743d9b80ac2be5ca211a69a) @@ -25,10 +25,10 @@ * Exported function declarations: */ -#ifndef Xotcl_Init_TCL_DECLARED -#define Xotcl_Init_TCL_DECLARED +#ifndef Next_Init_TCL_DECLARED +#define Next_Init_TCL_DECLARED /* 0 */ -EXTERN int Xotcl_Init (Tcl_Interp * interp); +EXTERN int Next_Init (Tcl_Interp * interp); #endif /* Slot 1 is reserved */ #ifndef XOTclIsClass_TCL_DECLARED @@ -241,7 +241,7 @@ int magic; struct XotclStubHooks *hooks; - int (*xotcl_Init) (Tcl_Interp * interp); /* 0 */ + int (*next_Init) (Tcl_Interp * interp); /* 0 */ void *reserved1; struct XOTcl_Class * (*xOTclIsClass) (Tcl_Interp * interp, ClientData cd); /* 2 */ void *reserved3; @@ -301,9 +301,9 @@ * Inline function declarations: */ -#ifndef Xotcl_Init -#define Xotcl_Init \ - (xotclStubsPtr->xotcl_Init) /* 0 */ +#ifndef Next_Init +#define Next_Init \ + (xotclStubsPtr->next_Init) /* 0 */ #endif /* Slot 1 is reserved */ #ifndef XOTclIsClass Index: generic/xotclInt.h =================================================================== diff -u -r9474936bd01f25c80caa91f9b3164a3072457f66 -r81c800c8b9cb42ef6743d9b80ac2be5ca211a69a --- generic/xotclInt.h (.../xotclInt.h) (revision 9474936bd01f25c80caa91f9b3164a3072457f66) +++ generic/xotclInt.h (.../xotclInt.h) (revision 81c800c8b9cb42ef6743d9b80ac2be5ca211a69a) @@ -582,9 +582,9 @@ "configure", /* var names */ "__autonames", "__default_metaclass", "__default_superclass", - "::xotcl::alias", + "::next::core::alias", /* object/class names */ - "::xotcl::methodParameterSlot", + "::next::methodParameterSlot", /* constants */ "alias", "args", "cmd", "filter", "forward", "method", "object", "setter", Index: generic/xotclStubInit.c =================================================================== diff -u -r46968ac6fcde3c5046aa0ede9a0e4c349e868de4 -r81c800c8b9cb42ef6743d9b80ac2be5ca211a69a --- generic/xotclStubInit.c (.../xotclStubInit.c) (revision 46968ac6fcde3c5046aa0ede9a0e4c349e868de4) +++ generic/xotclStubInit.c (.../xotclStubInit.c) (revision 81c800c8b9cb42ef6743d9b80ac2be5ca211a69a) @@ -36,7 +36,7 @@ XotclStubs xotclStubs = { TCL_STUB_MAGIC, &xotclStubHooks, - Xotcl_Init, /* 0 */ + Next_Init, /* 0 */ NULL, /* 1 */ XOTclIsClass, /* 2 */ NULL, /* 3 */ Index: library/comm/Connection.xotcl =================================================================== diff -u -rdf9b12b3347ec6d0aaab6a080619734cd4c45f34 -r81c800c8b9cb42ef6743d9b80ac2be5ca211a69a --- library/comm/Connection.xotcl (.../Connection.xotcl) (revision df9b12b3347ec6d0aaab6a080619734cd4c45f34) +++ library/comm/Connection.xotcl (.../Connection.xotcl) (revision 81c800c8b9cb42ef6743d9b80ac2be5ca211a69a) @@ -5,7 +5,7 @@ package require XOTcl namespace eval ::xotcl::comm::connection { - xotcl::use xotcl1 + namespace import ::xotcl::* Class Connection -parameter {host port req socket handle} Index: library/comm/Httpd.xotcl =================================================================== diff -u -r92c7f625cfc992f55193abbe7bd86e402cce776a -r81c800c8b9cb42ef6743d9b80ac2be5ca211a69a --- library/comm/Httpd.xotcl (.../Httpd.xotcl) (revision 92c7f625cfc992f55193abbe7bd86e402cce776a) +++ library/comm/Httpd.xotcl (.../Httpd.xotcl) (revision 81c800c8b9cb42ef6743d9b80ac2be5ca211a69a) @@ -17,7 +17,7 @@ package require xotcl::comm::mime namespace eval ::xotcl::comm::httpd { - xotcl::use xotcl1 + namespace import -force ::xotcl::* Class Httpd -parameter { {port 80} Index: library/comm/Mime.xotcl =================================================================== diff -u -rdf9b12b3347ec6d0aaab6a080619734cd4c45f34 -r81c800c8b9cb42ef6743d9b80ac2be5ca211a69a --- library/comm/Mime.xotcl (.../Mime.xotcl) (revision df9b12b3347ec6d0aaab6a080619734cd4c45f34) +++ library/comm/Mime.xotcl (.../Mime.xotcl) (revision 81c800c8b9cb42ef6743d9b80ac2be5ca211a69a) @@ -5,7 +5,7 @@ package require XOTcl namespace eval ::xotcl::comm::mime { - xotcl::use xotcl1 + namespace import ::xotcl::* ####################################################################### Class MimeTypeLoader Index: library/lib/makeDoc.xotcl =================================================================== diff -u -r217d826e64107056ae97176552cae3c776991b9e -r81c800c8b9cb42ef6743d9b80ac2be5ca211a69a --- library/lib/makeDoc.xotcl (.../makeDoc.xotcl) (revision 217d826e64107056ae97176552cae3c776991b9e) +++ library/lib/makeDoc.xotcl (.../makeDoc.xotcl) (revision 81c800c8b9cb42ef6743d9b80ac2be5ca211a69a) @@ -1,5 +1,9 @@ -#$Id: makeDoc.xotcl,v 1.6 2006/09/27 08:12:40 neumann Exp $ -package require XOTcl; xotcl::use xotcl1 +# +# XOTcl style documentation tools +# +package require XOTcl +namespace import ::xotcl::* + @ @File { description { Documentation tool for the XOTcl distribution.
Index: library/lib/metadataAnalyzer.xotcl =================================================================== diff -u -r32967f9cd85ab5b73e80781c150240d9c23ee7b0 -r81c800c8b9cb42ef6743d9b80ac2be5ca211a69a --- library/lib/metadataAnalyzer.xotcl (.../metadataAnalyzer.xotcl) (revision 32967f9cd85ab5b73e80781c150240d9c23ee7b0) +++ library/lib/metadataAnalyzer.xotcl (.../metadataAnalyzer.xotcl) (revision 81c800c8b9cb42ef6743d9b80ac2be5ca211a69a) @@ -453,6 +453,8 @@ AnalyzerCmd instproc unknown args { my instvar analyzerObj onOff + puts stderr "AnalyzerCmd: [self args]" + if {!$onOff} {return [next]} if {[llength $args] > 1} { Index: library/lib/pkgIndex.tcl =================================================================== diff -u -rdb31aba05701517b161d7633e64d5af925358ee0 -r81c800c8b9cb42ef6743d9b80ac2be5ca211a69a --- library/lib/pkgIndex.tcl (.../pkgIndex.tcl) (revision db31aba05701517b161d7633e64d5af925358ee0) +++ library/lib/pkgIndex.tcl (.../pkgIndex.tcl) (revision 81c800c8b9cb42ef6743d9b80ac2be5ca211a69a) @@ -8,7 +8,7 @@ # script is sourced, the variable $dir must contain the # full path name of this file's directory. -package ifneeded xotcl1 1.0 [list source [file join $dir xotcl1.xotcl]] +package ifneeded XOTcl 2.0 [list source [file join $dir xotcl1.xotcl]] package ifneeded xotcl::doc-tools 0.1 [list source [file join $dir doc-tools.xotcl]] package ifneeded xotcl::htmllib 0.1 [list source [file join $dir htmllib.xotcl]] package ifneeded xotcl::metadataAnalyzer 0.84 [list source [file join $dir metadataAnalyzer.xotcl]] Index: library/lib/staticMetadata.xotcl =================================================================== diff -u -r32967f9cd85ab5b73e80781c150240d9c23ee7b0 -r81c800c8b9cb42ef6743d9b80ac2be5ca211a69a --- library/lib/staticMetadata.xotcl (.../staticMetadata.xotcl) (revision 32967f9cd85ab5b73e80781c150240d9c23ee7b0) +++ library/lib/staticMetadata.xotcl (.../staticMetadata.xotcl) (revision 81c800c8b9cb42ef6743d9b80ac2be5ca211a69a) @@ -3,7 +3,7 @@ package provide xotcl::staticMetadataAnalyzer 0.84 namespace eval ::xotcl::staticMetadataAnalyzer { - ::xotcl::use xotcl1 + namespace import ::xotcl::* @ @File { description { Index: library/lib/test.xotcl =================================================================== diff -u -r4d21376ac1245e34cb5a5f52da893072f311d3a9 -r81c800c8b9cb42ef6743d9b80ac2be5ca211a69a --- library/lib/test.xotcl (.../test.xotcl) (revision 4d21376ac1245e34cb5a5f52da893072f311d3a9) +++ library/lib/test.xotcl (.../test.xotcl) (revision 81c800c8b9cb42ef6743d9b80ac2be5ca211a69a) @@ -4,27 +4,21 @@ namespace eval ::xotcl::test { ::xotcl::use xotcl2 - @ @File {description { - Simple regression test support. - }} + # @file Simple regression test support. - @ Class Test { - description { - Class Test is used to configure test instances, which can - be configured by the following parameters: - <@ul> - <@li>cmd: the command to be executed - <@li>expected: the expected result - <@li>count: number of executions of cmd - <@li>pre: a command to be executed at the begin of the test (before cmd) - <@li>post: a command to be executed after the test (after all cmds) - <@li>namespace in which pre, post and cmd are evaluated; default :: - - The defined tests can be executed by <@tt>Test run - } - } - Class create Test { + # + # Class Test is used to configure test instances, which can + # be configured by the following parameters: + # + # @param cmd the command to be executed + # @param expected the expected result + # @param count number of executions of cmd + # @param pre a command to be executed at the begin of the test (before cmd) + # @param post a command to be executed after the test (after all cmds) + # @param namespace in which pre, post and cmd are evaluated; default "::" + # + # The defined tests can be executed by [:cmd "Test run"] :attribute {name ""} :attribute cmd @@ -59,7 +53,7 @@ foreach o [Object info instances -closure] { if {[info exists pre_exist($o)]} continue #puts "must destroy $o" - if {[::xotcl::is $o object]} {$o destroy} + if {[::next::core::objectproperty $o object]} {$o destroy} } } } @@ -130,6 +124,7 @@ } else { puts stderr "[set :name]:\tincorrect result for '${:msg}'" puts stderr "\texpected: '${:expected}', got '$r' [info exists :errorReport]" + puts stderr "\tin test file [info script]" if {[info exists :errorReport]} {eval [set :errorReport]} exit -1 } Index: library/lib/xodoc.xotcl =================================================================== diff -u -r32967f9cd85ab5b73e80781c150240d9c23ee7b0 -r81c800c8b9cb42ef6743d9b80ac2be5ca211a69a --- library/lib/xodoc.xotcl (.../xodoc.xotcl) (revision 32967f9cd85ab5b73e80781c150240d9c23ee7b0) +++ library/lib/xodoc.xotcl (.../xodoc.xotcl) (revision 81c800c8b9cb42ef6743d9b80ac2be5ca211a69a) @@ -5,7 +5,7 @@ package require xotcl::htmllib namespace eval ::xotcl::xodoc { - ::xotcl::use xotcl1 + namespace import ::xotcl::* @ @File { description { Index: library/lib/xotcl1.xotcl =================================================================== diff -u -r15b6823910520e77bfa8c2cf4ea78289af91c28c -r81c800c8b9cb42ef6743d9b80ac2be5ca211a69a --- library/lib/xotcl1.xotcl (.../xotcl1.xotcl) (revision 15b6823910520e77bfa8c2cf4ea78289af91c28c) +++ library/lib/xotcl1.xotcl (.../xotcl1.xotcl) (revision 81c800c8b9cb42ef6743d9b80ac2be5ca211a69a) @@ -1,4 +1,5 @@ -package provide xotcl1 1.0 +package provide XOTcl 2.0 +package require next ####################################################### # Classical ::xotcl-1.* ####################################################### @@ -9,7 +10,7 @@ # ::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 { + ::next::core::createobjectsystem ::xotcl::Object ::xotcl::Class { -class.alloc alloc -class.create create -class.dealloc dealloc @@ -26,48 +27,59 @@ -object.unknown unknown } + # + # create ::next and ::next core namespaces, otherwise mk_pkgindex will fail + # + namespace eval ::next {} + namespace eval ::next::core {} + # + # get frequenly used primitiva into the ::xotcl namespace + # + namespace import ::next::core::* + namespace import ::next::Attribute + # provide the standard command set for ::xotcl::Object - foreach cmd [info command ::xotcl::cmd::Object::*] { + foreach cmd [info command ::next::core::cmd::Object::*] { set cmdName [namespace tail $cmd] if {$cmdName in [list "filtersearch" "setter"]} continue - ::xotcl::alias Object $cmdName $cmd + ::next::core::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 + ::next::core::alias Object $cmd -objscope ::$cmd } # provide the standard command set for ::xotcl::Class - foreach cmd [info command ::xotcl::cmd::Class::*] { + foreach cmd [info command ::next::core::cmd::Class::*] { set cmdName [namespace tail $cmd] if {$cmdName in [list "setter"]} continue - ::xotcl::alias Class $cmdName $cmd + ::next::core::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 + ::next::core::methodproperty Object destroy redefine-protected true + ::next::core::methodproperty Class alloc redefine-protected true + ::next::core::methodproperty Class dealloc redefine-protected true + ::next::core::methodproperty Class create redefine-protected true # define instproc and proc - ::xotcl::method Class instproc { + ::next::core::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 + ::next::core::method [self] $name $arguments $body {*}$conditions } - ::xotcl::method Object proc { + ::next::core::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 + ::next::core::method [self] -per-object $name $arguments $body {*}$conditions } # define - like in XOTcl 1 - a minimal implementation of "method" @@ -83,8 +95,8 @@ } # define forward methods - ::xotcl::forward Object forward ::xotcl::forward %self -per-object - ::xotcl::forward Class instforward ::xotcl::forward %self + ::next::core::forward Object forward ::next::core::forward %self -per-object + ::next::core::forward Class instforward ::next::core::forward %self Class instproc unknown {args} { #puts stderr "use '[self] create $args', not '[self] $args'" @@ -106,16 +118,16 @@ # object-parameter definition, backwards compatible # ::xotcl::Object instproc objectparameter {} { - set parameterdefinitions [::xotcl::parametersFromSlots [self]] + set parameterdefinitions [::next::core::parametersFromSlots [self]] lappend parameterdefinitions args #puts stderr "*** parameter definition for [self]: $parameterdefinitions" return $parameterdefinitions } # - # use parameter definition from xotcl2 + # use parameter definition from next # - ::xotcl::alias ::xotcl::Class parameter ::xotcl::classes::xotcl2::Class::parameter + ::next::core::alias ::xotcl::Class parameter ::next::core::classes::next::Class::parameter # We provide a default value for superclass (when no superclass is # specified explicitely) and metaclass, in case they should differ @@ -135,20 +147,20 @@ ${os}::Object alloc ${os}::Class::slot ${os}::Object alloc ${os}::Object::slot - ::xotcl::RelationSlot create ${os}::Class::slot::superclass - ::xotcl::alias ${os}::Class::slot::superclass assign ::xotcl::relation - ::xotcl::RelationSlot create ${os}::Object::slot::class -multivalued false - ::xotcl::alias ${os}::Object::slot::class assign ::xotcl::relation + ::next::RelationSlot create ${os}::Class::slot::superclass + ::next::core::alias ${os}::Class::slot::superclass assign ::next::core::relation + ::next::RelationSlot create ${os}::Object::slot::class -multivalued false + ::next::core::alias ${os}::Object::slot::class assign ::next::core::relation - ::xotcl::RelationSlot create ${os}::Object::slot::mixin \ + ::next::RelationSlot create ${os}::Object::slot::mixin \ -methodname object-mixin - ::xotcl::RelationSlot create ${os}::Object::slot::filter \ + ::next::RelationSlot create ${os}::Object::slot::filter \ -methodname object-filter \ -elementtype "" - ::xotcl::RelationSlot create ${os}::Class::slot::instmixin \ + ::next::RelationSlot create ${os}::Class::slot::instmixin \ -methodname class-mixin - ::xotcl::RelationSlot create ${os}::Class::slot::instfilter \ + ::next::RelationSlot create ${os}::Class::slot::instfilter \ -methodname class-filter \ -elementtype "" } @@ -162,8 +174,8 @@ 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} + Object instforward info -onerror ::next::core::infoError ::xotcl::objectInfo %1 {%@2 %self} + Class instforward info -onerror ::next::core::infoError ::xotcl::classInfo %1 {%@2 %self} objectInfo proc info {obj} { set methods [list] @@ -238,8 +250,8 @@ 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] { + argName [::next::core::cmd::${allocation}Info::method $o args $method] \ + flag [::next::core::cmd::${allocation}Info::method $o parameter $method] { if {[string match -* $flag]} continue lappend result $argName } @@ -249,7 +261,7 @@ proc ::xotcl::info_nonposargs {allocation o method} { set result [list] - foreach flag [::xotcl::cmd::${allocation}Info::method $o parameter $method] { + foreach flag [::next::core::cmd::${allocation}Info::method $o parameter $method] { if {![string match -* $flag]} continue lappend result $flag } @@ -258,8 +270,8 @@ } 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] { + argName [::next::core::cmd::${allocation}Info::method $o args $method] \ + flag [::next::core::cmd::${allocation}Info::method $o parameter $method] { if {$argName eq $arg} { upvar 3 $varName default if {[llength $flag] == 2} { @@ -284,25 +296,25 @@ :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} + :proc instbody {o methodName} {::next::core::cmd::ClassInfo::method $o body $methodName} + :proc instpre {o methodName} {::next::core::cmd::ClassInfo::method $o precondition $methodName} + :proc instpost {o methodName} {::next::core::cmd::ClassInfo::method $o postcondition $methodName} # info options emulated by "info methods" :proc instcommands {o {pattern:optional ""}} { - ::xotcl::cmd::ClassInfo::methods $o {*}$pattern + ::next::core::cmd::ClassInfo::methods $o {*}$pattern } :proc instprocs {o {pattern:optional ""}} { - ::xotcl::cmd::ClassInfo::methods $o -methodtype scripted {*}$pattern + ::next::core::cmd::ClassInfo::methods $o -methodtype scripted {*}$pattern } :proc parametercmd {o {pattern:optional ""}} { - ::xotcl::cmd::ClassInfo::methods $o -per-object -methodtype setter {*}$pattern + ::next::core::cmd::ClassInfo::methods $o -per-object -methodtype setter {*}$pattern } :proc instparametercmd {o {pattern:optional ""}} { - ::xotcl::cmd::ClassInfo::methods $o -methodtype setter {*}$pattern + ::next::core::cmd::ClassInfo::methods $o -methodtype setter {*}$pattern } # assertion handling - :proc instinvar {o} {::xotcl::assertion $o class-invar} + :proc instinvar {o} {::next::core::assertion $o class-invar} } objectInfo eval { @@ -311,24 +323,24 @@ :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} + :proc body {o methodName} {::next::core::cmd::ObjectInfo::method $o body $methodName} + :proc pre {o methodName} {::next::core::cmd::ObjectInfo::method $o pre $methodName} + :proc post {o methodName} {::next::core::cmd::ObjectInfo::method $o post $methodName} # info options emulated by "info methods" :proc commands {o {pattern:optional ""}} { - ::xotcl::cmd::ObjectInfo::methods $o {*}$pattern + ::next::core::cmd::ObjectInfo::methods $o {*}$pattern } :proc procs {o {pattern:optional ""}} { - ::xotcl::cmd::ObjectInfo::methods $o -methodtype scripted {*}$pattern + ::next::core::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 builtin} - set cmd [list ::xotcl::cmd::ObjectInfo::callable $o -methodtype $methodtype] + set cmd [list ::next::core::cmd::ObjectInfo::callable $o -methodtype $methodtype] if {$incontext} {lappend cmd -incontext} if {[::info exists pattern]} {lappend cmd $pattern} eval $cmd @@ -338,88 +350,88 @@ 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] + set def [::next::core::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] + set def [::next::core::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] + ::xotcl::checkoption_internal_to_xotcl1 [::next::core::assertion $o check] } - :proc invar {o} {::xotcl::assertion $o object-invar} + :proc invar {o} {::next::core::assertion $o object-invar} } - foreach cmd [::info command ::xotcl::cmd::ObjectInfo::*] { + foreach cmd [::info command ::next::core::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 + ::next::core::alias ::xotcl::objectInfo $cmdName $cmd + ::next::core::alias ::xotcl::classInfo $cmdName $cmd } - foreach cmd [::info command ::xotcl::cmd::ClassInfo::*] { + foreach cmd [::info command ::next::core::cmd::ClassInfo::*] { set cmdName [namespace tail $cmd] if {$cmdName in [list "forward" "method" "methods" \ "mixinof" "object-mixin-of" \ "filter" "filterguard" \ "mixin" "mixinguard"]} continue - ::xotcl::alias ::xotcl::classInfo $cmdName $cmd + ::next::core::alias ::xotcl::classInfo $cmdName $cmd } - ::xotcl::alias ::xotcl::objectInfo is ::xotcl::objectproperty - ::xotcl::alias ::xotcl::classInfo is ::xotcl::objectproperty - ::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::forward ::xotcl::classInfo instmixinof ::xotcl::cmd::ClassInfo::mixinof %1 -scope class - ::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 - ::xotcl::forward ::xotcl::classInfo mixinof ::xotcl::cmd::ClassInfo::mixinof %1 -scope object + ::next::core::alias ::xotcl::objectInfo is ::next::core::objectproperty + ::next::core::alias ::xotcl::classInfo is ::next::core::objectproperty + ::next::core::alias ::xotcl::classInfo classparent ::next::core::cmd::ObjectInfo::parent + ::next::core::alias ::xotcl::classInfo classchildren ::next::core::cmd::ObjectInfo::children + ::next::core::alias ::xotcl::classInfo instmixin ::next::core::cmd::ClassInfo::mixin + ::next::core::alias ::xotcl::classInfo instmixinguard ::next::core::cmd::ClassInfo::mixinguard + #::next::core::alias ::xotcl::classInfo instmixinof ::next::core::cmd::ClassInfo::class-mixin-of + ::next::core::forward ::xotcl::classInfo instmixinof ::next::core::cmd::ClassInfo::mixinof %1 -scope class + ::next::core::alias ::xotcl::classInfo instfilter ::next::core::cmd::ClassInfo::filter + ::next::core::alias ::xotcl::classInfo instfilterguard ::next::core::cmd::ClassInfo::filterguard + ::next::core::alias ::xotcl::classInfo instforward ::next::core::cmd::ClassInfo::forward + #::next::core::alias ::xotcl::classInfo mixinof ::next::core::cmd::ClassInfo::object-mixin-of + ::next::core::forward ::xotcl::classInfo mixinof ::next::core::cmd::ClassInfo::mixinof %1 -scope object # assertion handling - ::xotcl::alias ::xotcl::classInfo invar objectInfo::invar - ::xotcl::alias ::xotcl::classInfo check objectInfo::check + ::next::core::alias ::xotcl::classInfo invar objectInfo::invar + ::next::core::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 + ::next::core::alias classInfo body objectInfo::body + ::next::core::alias classInfo commands objectInfo::commands + ::next::core::alias classInfo filter objectInfo::filter + ::next::core::alias classInfo methods objectInfo::methods + ::next::core::alias classInfo procs objectInfo::procs + ::next::core::alias classInfo pre objectInfo::pre + ::next::core::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] object -hasmixin $class} - Object instproc istype {class} {::xotcl::is [self] type $class} + Object instproc isobject {{object:substdefault "[self]"}} {::next::core::objectproperty $object object} + Object instproc isclass {{class:substdefault "[self]"}} {::next::core::objectproperty $class class} + Object instproc ismetaclass {{class:substdefault "[self]"}} {::next::core::objectproperty $class metaclass} + Object instproc ismixin {class} {::next::core::is [self] object -hasmixin $class} + Object instproc istype {class} {::next::core::is [self] type $class} - ::xotcl::alias Object contains ::xotcl::classes::xotcl2::Object::contains + ::next::core::alias Object contains ::next::core::classes::next::Object::contains ::xotcl::Class instforward slots %self contains \ - -object {%::xotcl::dispatch [::xotcl::self] -objscope ::subst [::xotcl::self]::slot} + -object {%::next::core::dispatch [::xotcl::self] -objscope ::subst [::xotcl::self]::slot} # - # define parametercmd and instparametercmd in terms of ::xotcl2 method setter + # define parametercmd and instparametercmd in terms of ::next 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 + ::next::core::alias Object parametercmd ::next::core::classes::next::Object::setter + ::next::core::alias Class instparametercmd ::next::core::classes::next::Class::setter - ::xotcl::alias Class filterguard ::xotcl::cmd::Object::filterguard - ::xotcl::alias Class instfilterguard ::xotcl::cmd::Class::filterguard + ::next::core::alias Class filterguard ::next::core::cmd::Object::filterguard + ::next::core::alias Class instfilterguard ::next::core::cmd::Class::filterguard - ::xotcl::alias Class mixinguard ::xotcl::cmd::Object::mixinguard - ::xotcl::alias Class instmixinguard ::xotcl::cmd::Class::mixinguard + ::next::core::alias Class mixinguard ::next::core::cmd::Object::mixinguard + ::next::core::alias Class instmixinguard ::next::core::cmd::Class::mixinguard # assertion handling proc checkoption_xotcl1_to_internal checkoptions { @@ -477,10 +489,10 @@ Object instproc check {checkoptions} { - ::xotcl::assertion [self] check [::xotcl::checkoption_xotcl1_to_internal $checkoptions] + ::next::core::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 instforward invar ::next::core::assertion %self object-invar + Class instforward instinvar ::next::core::assertion %self class-invar Object instproc abstract {methtype methname arglist} { if {$methtype ne "proc" && $methtype ne "instproc" && $methtype ne "method"} { @@ -496,20 +508,20 @@ # support for XOTcl 1.* specific convenience routines Object instproc hasclass cl { - if {[::xotcl::is [self] object -hasmixin $cl]} {return 1} - ::xotcl::is [self] type $cl + if {[::next::core::is [self] object -hasmixin $cl]} {return 1} + ::next::core::is [self] type $cl } Object instproc filtersearch {filter} { - set definition [::xotcl::dispatch [self] ::xotcl::cmd::Object::filtersearch $filter] + set definition [::next::core::dispatch [self] ::next::core::cmd::Object::filtersearch $filter] return [filterorder_to_xotcl1 $definition] } Object instproc procsearch {name} { - set definition [::xotcl::cmd::ObjectInfo::callable [self] -which $name] + set definition [::next::core::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] + set perClass [::next::core::is $obj class] } else { set perClass 0 } @@ -530,16 +542,16 @@ } # 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} + Object proc unsetExitHandler {} {::next::core::unsetExitHandler $newbody} + Object proc setExitHandler {newbody} {::next::core::setExitHandler $newbody} + Object proc getExitHandler {} {::next::core::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 + # resue some definitions from ::next + ::next::core::alias ::xotcl::Object copy ::next::core::classes::next::Object::copy + ::next::core::alias ::xotcl::Object move ::next::core::classes::next::Object::move + ::next::core::alias ::xotcl::Object defaultmethod ::next::core::classes::next::Object::defaultmethod - ::xotcl::alias ::xotcl::Class -per-object __unknown ::xotcl2::Class::__unknown + ::next::core::alias ::xotcl::Class -per-object __unknown ::next::Class::__unknown proc myproc {args} {linsert $args 0 [::xotcl::self]} proc myvar {var} {.requireNamespace; return [::xotcl::self]::$var} @@ -663,7 +675,7 @@ puts stderr "*** using ${package}::* in [::xotcl::self]" } } - ::xotcl2::Class create ::xotcl::package -superclass ::xotcl::Class -parameter { + ::next::Class create ::xotcl::package -superclass ::xotcl::Class -parameter { provide {version 1.0} {autoexport {}} @@ -770,6 +782,30 @@ } if {[info exists cmd]} {unset cmd} + + + # documentation stub object -> just ignore per default. + # if xoDoc is loaded, documentation will be activated + ::xotcl::Object create ::xotcl::@ + ::xotcl::@ proc unknown args {} + + # + # set xotcl version variables + # + # check for variable, otherwise mk_pkgindex will fail + if {[info exists ::next::core::version]} { + set ::xotcl::version $::next::core::version + set ::xotcl::patchlevel $::next::core::patchlevel + } + + set ::xotcl::confdir ~/.xotcl + set ::xotcl::logdir $::xotcl::confdir/log + namespace import ::next::core::tmpdir + # finally, export contents defined for xotcl 1.* - namespace export Object Class myproc myvar + namespace export Object Class Attribute myproc myvar my self next @ } + +foreach ns {::next::core ::next ::xotcl} { + puts stderr "$ns exports [namespace eval $ns {lsort [namespace export]}]" +} \ No newline at end of file Index: library/serialize/Serializer.xotcl =================================================================== diff -u -r7b269f76914972e68ebdd5d419f543793bb01c51 -r81c800c8b9cb42ef6743d9b80ac2be5ca211a69a --- library/serialize/Serializer.xotcl (.../Serializer.xotcl) (revision 7b269f76914972e68ebdd5d419f543793bb01c51) +++ library/serialize/Serializer.xotcl (.../Serializer.xotcl) (revision 81c800c8b9cb42ef6743d9b80ac2be5ca211a69a) @@ -2,18 +2,16 @@ package require XOTcl package provide xotcl::serializer 1.0 -# For the time being, we require xotcl1. +# For the time being, we require classical XOTcl. -# TODO: separate into two packages (i.e. make one xotcl1 specific +# TODO: separate into two packages (i.e. make one XOTcl specific # serializer package, and (a) load this package on a load of this # package (when ::xotcl::Object is defined), and (b) load it from -# "xotcl::use xotcl1", when the serializer is alreaded loaded. +# "xotcl1.tcl", when the serializer is alreaded loaded. -package require xotcl1 - namespace eval ::xotcl::serializer { - ::xotcl::use xotcl2 + namespace import ::next::* @ @File { description { @@ -298,7 +296,7 @@ :object method allChildren o { # return o and all its children fully qualified - set set [::xotcl::dispatch $o -objscope ::xotcl::self] + set set [::next::core::dispatch $o -objscope ::xotcl::self] foreach c [$o info children] { lappend set {*}[:allChildren $c] } @@ -352,15 +350,15 @@ :object method all {-ignoreVarsRE -ignore} { # don't filter anything during serialization - set filterstate [::xotcl::configure filter off] + set filterstate [::next::core::configure filter off] set s [:new -childof [self] -volatile] if {[info exists ignoreVarsRE]} {$s ignoreVarsRE $ignoreVarsRE} if {[info exists ignore]} {$s ignore $ignore} set r [subst { - set ::xotcl::__filterstate \[::xotcl::configure filter off\] + set ::xotcl::__filterstate \[::next::core::configure filter off\] #::xotcl::Slot mixin add ::xotcl::Slot::Nocheck - ::xotcl::configure softrecreate [::xotcl::configure softrecreate] + ::next::core::configure softrecreate [::next::core::configure softrecreate] ::xotcl::setExitHandler [list [::xotcl::getExitHandler]] }]\n :resetPattern @@ -385,10 +383,10 @@ append r { #::xotcl::Slot mixin delete ::xotcl::Slot::Nocheck - ::xotcl::configure filter $::xotcl::__filterstate + ::next::core::configure filter $::xotcl::__filterstate unset ::xotcl::__filterstate } - ::xotcl::configure filter $filterstate + ::next::core::configure filter $filterstate return $r } @@ -440,19 +438,19 @@ set cmd "" foreach o [list ${:rootClass} ${:rootMetaClass}] { append cmd \ - [:frameWorkCmd ::xotcl::relation $o object-mixin] \ - [:frameWorkCmd ::xotcl::relation $o class-mixin] \ - [:frameWorkCmd ::xotcl::assertion $o object-invar] \ - [:frameWorkCmd ::xotcl::assertion $o class-invar] + [:frameWorkCmd ::next::core::relation $o object-mixin] \ + [:frameWorkCmd ::next::core::relation $o class-mixin] \ + [:frameWorkCmd ::next::core::assertion $o object-invar] \ + [:frameWorkCmd ::next::core::assertion $o class-invar] } return $cmd } :method registerTrace {on} { if {$on} { - ::xotcl::alias ${:rootClass} __trace__ -objscope ::trace + ::next::core::alias ${:rootClass} __trace__ -objscope ::trace } else { - ::xotcl::method ${:rootClass} __trace__ {} {} + ::next::core::method ${:rootClass} __trace__ {} {} } } @@ -514,7 +512,7 @@ if {[$o eval [list ::array exists :$v]]} { lappend setcmd [list array set :$v [$o eval [list array get :$v]]] } else { - lappend setcmd [list set :$v [::xotcl::setvar $o $v]] + lappend setcmd [list set :$v [::next::core::setvar $o $v]] } } } @@ -593,7 +591,7 @@ if {![:Object-needsNothing $x $s]} {return 0} set scs [$x info superclass] if {[$s needsOneOf $scs]} {return 0} - if {[$s needsOneOf [::xotcl::relation $x class-mixin]]} {return 0} + if {[$s needsOneOf [::next::core::relation $x class-mixin]]} {return 0} foreach sc $scs {if {[$s needsOneOf [$sc info slots]]} {return 0}} return 1 } @@ -609,26 +607,26 @@ } ########################################################################### - # XOTcl 2 specific serializer + # next specific serializer ########################################################################### ObjectSystemSerializer create Serializer2 { - set :rootClass ::xotcl2::Object - set :rootMetaClass ::xotcl2::Class - array set :ignorePattern [list "::xotcl2::*" 1 "::xotcl::*" 1] + set :rootClass ::next::Object + set :rootMetaClass ::next::Class + array set :ignorePattern [list "::next::*" 1 "::xotcl::*" 1] :method serialize-all-start {s} { - if {[info command ::Object] ne "" && [namespace origin ::Object] eq "::xotcl2::Object"} { - set intro "::xotcl::use xotcl2" + if {[info command ::Object] ne "" && [namespace origin ::Object] eq "::next::Object"} { + set intro "package require next; namespace import -force ::next::*" } else { set intro "" } return "$intro\n[next]" } ############################### - # XOTcl 2 method serialization + # next method serialization ############################### :method methodExists {object kind name} { @@ -646,54 +644,54 @@ } ############################### - # XOTcl 2 object serialization + # next object serialization ############################### :method Object-serialize {o s} { :collect-var-traces $o $s append cmd [list [$o info class] create \ - [::xotcl::dispatch $o -objscope ::xotcl::self]] + [::next::core::dispatch $o -objscope ::xotcl::self]] append cmd " -noinit\n" - foreach i [lsort [::xotcl::cmd::ObjectInfo::methods $o]] { + foreach i [lsort [::next::core::cmd::ObjectInfo::methods $o]] { append cmd [:method-serialize $o $i "object"] "\n" } append cmd \ [list $o eval [join [:collectVars $o] "\n "]]\n \ - [:frameWorkCmd ::xotcl::relation $o object-mixin] \ - [:frameWorkCmd ::xotcl::assertion $o object-invar] + [:frameWorkCmd ::next::core::relation $o object-mixin] \ + [:frameWorkCmd ::next::core::assertion $o object-invar] if {[::xotcl::is $o type ::xotcl::Slot]} { # Slots needs to be initialized to ensure # __invalidateobjectparameter to be called append cmd [list $o eval :init] \n } - $s addPostCmd [:frameWorkCmd ::xotcl::relation $o object-filter] + $s addPostCmd [:frameWorkCmd ::next::core::relation $o object-filter] return $cmd } ############################### - # XOTcl 2 class serialization + # next class serialization ############################### :method Class-serialize {o s} { set cmd [:Object-serialize $o $s] - foreach i [lsort [::xotcl::cmd::ClassInfo::methods $o]] { + foreach i [lsort [::next::core::cmd::ClassInfo::methods $o]] { append cmd [:method-serialize $o $i ""] "\n" } append cmd \ - [:frameWorkCmd ::xotcl::relation $o superclass -unless ${:rootClass}] \ - [:frameWorkCmd ::xotcl::relation $o class-mixin] \ - [:frameWorkCmd ::xotcl::assertion $o class-invar] + [:frameWorkCmd ::next::core::relation $o superclass -unless ${:rootClass}] \ + [:frameWorkCmd ::next::core::relation $o class-mixin] \ + [:frameWorkCmd ::next::core::assertion $o class-invar] - $s addPostCmd [:frameWorkCmd ::xotcl::relation $o class-filter] + $s addPostCmd [:frameWorkCmd ::next::core::relation $o class-filter] return $cmd\n } # register serialize a global method - ::xotcl2::Object method serialize {} { + ::next::Object method serialize {} { ::Serializer deepSerialize [self] } @@ -702,7 +700,7 @@ ########################################################################### - # XOTcl 1 specific serializer + # XOTcl specific serializer ########################################################################### ObjectSystemSerializer create Serializer1 { @@ -712,20 +710,20 @@ array set :ignorePattern [list "::xotcl::*" 1] :method serialize-all-start {s} { - set intro "package require xotcl1" + set intro "package require XOTcl" if {[info command ::Object] ne "" && [namespace origin ::Object] eq "::xotcl::Object"} { - set intro "::xotcl::use xotcl1" + set intro "namespace import -force ::xotcl::*" } return "$intro\n::xotcl::Object instproc trace args {}\n[next]" } :method serialize-all-end {s} { - return "[next]\n::xotcl::alias ::xotcl::Object trace -objscope ::trace\n" + return "[next]\n::next::core::alias ::xotcl::Object trace -objscope ::trace\n" } ############################### - # XOTcl 1 method serialization + # XOTcl method serialization ############################### :method methodExists {object kind name} { @@ -773,36 +771,36 @@ } ############################### - # XOTcl 1 object serialization + # XOTcl object serialization ############################### :method Object-serialize {o s} { :collect-var-traces $o $s - append cmd [list [$o info class] create [::xotcl::dispatch $o -objscope ::xotcl::self]] + append cmd [list [$o info class] create [::next::core::dispatch $o -objscope ::xotcl::self]] # slots needs to be initialized when optimized, since # parametercmds are not serialized append cmd " -noinit\n" - foreach i [::xotcl::cmd::ObjectInfo::methods $o -methodtype scripted] { + foreach i [::next::core::cmd::ObjectInfo::methods $o -methodtype scripted] { append cmd [:method-serialize $o $i ""] "\n" } - foreach i [::xotcl::cmd::ObjectInfo::methods $o -methodtype forward] { + foreach i [::next::core::cmd::ObjectInfo::methods $o -methodtype forward] { append cmd [concat [list $o] forward $i [$o info forward -definition $i]] "\n" } - foreach i [::xotcl::cmd::ObjectInfo::methods $o -methodtype setter] { + foreach i [::next::core::cmd::ObjectInfo::methods $o -methodtype setter] { append cmd [list $o parametercmd $i] "\n" } append cmd \ [list $o eval [join [:collectVars $o] "\n "]] \n \ - [:frameWorkCmd ::xotcl::relation $o object-mixin] \ - [:frameWorkCmd ::xotcl::assertion $o object-invar] + [:frameWorkCmd ::next::core::relation $o object-mixin] \ + [:frameWorkCmd ::next::core::assertion $o object-invar] - $s addPostCmd [:frameWorkCmd ::xotcl::relation $o object-filter] + $s addPostCmd [:frameWorkCmd ::next::core::relation $o object-filter] return $cmd } ############################### - # XOTcl 1 class serialization + # XOTcl class serialization ############################### :method Class-serialize {o s} { @@ -816,25 +814,25 @@ foreach i [$o info instparametercmd] { append cmd [list $o instparametercmd $i] "\n" } - # provide limited support for exporting aliases for xotcl1 objects - foreach i [::xotcl::cmd::ClassInfo::methods $o -methodtype alias] { - set xotcl2Def [::xotcl::cmd::ClassInfo::method $o definition $i] + # provide limited support for exporting aliases for XOTcl objects + foreach i [::next::core::cmd::ClassInfo::methods $o -methodtype alias] { + set xotcl2Def [::next::core::cmd::ClassInfo::method $o definition $i] set objscope [lindex $xotcl2Def end-2] set methodName [lindex $xotcl2Def end-1] set cmdName [lindex $xotcl2Def end] if {$objscope ne "-objscope"} {set objscope ""} - append cmd [list ::xotcl::alias $o $methodName {*}$objscope $cmdName]\n + append cmd [list ::next::core::alias $o $methodName {*}$objscope $cmdName]\n } append cmd \ - [:frameWorkCmd ::xotcl::relation $o superclass -unless ${:rootClass}] \ - [:frameWorkCmd ::xotcl::relation $o class-mixin] \ - [:frameWorkCmd ::xotcl::assertion $o class-invar] + [:frameWorkCmd ::next::core::relation $o superclass -unless ${:rootClass}] \ + [:frameWorkCmd ::next::core::relation $o class-mixin] \ + [:frameWorkCmd ::next::core::assertion $o class-invar] - $s addPostCmd [:frameWorkCmd ::xotcl::relation $o class-filter] + $s addPostCmd [:frameWorkCmd ::next::core::relation $o class-filter] return $cmd } - # register serialize a global method for xotcl1 + # register serialize a global method for XOTcl ::xotcl::Object instproc serialize {} { ::Serializer deepSerialize [self] } Index: tests/UNIVERSAL.test =================================================================== diff -u -rc72f9f638677608fab1502cd696c8f2d6b2952f9 -r81c800c8b9cb42ef6743d9b80ac2be5ca211a69a --- tests/UNIVERSAL.test (.../UNIVERSAL.test) (revision c72f9f638677608fab1502cd696c8f2d6b2952f9) +++ tests/UNIVERSAL.test (.../UNIVERSAL.test) (revision 81c800c8b9cb42ef6743d9b80ac2be5ca211a69a) @@ -1,4 +1,4 @@ -# $Id $ +# -*- Tcl -*- #if {[set ::tcl_platform(platform)] == "windows"} {lappend auto_path .} package require XOTcl; namespace import -force xotcl::* Index: tests/actiweb.test =================================================================== diff -u -rc72f9f638677608fab1502cd696c8f2d6b2952f9 -r81c800c8b9cb42ef6743d9b80ac2be5ca211a69a --- tests/actiweb.test (.../actiweb.test) (revision c72f9f638677608fab1502cd696c8f2d6b2952f9) +++ tests/actiweb.test (.../actiweb.test) (revision 81c800c8b9cb42ef6743d9b80ac2be5ca211a69a) @@ -1,5 +1,4 @@ # -*- Mode: tcl -*- -# $Id: actiweb.test,v 1.9 2006/09/27 08:12:40 neumann Exp $ # regression test for actiweb examples #if {[set ::tcl_platform(platform)] == "windows"} { # lappend auto_path . Index: tests/aliastest.xotcl =================================================================== diff -u -rd337d1f94a287b8d694b50c4b1000151de21098c -r81c800c8b9cb42ef6743d9b80ac2be5ca211a69a --- tests/aliastest.xotcl (.../aliastest.xotcl) (revision d337d1f94a287b8d694b50c4b1000151de21098c) +++ tests/aliastest.xotcl (.../aliastest.xotcl) (revision 81c800c8b9cb42ef6743d9b80ac2be5ca211a69a) @@ -5,11 +5,11 @@ Test case alias-preliminaries { # The system methods of Object are either alias or forwarders - ? {lsort [::xotcl::ObjectParameterSlot info methods -methodtype alias]} {assign get} - ? {::xotcl::ObjectParameterSlot info method definition get} "::xotcl::ObjectParameterSlot alias get ::xotcl::setvar" + ? {lsort [::next::ObjectParameterSlot info methods -methodtype alias]} {assign get} + ? {::next::ObjectParameterSlot info method definition get} "::next::ObjectParameterSlot alias get ::next::core::setvar" # define an alias and retrieve its definition - set cmd "::xotcl2::Object alias -objscope set ::set" + set cmd "::next::Object alias -objscope set ::set" eval $cmd ? {Object info method definition set} $cmd @@ -22,9 +22,9 @@ } Class create Foo - ::xotcl::alias ::Foo foo ::xotcl::classes::Base::foo + ::next::core::alias ::Foo foo ::next::core::classes::Base::foo - ? {Foo info method definition foo} "::Foo alias foo ::xotcl::classes::Base::foo" + ? {Foo info method definition foo} "::Foo alias foo ::next::core::classes::Base::foo" Foo create f1 ? {f1 foo} 1 @@ -42,7 +42,7 @@ Base method foo {{-x 1}} {return $x} - ::xotcl::alias ::Foo foo ::xotcl::classes::Base::foo + ::next::core::alias ::Foo foo ::next::core::classes::Base::foo ? {Base info methods -methodtype scripted} {foo} "defined again" ? {Foo info methods -methodtype alias} {foo} "aliased again" @@ -63,7 +63,7 @@ T method foo args { return [self class]->[self proc] } - ::xotcl::alias T FOO ::xotcl::classes::T::foo + ::next::core::alias T FOO ::next::core::classes::T::foo ? {t foo} ::T->foo ? {t FOO} ::T->foo @@ -74,28 +74,28 @@ # puts stderr "double indirection" T method foo args { return [self class]->[self proc] } - ::xotcl::alias T FOO ::xotcl::classes::T::foo - ::xotcl::alias S BAR ::xotcl::classes::T::FOO + ::next::core::alias T FOO ::next::core::classes::T::foo + ::next::core::alias S BAR ::next::core::classes::T::FOO ? {T info methods -methodtype alias} "FOO" - ? {T info method definition FOO} "::T alias FOO ::xotcl::classes::T::foo" + ? {T info method definition FOO} "::T alias FOO ::next::core::classes::T::foo" ? {lsort [T info methods]} {FOO foo} ? {S info methods} {BAR} T method FOO {} {} ? {T info methods} {foo} ? {S info methods} {BAR} ? {s BAR} ::S->foo ? {t foo} ::T->foo - ? {S info method definition BAR} "::S alias BAR ::xotcl::classes::T::FOO" + ? {S info method definition BAR} "::S alias BAR ::next::core::classes::T::FOO" T method foo {} {} ? {T info methods} {} ? {S info methods} {} T method foo args { return [self class]->[self proc] } - ::xotcl::alias T FOO ::xotcl::classes::T::foo - ::xotcl::alias S BAR ::xotcl::classes::T::FOO + ::next::core::alias T FOO ::next::core::classes::T::foo + ::next::core::alias S BAR ::next::core::classes::T::FOO ? {lsort [T info methods]} {FOO foo} ? {S info methods} {BAR} @@ -105,9 +105,9 @@ T method foo args { return [self class]->[self proc] } T object method bar args { return [self class]->[self proc] } - ::xotcl::alias T -per-object FOO ::xotcl::classes::T::foo - ::xotcl::alias T -per-object BAR ::T::FOO - ::xotcl::alias T -per-object ZAP ::T::BAR + ::next::core::alias T -per-object FOO ::next::core::classes::T::foo + ::next::core::alias T -per-object BAR ::T::FOO + ::next::core::alias T -per-object ZAP ::T::BAR ? {T info methods} {foo} ? {lsort [T object info methods -methodtype alias]} {BAR FOO ZAP} ? {lsort [T object info methods]} {BAR FOO ZAP bar} @@ -149,8 +149,8 @@ # per-object methods as per-object aliases # T object method m1 args { return [self class]->[self proc] } - ::xotcl::alias T -per-object M1 ::T::m1 - ::xotcl::alias T -per-object M11 ::T::M1 + ::next::core::alias T -per-object M1 ::T::m1 + ::next::core::alias T -per-object M11 ::T::M1 ? {lsort [T object info methods]} {M1 M11 bar m1} ? {T m1} ->m1 ? {T M1} ->m1 @@ -167,12 +167,12 @@ # proc foo args { return [self class]->[self proc] } - ::xotcl::alias T FOO1 ::foo - ::xotcl::alias T -per-object FOO2 ::foo + ::next::core::alias T FOO1 ::foo + ::next::core::alias T -per-object FOO2 ::foo # # ! per-object alias referenced as per-class alias ! # - ::xotcl::alias T BAR ::T::FOO2 + ::next::core::alias T BAR ::T::FOO2 ? {lsort [T object info methods]} {FOO2 bar} ? {lsort [T info methods]} {BAR FOO1} ? {T FOO2} ->foo @@ -200,9 +200,9 @@ proc bar2 args { upvar 2 _ __; return $__} } - ::xotcl::alias T FOO ::ns1::foo - ::xotcl::alias T BAR ::ns1::bar - ::xotcl::alias T BAR2 ::ns1::bar2 + ::next::core::alias T FOO ::ns1::foo + ::next::core::alias T BAR ::ns1::bar + ::next::core::alias T BAR2 ::ns1::bar2 ? {lsort [T info methods]} {BAR BAR2 FOO} set ::_ GOTYA ? {t FOO} ::T->foo @@ -218,12 +218,12 @@ U create u ? {namespace exists ::U} 0 U object method zap args { return [self class]->[self proc] } - ::xotcl::alias ::U -per-object ZAP ::U::zap + ::next::core::alias ::U -per-object ZAP ::U::zap U requireNamespace ? {namespace exists ::U} 1 U object method bar args { return [self class]->[self proc] } - ::xotcl::alias U -per-object BAR ::U::bar + ::next::core::alias U -per-object BAR ::U::bar ? {lsort [U object info methods]} {BAR ZAP bar zap} ? {U BAR} ->bar ? {U ZAP} ->zap @@ -253,10 +253,10 @@ ? {lsort [V info vars]} {z} ? {lsort [v info vars]} {z} - proc ::foo args { return [:bar ${:z}]-[set :z]-[my bar [set :z]] } + proc ::foo args { return [:bar ${:z}]-[set :z]-[:bar [set :z]] } - ::xotcl::alias V FOO1 ::foo - ::xotcl::alias V -per-object FOO2 ::foo + ::next::core::alias V FOO1 ::foo + ::next::core::alias V -per-object FOO2 ::foo ? {lsort [V object info methods]} {FOO2 bar} ? {lsort [V info methods]} {FOO1 bar} @@ -270,15 +270,15 @@ } # -# Tests for the ::xotcl::alias store, used for introspection for +# Tests for the ::next::core::alias store, used for introspection for # aliases. The alias store (an associative variable) is mostly # necessary for for the direct aliases (e.g. aliases to C implemented # tcl commands), for which we have no stubs at the place where the # alias was registered. # # -# structure of the ::xotcl::alias store: +# structure of the ::next::core::alias store: # ,, -> # @@ -287,95 +287,95 @@ o method bar args {;} -? {info vars ::xotcl::alias} ::xotcl::alias -? {array exists ::xotcl::alias} 1 +? {info vars ::next::core::alias} ::next::core::alias +? {array exists ::next::core::alias} 1 proc ::foo args {;} -::xotcl::alias ::o FOO ::foo -::xotcl::alias ::C FOO ::foo -? {info exists ::xotcl::alias(::o,FOO,1)} 1 -? {info exists ::xotcl::alias(::C,FOO,0)} 1 -? {array get ::xotcl::alias ::o,FOO,1} "::o,FOO,1 ::foo" -? {array get ::xotcl::alias ::C,FOO,0} "::C,FOO,0 ::foo" +::next::core::alias ::o FOO ::foo +::next::core::alias ::C FOO ::foo +? {info exists ::next::core::alias(::o,FOO,1)} 1 +? {info exists ::next::core::alias(::C,FOO,0)} 1 +? {array get ::next::core::alias ::o,FOO,1} "::o,FOO,1 ::foo" +? {array get ::next::core::alias ::C,FOO,0} "::C,FOO,0 ::foo" ? {o info method definition FOO} "::o alias FOO ::foo" ? {C info method definition FOO} "::C alias FOO ::foo" -::xotcl::alias o FOO ::o::bar -? {info exists ::xotcl::alias(::o,FOO,1)} 1 -? {array get ::xotcl::alias ::o,FOO,1} "::o,FOO,1 ::o::bar" +::next::core::alias o FOO ::o::bar +? {info exists ::next::core::alias(::o,FOO,1)} 1 +? {array get ::next::core::alias ::o,FOO,1} "::o,FOO,1 ::o::bar" ? {o info method definition FOO} "::o alias FOO ::o::bar" # AliasDelete in XOTclRemoveObjectMethod o method FOO {} {} -? {info exists ::xotcl::alias(::o,FOO,1)} 0 -? {array get ::xotcl::alias ::o,FOO,1} "" +? {info exists ::next::core::alias(::o,FOO,1)} 0 +? {array get ::next::core::alias ::o,FOO,1} "" ? {o info method definition FOO} "" # AliasDelete in XOTclRemoveClassMethod C method FOO {} {} -? {info exists ::xotcl::alias(::C,FOO,0)} 0 -? {array get ::xotcl::alias ::C,FOO,0} "" +? {info exists ::next::core::alias(::C,FOO,0)} 0 +? {array get ::next::core::alias ::C,FOO,0} "" ? {C info method definition FOO} "" -::xotcl::alias ::o BAR ::foo -::xotcl::alias ::C BAR ::foo +::next::core::alias ::o BAR ::foo +::next::core::alias ::C BAR ::foo # AliasDelete in XOTclAddObjectMethod -? {info exists ::xotcl::alias(::o,BAR,1)} 1 +? {info exists ::next::core::alias(::o,BAR,1)} 1 ::o method BAR {} {;} -? {info exists ::xotcl::alias(::o,BAR,1)} 0 +? {info exists ::next::core::alias(::o,BAR,1)} 0 # AliasDelete in XOTclAddInstanceMethod -? {info exists ::xotcl::alias(::C,BAR,0)} 1 +? {info exists ::next::core::alias(::C,BAR,0)} 1 ::C method BAR {} {;} -? {info exists ::xotcl::alias(::C,BAR,0)} 0 +? {info exists ::next::core::alias(::C,BAR,0)} 0 # AliasDelete in aliasCmdDeleteProc -::xotcl::alias o FOO ::foo -? {info exists ::xotcl::alias(::o,FOO,1)} 1 +::next::core::alias o FOO ::foo +? {info exists ::next::core::alias(::o,FOO,1)} 1 rename ::foo "" -? {info exists ::xotcl::alias(::o,FOO,1)} 0 +? {info exists ::next::core::alias(::o,FOO,1)} 0 -::xotcl::alias o FOO ::o::bar -::xotcl::alias o BAR ::o::FOO -? {info exists ::xotcl::alias(::o,FOO,1)} 1 -? {info exists ::xotcl::alias(::o,BAR,1)} 1 +::next::core::alias o FOO ::o::bar +::next::core::alias o BAR ::o::FOO +? {info exists ::next::core::alias(::o,FOO,1)} 1 +? {info exists ::next::core::alias(::o,BAR,1)} 1 o method bar {} {} -? {info exists ::xotcl::alias(::o,FOO,1)} 0 -? {info exists ::xotcl::alias(::o,BAR,1)} 0 +? {info exists ::next::core::alias(::o,FOO,1)} 0 +? {info exists ::next::core::alias(::o,BAR,1)} 0 # # pulling the rug out from the proc-alias deletion mechanism # proc ::foo args {;} -::xotcl::alias C FOO ::foo -? {info exists ::xotcl::alias(::C,FOO,0)} 1 -unset ::xotcl::alias(::C,FOO,0) -? {info exists ::xotcl::alias(::C,FOO,0)} 0 +::next::core::alias C FOO ::foo +? {info exists ::next::core::alias(::C,FOO,0)} 1 +unset ::next::core::alias(::C,FOO,0) +? {info exists ::next::core::alias(::C,FOO,0)} 0 ? {C info method definition FOO} "" ? {C info methods -methodtype alias} FOO rename ::foo "" ? {C info methods -methodtype alias} "" -? {info exists ::xotcl::alias(::C,FOO,0)} 0 +? {info exists ::next::core::alias(::C,FOO,0)} 0 ? {C info method definition FOO} "" # # test renaming of Tcl proc (actually sensed by the alias, though not # reflected by the alias definition store) # a) is this acceptable? -# b) sync ::xotcl::alias upon "info method definition" calls? is this feasible, +# b) sync ::next::core::alias upon "info method definition" calls? is this feasible, # e.g. through rename traces? # C create c proc ::foo args { return [self]->[self proc]} -? {info exists ::xotcl::alias(::C,FOO,0)} 0 -::xotcl::alias C FOO ::foo -? {info exists ::xotcl::alias(::C,FOO,0)} 1 +? {info exists ::next::core::alias(::C,FOO,0)} 0 +::next::core::alias C FOO ::foo +? {info exists ::next::core::alias(::C,FOO,0)} 1 ? {C info methods -methodtype alias} FOO rename ::foo ::foo2 -? {info exists ::xotcl::alias(::C,FOO,0)} 1 +? {info exists ::next::core::alias(::C,FOO,0)} 1 ? {C info methods -methodtype alias} FOO ? {c FOO} ::c->foo2 ? {C info method definition FOO} "::C alias FOO ::foo"; # should be ::foo2 (!) Index: tests/destroytest.xotcl =================================================================== diff -u -rd337d1f94a287b8d694b50c4b1000151de21098c -r81c800c8b9cb42ef6743d9b80ac2be5ca211a69a --- tests/destroytest.xotcl (.../destroytest.xotcl) (revision d337d1f94a287b8d694b50c4b1000151de21098c) +++ tests/destroytest.xotcl (.../destroytest.xotcl) (revision 81c800c8b9cb42ef6743d9b80ac2be5ca211a69a) @@ -1,9 +1,9 @@ -package require XOTcl; xotcl::use xotcl2 +package require XOTcl; xotcl::use next package require xotcl::test Test parameter count 10 -::xotcl::alias ::xotcl2::Object set -objscope ::set +::next::core::alias ::next::Object set -objscope ::set Class create O -superclass Object { :method init {} { @@ -12,7 +12,7 @@ } :method destroy {} { incr ::ObjectDestroy - #[my info class] dealloc [self] + #[:info class] dealloc [self] next } } @@ -26,19 +26,19 @@ C method destroy {} {incr ::firstDestroy; puts stderr " *** [self] destroy"; next} C method foo {} { puts stderr "==== $::case [self]" - my destroy - puts stderr "AAAA [self] exists [::xotcl::is [self] object]" - my set x 1 + :destroy + puts stderr "AAAA [self] exists [::next::core::objectproperty [self] object]" + :set x 1 ? "[self] set x" 1 "$::case can still access [self]" puts stderr "BBBB" - ? {::xotcl::is c1 object} 1 "$::case object still exists in proc" + ? {::next::core::objectproperty c1 object} 1 "$::case object still exists in proc" ? "set ::firstDestroy" 1 "firstDestroy called" ? "set ::ObjectDestroy" 1 "ObjectDestroy called" } C create c1 c1 foo -puts stderr ======[::xotcl::is c1 object] -? {::xotcl::is c1 object} 0 "$::case object deleted" +puts stderr ======[::next::core::objectproperty c1 object] +? {::next::core::objectproperty c1 object} 0 "$::case object deleted" ? "set ::firstDestroy" 1 "firstDestroy called" @@ -51,19 +51,19 @@ C method destroy {} {incr ::firstDestroy; puts stderr " *** [self] destroy block"} C method foo {} { puts stderr "==== $::case [self]" - my destroy - puts stderr "AAAA [self] exists [::xotcl::is [self] object]" - my set x 1 + :destroy + puts stderr "AAAA [self] exists [::next::core::objectproperty [self] object]" + :set x 1 ? "[self] set x" 1 "$::case can still access [self]" puts stderr "BBBB" - ? {::xotcl::is c1 object} 1 "$::case object still exists in proc" + ? {::next::core::objectproperty c1 object} 1 "$::case object still exists in proc" ? "set ::firstDestroy" 1 "firstDestroy called" ? "set ::ObjectDestroy" 0 "ObjectDestroy called" } C create c1 c1 foo -puts stderr ======[::xotcl::is c1 object] -? {::xotcl::is c1 object} 1 "$::case object deleted" +puts stderr ======[::next::core::objectproperty c1 object] +? {::next::core::objectproperty c1 object} 1 "$::case object deleted" ? "set ::firstDestroy" 1 "firstDestroy called" ? "set ::ObjectDestroy" 0 "ObjectDestroy called" @@ -76,19 +76,19 @@ C method destroy {} {incr ::firstDestroy; puts stderr " *** [self] destroy"; next} C method foo {} { puts stderr "==== $::case [self]" - [my info class] create [self] - puts stderr "AAAA [self] exists [::xotcl::is [self] object]" - my set x 1 + [:info class] create [self] + puts stderr "AAAA [self] exists [::next::core::objectproperty [self] object]" + :set x 1 ? "[self] set x" 1 "$::case can still access [self]" puts stderr "BBBB" - ? {::xotcl::is c1 object} 1 "$::case object still exists in proc" + ? {::next::core::objectproperty c1 object} 1 "$::case object still exists in proc" ? "set ::firstDestroy" 0 "firstDestroy called" ? "set ::ObjectDestroy" 0 "ObjectDestroy called" } C create c1 c1 foo -puts stderr ======[::xotcl::is c1 object] -? {::xotcl::is c1 object} 1 "$::case object deleted" +puts stderr ======[::next::core::objectproperty c1 object] +? {::next::core::objectproperty c1 object} 1 "$::case object deleted" ? "set ::firstDestroy" 0 "firstDestroy called" # @@ -103,18 +103,18 @@ C method foo {} { puts stderr "==== $::case [self]" rename [self] "" - puts stderr "AAAA [self] exists [::xotcl::is [self] object]" - my set x 1 + puts stderr "AAAA [self] exists [::next::core::objectproperty [self] object]" + :set x 1 ? "[self] set x" 1 "$::case can still access [self]" puts stderr "BBB" - ? {::xotcl::is c1 object} 1 "$::case object still exists in proc" + ? {::next::core::objectproperty c1 object} 1 "$::case object still exists in proc" ? "set ::firstDestroy" 1 "firstDestroy called" ? "set ::ObjectDestroy" 1 "ObjectDestroy called" } C create c1 c1 foo -puts stderr ======[::xotcl::is c1 object] -? {::xotcl::is c1 object} 0 "$::case object still exists after proc" +puts stderr ======[::next::core::objectproperty c1 object] +? {::next::core::objectproperty c1 object} 0 "$::case object still exists after proc" ? "set ::firstDestroy" 1 "firstDestroy called" ? "set ::ObjectDestroy" 1 "ObjectDestroy called" @@ -130,19 +130,19 @@ C method foo {} { puts stderr "==== $::case [self]" rename [self] "" - puts stderr "AAAA [self] exists [::xotcl::is [self] object]" - my set x 1 + puts stderr "AAAA [self] exists [::next::core::objectproperty [self] object]" + :set x 1 ? "[self] set x" 1 "$::case can still access [self]" puts stderr "BBB" - ? {::xotcl::is c1 object} 1 "$::case object still exists in proc" + ? {::next::core::objectproperty c1 object} 1 "$::case object still exists in proc" ? "set ::firstDestroy" 1 "firstDestroy called" ? "set ::ObjectDestroy" 0 "ObjectDestroy called" } C create c1 c1 foo -puts stderr ======[::xotcl::is c1 object] +puts stderr ======[::next::core::objectproperty c1 object] puts stderr ======[c1 set x] -? {::xotcl::is c1 object} 1 "$::case object still exists after proc" +? {::next::core::objectproperty c1 object} 1 "$::case object still exists after proc" ? "set ::firstDestroy" 1 "firstDestroy called" ? "set ::ObjectDestroy" 0 "ObjectDestroy called" @@ -158,18 +158,18 @@ C method foo {} { puts stderr "==== $::case [self]" rename o [self] - puts stderr "AAAA [self] exists [::xotcl::is [self] object]" - my set x 1 + puts stderr "AAAA [self] exists [::next::core::objectproperty [self] object]" + :set x 1 ? "[self] set x" 1 "$::case can still access [self]" puts stderr "BBB" - ? {::xotcl::is c1 object} 1 "$::case object still exists in proc" + ? {::next::core::objectproperty c1 object} 1 "$::case object still exists in proc" ? "set ::firstDestroy" 0 "firstDestroy called" ? "set ::ObjectDestroy" 0 "ObjectDestroy called" } C create c1 c1 foo -puts stderr ======[::xotcl::is c1 object] -? {::xotcl::is c1 object} 1 "$::case object still exists after proc" +puts stderr ======[::next::core::objectproperty c1 object] +? {::next::core::objectproperty c1 object} 1 "$::case object still exists after proc" ? "set ::firstDestroy" 0 "firstDestroy called" ? "set ::ObjectDestroy" 0 "ObjectDestroy called" @@ -189,7 +189,7 @@ } C create c1 c1 foo -? {::xotcl::is c1 object} 1 "$::case object still exists after proc" +? {::next::core::objectproperty c1 object} 1 "$::case object still exists after proc" ? "set ::firstDestroy" 0 "firstDestroy called" ? "set ::ObjectDestroy" 0 "ObjectDestroy called" @@ -209,28 +209,28 @@ C method foo {} { puts stderr "==== $::case [self]" namespace delete ::test - puts stderr "AAAA [self] exists [::xotcl::is [self] object]" - my set x 1 + puts stderr "AAAA [self] exists [::next::core::objectproperty [self] object]" + :set x 1 # # If the following line is commented in, the namespace is deleted # here. Is there a bug with nsPtr->activationCount # #? "[self] set x" 1 "$::case can still access [self]" puts stderr "BBB" - puts stderr "???? [self] exists [::xotcl::is [self] object]" - ? "::xotcl::is [self] object" 0 ;# WHY? - puts stderr "???? [self] exists [::xotcl::is [self] object]" + puts stderr "???? [self] exists [::next::core::objectproperty [self] object]" + ? "::next::core::objectproperty [self] object" 0 ;# WHY? + puts stderr "???? [self] exists [::next::core::objectproperty [self] object]" ? "set ::firstDestroy" 0 "firstDestroy called" ? "set ::ObjectDestroy" 0 "$::case destroy not yet called" } } test::C create test::c1 test::c1 foo -puts stderr ======[::xotcl::is test::c1 object] -? {::xotcl::is test::c1 object} 0 "object still exists after proc" +puts stderr ======[::next::core::objectproperty test::c1 object] +? {::next::core::objectproperty test::c1 object} 0 "object still exists after proc" ? "set ::firstDestroy" 1 "firstDestroy called" ? "set ::ObjectDestroy" 1 "destroy was called when poping stack frame" -? {::xotcl::is ::test::C object} 0 "class still exists after proc" +? {::next::core::objectproperty ::test::C object} 0 "class still exists after proc" ? {namespace exists ::test::C} 0 "namespace ::test::C still exists after proc" ? {namespace exists ::test} 1 "parent ::test namespace still exists after proc" ? {namespace exists ::xotcl::classes::test::C} 0 "namespace ::xotcl::classes::test::C still exists after proc" @@ -249,25 +249,25 @@ C method foo {} { puts stderr "==== $::case [self]" namespace delete ::test - puts stderr "AAAA [self] exists [::xotcl::is [self] object]" - my set x 1 + puts stderr "AAAA [self] exists [::next::core::objectproperty [self] object]" + :set x 1 # # If the following line is commented in, the namespace is deleted # here. Is there a bug with nsPtr->activationCount # #? "[self] set x" 1 "$::case can still access [self]" puts stderr "BBBB" - puts stderr "???? [self] exists [::xotcl::is [self] object]" - ? "::xotcl::is [self] object" 0 "$::case object still exists in proc";# WHY? - puts stderr "???? [self] exists [::xotcl::is [self] object]" + puts stderr "???? [self] exists [::next::core::objectproperty [self] object]" + ? "::next::core::objectproperty [self] object" 0 "$::case object still exists in proc";# WHY? + puts stderr "???? [self] exists [::next::core::objectproperty [self] object]" ? "set ::firstDestroy" 0 "firstDestroy called" ? "set ::ObjectDestroy" 0 "ObjectDestroy called"; # NOT YET CALLED } } test::C create test::c1 test::c1 foo -puts stderr ======[::xotcl::is test::c1 object] -? {::xotcl::is test::c1 object} 0 "$::case object still exists after proc" +puts stderr ======[::next::core::objectproperty test::c1 object] +? {::next::core::objectproperty test::c1 object} 0 "$::case object still exists after proc" ? "set ::firstDestroy" 1 "firstDestroy called" ? "set ::ObjectDestroy" 0 "ObjectDestroy called" ;# toplevel destroy was blocked @@ -287,20 +287,20 @@ puts stderr "AAAA" # the following isobject call has a problem in Tcl_GetCommandFromObj(), # which tries to access invalid memory - puts stderr "AAAA [self] exists [::xotcl::is [self] object]" - my set x 1 + puts stderr "AAAA [self] exists [::next::core::objectproperty [self] object]" + :set x 1 #? "[self] set x" 1 "$::case can still access [self]" puts stderr "BBBB" - ? {::xotcl::is ::o::c1 object} 0 "$::case object still exists in proc" + ? {::next::core::objectproperty ::o::c1 object} 0 "$::case object still exists in proc" ? "set ::firstDestroy" 1 "firstDestroy called" ? "set ::ObjectDestroy" 1 "ObjectDestroy called" } C create o::c1 o::c1 foo -puts stderr ======[::xotcl::is ::o::c1 object] -? {::xotcl::is ::o::c1 object} 0 "$::case object o::c1 still exists after proc" -? {::xotcl::is o object} 0 "$::case object o still exists after proc" +puts stderr ======[::next::core::objectproperty ::o::c1 object] +? {::next::core::objectproperty ::o::c1 object} 0 "$::case object o::c1 still exists after proc" +? {::next::core::objectproperty o object} 0 "$::case object o still exists after proc" ? "set ::firstDestroy" 1 "firstDestroy called" ? "set ::ObjectDestroy" 1 "ObjectDestroy called" @@ -317,18 +317,18 @@ C method foo {} { puts stderr "==== $::case [self]" o destroy - puts stderr "AAAA [self] exists [::xotcl::is [self] object]" - my set x 1 + puts stderr "AAAA [self] exists [::next::core::objectproperty [self] object]" + :set x 1 #? "[self] set x" 1 "$::case can still access [self]" puts stderr "BBB" - ? {::xotcl::is ::o::c1 object} 0 "$::case object still exists in proc" + ? {::next::core::objectproperty ::o::c1 object} 0 "$::case object still exists in proc" ? "set ::firstDestroy" 1 "firstDestroy called" ? "set ::ObjectDestroy" 0 "ObjectDestroy called" } C create o::c1 o::c1 foo -puts stderr ======[::xotcl::is ::o::c1 object] -? {::xotcl::is ::o::c1 object} 0 "$::case object still exists after proc" +puts stderr ======[::next::core::objectproperty ::o::c1 object] +? {::next::core::objectproperty ::o::c1 object} 0 "$::case object still exists after proc" ? "set ::firstDestroy" 1 "firstDestroy called" ? "set ::ObjectDestroy" 0 "ObjectDestroy called" @@ -345,18 +345,18 @@ C method foo {} { puts stderr "==== $::case [self]" proc [self] {args} {puts HELLO} - puts stderr "AAAA [self] exists [::xotcl::is [self] object]" - my set x 1 + puts stderr "AAAA [self] exists [::next::core::objectproperty [self] object]" + :set x 1 #? "[self] set x" 1 "$::case can still access [self]" puts stderr "BBB" ? "set ::firstDestroy" 1 "firstDestroy called" ? "set ::ObjectDestroy" 1 "ObjectDestroy called" - ? {::xotcl::is c1 object} 0 "$::case object still exists in proc" + ? {::next::core::objectproperty c1 object} 0 "$::case object still exists in proc" } C create c1 c1 foo -puts stderr ======[::xotcl::is c1 object] -? {::xotcl::is c1 object} 0 "$::case object still exists after proc" +puts stderr ======[::next::core::objectproperty c1 object] +? {::next::core::objectproperty c1 object} 0 "$::case object still exists after proc" ? "set ::firstDestroy" 1 "firstDestroy called" ? "set ::ObjectDestroy" 1 "ObjectDestroy called" @@ -372,23 +372,23 @@ C method foo {} { puts stderr "==== $::case [self]" C destroy - puts stderr "AAAA [self] exists [::xotcl::is [self] object]" - my set x 1 + puts stderr "AAAA [self] exists [::next::core::objectproperty [self] object]" + :set x 1 #? "[self] set x" 1 "$::case can still access [self]" puts stderr "BBB" - #? [my info class] ::xotcl::Object "object reclassed" - ? [my info class] ::C "object reclassed?" + #? [:info class] ::xotcl::Object "object reclassed" + ? [:info class] ::C "object reclassed?" ? "set ::firstDestroy" 0 "firstDestroy called" ? "set ::ObjectDestroy" 0 "ObjectDestroy called" - ? {::xotcl::is c1 object} 1 "object still exists in proc" - #? {::xotcl::is ::C class} 0 "class still exists in proc" - ? {::xotcl::is ::C class} 1 "class still exists in proc" + ? {::next::core::objectproperty c1 object} 1 "object still exists in proc" + #? {::next::core::objectproperty ::C class} 0 "class still exists in proc" + ? {::next::core::objectproperty ::C class} 1 "class still exists in proc" } C create c1 c1 foo -puts stderr ======[::xotcl::is c1 object] -? {::xotcl::is c1 object} 1 "object still exists after proc" -? [c1 info class] ::xotcl2::Object "after proc: object reclassed?" +puts stderr ======[::next::core::objectproperty c1 object] +? {::next::core::objectproperty c1 object} 1 "object still exists after proc" +? [c1 info class] ::next::Object "after proc: object reclassed?" ? "set ::firstDestroy" 0 "firstDestroy called" ? "set ::ObjectDestroy" 0 "ObjectDestroy called" @@ -402,24 +402,24 @@ C method foo {} { puts stderr "==== $::case [self]" C destroy - puts stderr "AAAA [self] exists [::xotcl::is [self] object]" - my set x 1 + puts stderr "AAAA [self] exists [::next::core::objectproperty [self] object]" + :set x 1 #? "[self] set x" 1 "$::case can still access [self]" puts stderr "BBB" #? "set ::firstDestroy" 0 "firstDestroy called" ? "set ::firstDestroy" 1 "firstDestroy called" #? "set ::ObjectDestroy" 0 "ObjectDestroy called" ? "set ::ObjectDestroy" 1 "ObjectDestroy called" - ? [my info class] ::C "object reclassed" - #? [my info class] ::xotcl::Object "object reclassed" - ? {::xotcl::is ::C::c1 object} 1 "object still exists in proc" - ? {::xotcl::is ::C class} 1 "class still exists in proc" + ? [:info class] ::C "object reclassed" + #? [:info class] ::xotcl::Object "object reclassed" + ? {::next::core::objectproperty ::C::c1 object} 1 "object still exists in proc" + ? {::next::core::objectproperty ::C class} 1 "class still exists in proc" } C create ::C::c1 C::c1 foo -#puts stderr ======[::xotcl::is ::C::c1 object] -? {::xotcl::is ::C::c1 object} 0 "object still exists after proc" -? {::xotcl::is ::C class} 0 "class still exists after proc" +#puts stderr ======[::next::core::objectproperty ::C::c1 object] +? {::next::core::objectproperty ::C::c1 object} 0 "object still exists after proc" +? {::next::core::objectproperty ::C class} 0 "class still exists after proc" ? "set ::firstDestroy" 1 "firstDestroy called" ? "set ::ObjectDestroy" 1 "ObjectDestroy called" @@ -429,14 +429,14 @@ Object create x Object create x::y x destroy -? {::xotcl::is x object} 0 "parent object gone" -? {::xotcl::is x::y object} 0 "child object gone" +? {::next::core::objectproperty x object} 0 "parent object gone" +? {::next::core::objectproperty x::y object} 0 "child object gone" set case "deleting aliased object" Test case deleting-aliased-object Object create o Object create o2 -::xotcl::alias o x o2 +::next::core::alias o x o2 ? {o x} ::o2 "call object via alias" ? {o x info vars} "" "call info on aliased object" ? {o2 set x 10} 10 "set variable on object" @@ -455,27 +455,27 @@ Test case deleting-object-with-alias-to-object Object create o Object create o3 -::xotcl::alias o x o3 +::next::core::alias o x o3 o destroy -? {::xotcl::is o object} 0 "parent object gone" -? {::xotcl::is o3 object} 1 "aliased object still here" +? {::next::core::objectproperty o object} 0 "parent object gone" +? {::next::core::objectproperty o3 object} 1 "aliased object still here" o3 destroy -? {::xotcl::is o3 object} 0 "aliased object destroyed" +? {::next::core::objectproperty o3 object} 0 "aliased object destroyed" set case "create an alias, and delete cmd via aggregation" Test case create-alias-delete-via-aggregation Object create o Object create o3 -::xotcl::alias o x o3 +::next::core::alias o x o3 o::x destroy -? {::xotcl::is o3 object} 0 "aliased object destroyed" +? {::next::core::objectproperty o3 object} 0 "aliased object destroyed" o destroy set case "create an alias, and recreate obj" Test case create-alias-and-recreate-obj Object create o Object create o3 -::xotcl::alias o x o3 +::next::core::alias o x o3 Object create o3 o3 set a 13 ? {o x set a} 13 "aliased object works after recreate" @@ -486,8 +486,8 @@ Class create C Object create o Object create o3 -::xotcl::alias o a o3 -::xotcl::alias C b o +::next::core::alias o a o3 +::next::core::alias C b o C create c1 ? {c1 b set B 2} 2 "call 1st level" ? {c1 b a set A 3} 3 "call 2nd level" @@ -505,12 +505,12 @@ Class create C Object create o Object create o3 -::xotcl::alias o a o3 -::xotcl::alias C b o +::next::core::alias o a o3 +::next::core::alias C b o C create c1 C destroy -? {::xotcl::is o object} 1 "object o still here" -? {::xotcl::is o3 object} 1 "object o3 still here" +? {::next::core::objectproperty o object} 1 "object o still here" +? {::next::core::objectproperty o3 object} 1 "object o3 still here" o destroy o3 destroy c1 destroy @@ -527,12 +527,12 @@ # reuse the namespace for a class/object Class create ::module - ? {::xotcl::objectproperty ::module class} 1 + ? {::next::core::objectproperty ::module class} 1 # delete the object/class ... and namespace ::module destroy - ? {::xotcl::objectproperty ::module class} 0 + ? {::next::core::objectproperty ::module class} 0 } Test case namespace-import { @@ -546,25 +546,25 @@ Class create ::module { :create mod1 } - ? {xotcl::objectproperty ::module::Foo class} 1 - ? {xotcl::objectproperty ::module::foo class} 0 - ? {xotcl::objectproperty ::module::foo object} 1 - ? {xotcl::objectproperty ::module class} 1 + ? {::next::core::objectproperty ::module::Foo class} 1 + ? {::next::core::objectproperty ::module::foo class} 0 + ? {::next::core::objectproperty ::module::foo object} 1 + ? {::next::core::objectproperty ::module class} 1 Object create ::o { :requireNamespace } namespace eval ::o {namespace import ::module::*} - ? {xotcl::objectproperty ::o::Foo class} 1 - ? {xotcl::objectproperty ::o::foo object} 1 + ? {::next::core::objectproperty ::o::Foo class} 1 + ? {::next::core::objectproperty ::o::foo object} 1 # do not destroy namespace imported objects/classes ::o destroy - ? {xotcl::objectproperty ::o::Foo class} 0 - ? {xotcl::objectproperty ::o::foo object} 0 + ? {::next::core::objectproperty ::o::Foo class} 0 + ? {::next::core::objectproperty ::o::foo object} 0 - ? {xotcl::objectproperty ::module::Foo class} 1 - ? {xotcl::objectproperty ::module::foo object} 1 + ? {::next::core::objectproperty ::module::Foo class} 1 + ? {::next::core::objectproperty ::module::foo object} 1 ::module destroy } Index: tests/forwardtest.xotcl =================================================================== diff -u -rf3a84ed90cf24565e3bae87abfe8185acc0e9cc4 -r81c800c8b9cb42ef6743d9b80ac2be5ca211a69a --- tests/forwardtest.xotcl (.../forwardtest.xotcl) (revision f3a84ed90cf24565e3bae87abfe8185acc0e9cc4) +++ tests/forwardtest.xotcl (.../forwardtest.xotcl) (revision 81c800c8b9cb42ef6743d9b80ac2be5ca211a69a) @@ -1,5 +1,5 @@ -# $Id: forwardtest.xotcl,v 1.12 2007/08/14 16:38:27 neumann Exp $ -package require XOTcl; xotcl::use xotcl1 +# -*- Tcl -*- +package require XOTcl; namespace import ::xotcl::* package require xotcl::test ########################################### Index: tests/info-method.xotcl =================================================================== diff -u -r7f114dad2b4deb00431c895e511118c3c675cb07 -r81c800c8b9cb42ef6743d9b80ac2be5ca211a69a --- tests/info-method.xotcl (.../info-method.xotcl) (revision 7f114dad2b4deb00431c895e511118c3c675cb07) +++ tests/info-method.xotcl (.../info-method.xotcl) (revision 81c800c8b9cb42ef6743d9b80ac2be5ca211a69a) @@ -38,7 +38,7 @@ ? {c1 info method definition foo} "::c1 method foo {} {puts foo}" ? {c1 info callable -which foo} "::c1 method foo {} {puts foo}" -? {C info method name m} "::xotcl::classes::C::m" +? {C info method name m} "::next::core::classes::C::m" ? {C object info method name mpo} "::C::mpo" ? {C info method definition m} {::C method m x {return proc-[self proc]}} @@ -65,7 +65,7 @@ ? {C object info method definition apo} "::C object alias apo ::puts" -? {::xotcl2::Object info callable -application} "" -? {::xotcl2::Class info callable -application} "" +? {::next::Object info callable -application} "" +? {::next::Class info callable -application} "" ? {lsort [C info callable -application]} "add1 apo fpo mpo spo" ? {lsort [c1 info callable -application]} "a addOne foo m m-with-assertions s" \ No newline at end of file Index: tests/interceptor-slot.xotcl =================================================================== diff -u -r210eab6d9149846d5d6a6a8e0fa74e232ca5b6de -r81c800c8b9cb42ef6743d9b80ac2be5ca211a69a --- tests/interceptor-slot.xotcl (.../interceptor-slot.xotcl) (revision 210eab6d9149846d5d6a6a8e0fa74e232ca5b6de) +++ tests/interceptor-slot.xotcl (.../interceptor-slot.xotcl) (revision 81c800c8b9cb42ef6743d9b80ac2be5ca211a69a) @@ -1,104 +1,105 @@ -package require XOTcl +package require next package require xotcl::test -::xotcl::use xotcl2 +namespace import ::next::* + Class create M { :method mfoo {} {puts [self proc]} } Class create M2 Class create C -? {C info callable -which mixin} "::xotcl2::Class forward mixin ::xotcl2::Class::slot::mixin {%1 {get assign}} %self class-mixin" +? {C info callable -which mixin} "::next::Class forward mixin ::next::Class::slot::mixin {%1 {get assign}} %self class-mixin" C mixin M -? {C info precedence} "::xotcl2::Class ::xotcl2::Object" +? {C info precedence} "::next::Class ::next::Object" ? {C mixin} "::M" ? {C info mixin} "::M" C create c1 -? {c1 info precedence} "::M ::C ::xotcl2::Object" +? {c1 info precedence} "::M ::C ::next::Object" C mixin add M2 -? {c1 info precedence} "::M2 ::M ::C ::xotcl2::Object" +? {c1 info precedence} "::M2 ::M ::C ::next::Object" C mixin delete M2 -? {c1 info precedence} "::M ::C ::xotcl2::Object" +? {c1 info precedence} "::M ::C ::next::Object" C mixin delete M # per-object mixins -? {c1 info precedence} "::C ::xotcl2::Object" +? {c1 info precedence} "::C ::next::Object" c1 mixin add M -? {::xotcl::relation c1 object-mixin} ::M +? {::next::core::relation c1 object-mixin} ::M ? {catch {c1 mixin UNKNOWN}} 1 -? {::xotcl::relation c1 object-mixin} "::M" +? {::next::core::relation c1 object-mixin} "::M" # add again the same mixin c1 mixin add M -? {c1 info precedence} "::M ::C ::xotcl2::Object" +? {c1 info precedence} "::M ::C ::next::Object" c1 mixin add M2 -? {c1 info precedence} "::M2 ::M ::C ::xotcl2::Object" +? {c1 info precedence} "::M2 ::M ::C ::next::Object" c1 mixin delete M -? {c1 info precedence} "::M2 ::C ::xotcl2::Object" +? {c1 info precedence} "::M2 ::C ::next::Object" c1 mixin delete M2 -? {c1 info precedence} "::C ::xotcl2::Object" +? {c1 info precedence} "::C ::next::Object" # # adding, removing per-object mixins for classes through relation # "object-mixin" # -::xotcl::relation C object-mixin M -? {C info precedence} "::M ::xotcl2::Class ::xotcl2::Object" +::next::core::relation C object-mixin M +? {C info precedence} "::M ::next::Class ::next::Object" ? {C object info mixin} "::M" -::xotcl::relation C object-mixin "" -? {C info precedence} "::xotcl2::Class ::xotcl2::Object" +::next::core::relation C object-mixin "" +? {C info precedence} "::next::Class ::next::Object" # # adding, removing per-object mixins for classes through slot # "object-mixin" # C object-mixin M -? {C info precedence} "::M ::xotcl2::Class ::xotcl2::Object" +? {C info precedence} "::M ::next::Class ::next::Object" ? {C object info mixin} "::M" C object-mixin "" -? {C info precedence} "::xotcl2::Class ::xotcl2::Object" +? {C info precedence} "::next::Class ::next::Object" # # add and remove object mixin for classes via modifier "object" and # "mixin" # C object mixin M -? {C info precedence} "::M ::xotcl2::Class ::xotcl2::Object" +? {C info precedence} "::M ::next::Class ::next::Object" ? {C object info mixin} "::M" C object mixin "" -? {C info precedence} "::xotcl2::Class ::xotcl2::Object" +? {C info precedence} "::next::Class ::next::Object" # # add and remove object mixin for classes via object mixin add # C object mixin add M -? {C info precedence} "::M ::xotcl2::Class ::xotcl2::Object" +? {C info precedence} "::M ::next::Class ::next::Object" ? {C object info mixin} "::M" C object mixin "" -? {C info precedence} "::xotcl2::Class ::xotcl2::Object" +? {C info precedence} "::next::Class ::next::Object" # # adding per-object mixins for classes via "object mixin add M" # C object mixin add M -? {C info precedence} "::M ::xotcl2::Class ::xotcl2::Object" -? {::xotcl::relation C object-mixin} ::M +? {C info precedence} "::M ::next::Class ::next::Object" +? {::next::core::relation C object-mixin} ::M ? {catch {C object mixin add UNKNOWN}} 1 -? {::xotcl::relation C object-mixin} "::M" +? {::next::core::relation C object-mixin} "::M" C object mixin "" -? {C info precedence} "::xotcl2::Class ::xotcl2::Object" +? {C info precedence} "::next::Class ::next::Object" # # adding per-object mixins for classes via "object mixin M" # C object mixin M -? {C info precedence} "::M ::xotcl2::Class ::xotcl2::Object" +? {C info precedence} "::M ::next::Class ::next::Object" # forwarder with 0 arguments + flag ? {C object-mixin} "::M" puts stderr "==================== XOTcl 1" -::xotcl::use xotcl1 +namespace import -force ::xotcl::* Class create M1 Class create M11 Index: tests/method-modifiers.xotcl =================================================================== diff -u -r4d21376ac1245e34cb5a5f52da893072f311d3a9 -r81c800c8b9cb42ef6743d9b80ac2be5ca211a69a --- tests/method-modifiers.xotcl (.../method-modifiers.xotcl) (revision 4d21376ac1245e34cb5a5f52da893072f311d3a9) +++ tests/method-modifiers.xotcl (.../method-modifiers.xotcl) (revision 81c800c8b9cb42ef6743d9b80ac2be5ca211a69a) @@ -64,7 +64,7 @@ C public setter s0 C protected setter s1 ? {c1 s0 0} 0 -? {::xotcl::dispatch c1 s1 1} 1 +? {::next::core::dispatch c1 s1 1} 1 C object setter s3 ? {C s3 3} 3 @@ -75,31 +75,31 @@ ? {c2 plain_method} "plain_method" ? {c2 public_method} "public_method" ? {catch {c2 protected_method}} 1 - ? {::xotcl::dispatch c2 protected_method} "protected_method" + ? {::next::core::dispatch c2 protected_method} "protected_method" } # class level forwards Test case class-level-forwards { ? {c2 plain_forward} "plain_method" ? {c2 public_forward} "public_method" ? {catch {c2 protected_forward}} 1 - ? {::xotcl::dispatch c2 protected_forward} "protected_method" + ? {::next::core::dispatch c2 protected_forward} "protected_method" } # class level setter Test case class-level-setter { ? {c2 plain_setter 1} "1" ? {c2 public_setter 2} "2" ? {catch {c2 protected_setter 3}} 1 - ? {::xotcl::dispatch c2 protected_setter 4} "4" + ? {::next::core::dispatch c2 protected_setter 4} "4" } # class level alias ....TODO: wanted behavior of [self proc]? not "plain_alias"? Test case class-level-alias { ? {c2 plain_alias} "plain_method" ? {c2 public_alias} "public_method" ? {catch {c2 protected_alias}} 1 - ? {::xotcl::dispatch c2 protected_alias} "protected_method" + ? {::next::core::dispatch c2 protected_alias} "protected_method" } ########### @@ -109,31 +109,31 @@ ? {C plain_object_method} "plain_object_method" ? {C public_object_method} "public_object_method" ? {catch {C protected_object_method}} 1 - ? {::xotcl::dispatch C protected_object_method} "protected_object_method" + ? {::next::core::dispatch C protected_object_method} "protected_object_method" } # class-object level forwards Test case class-object-level-forwards { ? {C plain_object_forward} "plain_object_method" ? {C public_object_forward} "public_object_method" ? {catch {C protected_object_forward}} 1 - ? {::xotcl::dispatch C protected_object_forward} "protected_object_method" + ? {::next::core::dispatch C protected_object_forward} "protected_object_method" } # class-object level setter Test case class-object-level-setter { ? {C plain_object_setter 1} "1" ? {C public_object_setter 2} "2" ? {catch {C protected_object_setter 3}} 1 - ? {::xotcl::dispatch C protected_object_setter 4} "4" + ? {::next::core::dispatch C protected_object_setter 4} "4" } # class-object level alias ....TODO: wanted behavior of [self proc]? not "plain_alias"? Test case class-object-level-alias { ? {C plain_object_alias} "plain_object_method" ? {C public_object_alias} "public_object_method" ? {catch {C protected_object_alias}} 1 - ? {::xotcl::dispatch C protected_object_alias} "protected_object_method" + ? {::next::core::dispatch C protected_object_alias} "protected_object_method" } ########### @@ -143,30 +143,30 @@ ? {c1 plain_object_method} "plain_object_method" ? {c1 public_object_method} "public_object_method" ? {catch {c1 protected_object_method}} 1 - ? {::xotcl::dispatch c1 protected_object_method} "protected_object_method" + ? {::next::core::dispatch c1 protected_object_method} "protected_object_method" } # object level forwards Test case object-level-forwards { ? {c1 plain_object_forward} "plain_object_method" ? {c1 public_object_forward} "public_object_method" ? {catch {c1 protected_object_forward}} 1 - ? {::xotcl::dispatch c1 protected_object_forward} "protected_object_method" + ? {::next::core::dispatch c1 protected_object_forward} "protected_object_method" } # object level setter Test case object-level-setter ? {c1 plain_object_setter 1} "1" ? {c1 public_object_setter 2} "2" ? {catch {c1 protected_object_setter 3}} 1 -? {::xotcl::dispatch c1 protected_object_setter 4} "4" +? {::next::core::dispatch c1 protected_object_setter 4} "4" # object level alias ....TODO: wanted behavior of [self proc]? not "plain_alias"? Test case object-level-alias { ? {c1 plain_object_alias} "plain_object_method" ? {c1 public_object_alias} "public_object_method" ? {catch {c1 protected_object_alias}} 1 - ? {::xotcl::dispatch c1 protected_object_alias} "protected_object_method" + ? {::next::core::dispatch c1 protected_object_alias} "protected_object_method" ? {lsort [c1 info methods]} \ "plain_object_alias plain_object_forward plain_object_method plain_object_setter public_object_alias public_object_forward public_object_method public_object_setter" @@ -238,7 +238,7 @@ Class create C { set x [:attribute a] - ? [list set _ $x] "::xotcl::classes::C::a" + ? [list set _ $x] "::next::core::classes::C::a" # attribute with default :attribute {b b1} Index: tests/mixinoftest.xotcl =================================================================== diff -u -r29267f0c9db8387f58b03ffc124fc138ad88e463 -r81c800c8b9cb42ef6743d9b80ac2be5ca211a69a --- tests/mixinoftest.xotcl (.../mixinoftest.xotcl) (revision 29267f0c9db8387f58b03ffc124fc138ad88e463) +++ tests/mixinoftest.xotcl (.../mixinoftest.xotcl) (revision 81c800c8b9cb42ef6743d9b80ac2be5ca211a69a) @@ -1,5 +1,5 @@ # testing mixinof -package require XOTcl; xotcl::use xotcl1 +package require XOTcl; namespace import ::xotcl::* package require xotcl::test ########################################### @@ -315,7 +315,7 @@ # redefinition and softrecreate ########################################### Test case pcm-redefine-soft -::xotcl::configure softrecreate true +::next::core::configure softrecreate true Class A Class B -instmixin A Class C -superclass B @@ -349,7 +349,7 @@ # with softrecreate off ########################################### Test case precedence -::xotcl::configure softrecreate false +::next::core::configure softrecreate false Class O Class A -superclass O Class B -superclass A @@ -381,7 +381,7 @@ # with softrecreate on ########################################### Test case alternate-precedence -::xotcl::configure softrecreate false +::next::core::configure softrecreate false Class O Class A -superclass O Class B -superclass A @@ -414,7 +414,7 @@ # with softrecreate on ########################################### Test case recreate-precedence -::xotcl::configure softrecreate true +::next::core::configure softrecreate true Class O Class A -superclass O Class B -superclass A @@ -446,7 +446,7 @@ # with softrecreate on ########################################### Test case recreate-alternate-precedence -::xotcl::configure softrecreate true +::next::core::configure softrecreate true Class O Class A -superclass O Class B -superclass A Index: tests/object-system.xotcl =================================================================== diff -u -r32967f9cd85ab5b73e80781c150240d9c23ee7b0 -r81c800c8b9cb42ef6743d9b80ac2be5ca211a69a --- tests/object-system.xotcl (.../object-system.xotcl) (revision 32967f9cd85ab5b73e80781c150240d9c23ee7b0) +++ tests/object-system.xotcl (.../object-system.xotcl) (revision 81c800c8b9cb42ef6743d9b80ac2be5ca211a69a) @@ -1,5 +1,5 @@ package require XOTcl -xotcl::use xotcl1 +namespace import xotcl::* # # Basic tests of the object system, should not require Class Test, # since even class Test might not work at that time. @@ -81,16 +81,16 @@ # basic parameter tests Class C -parameter {{x 1} {y 2}} -? {::xotcl::objectproperty C object} 1 -? {::xotcl::objectproperty C::slot object} 1 +? {::next::core::objectproperty C object} 1 +? {::next::core::objectproperty C::slot object} 1 ? {C info children} ::C::slot C copy X -? {::xotcl::objectproperty X object} 1 +? {::next::core::objectproperty X object} 1 ? {X info vars} "" ? {C info vars} "" -? {::xotcl::objectproperty X::slot object} 1 +? {::next::core::objectproperty X::slot object} 1 #? {C::slot info vars} __parameter ? {C info parameter} {{x 1} {y 2}} @@ -106,68 +106,68 @@ o proc bar {x} {return goo-$x} # dispatch without colon names -::xotcl::dispatch o set x 1 +::next::core::dispatch o set x 1 ? {o info vars} x "simple dispatch has set variable x" ? {o set x} 1 "simple dispatch has set variable x to 1" -? {::xotcl::dispatch o foo} "goo" "simple dispatch with one arg works" -? {::xotcl::dispatch o bar 1} "goo-1" "simple dispatch with two args works" +? {::next::core::dispatch o foo} "goo" "simple dispatch with one arg works" +? {::next::core::dispatch o bar 1} "goo-1" "simple dispatch with two args works" o destroy # dispatch without colon names Object o -set x 1 -::xotcl::dispatch ::o ::incr x +::next::core::dispatch ::o ::incr x ? {o set x} 1 "cmd dispatch without -objscope did not modify the instance variable" -::xotcl::dispatch ::o -objscope ::incr x +::next::core::dispatch ::o -objscope ::incr x ? {o set x} 2 "cmd dispatch -objscope modifies the instance variable" -? {catch {::xotcl::dispatch ::o -objscope ::xxx x}} 1 "cmd dispatch with unknown command" +? {catch {::next::core::dispatch ::o -objscope ::xxx x}} 1 "cmd dispatch with unknown command" o destroy puts stderr ===MINI-OBJECTSYSTEM # test object system # create a minimal object system without internally dipatched methods -::xotcl::createobjectsystem ::object ::class +::next::core::createobjectsystem ::object ::class -? {::xotcl::objectproperty ::object object} 1 -? {::xotcl::objectproperty ::object class} 1 -? {::xotcl::objectproperty ::object metaclass} 0 -? {::xotcl::relation ::object class} ::class -? {::xotcl::relation ::object superclass} "" +? {::next::core::objectproperty ::object object} 1 +? {::next::core::objectproperty ::object class} 1 +? {::next::core::objectproperty ::object metaclass} 0 +? {::next::core::relation ::object class} ::class +? {::next::core::relation ::object superclass} "" -? {::xotcl::objectproperty ::class object} 1 -? {::xotcl::objectproperty ::class class} 1 -? {::xotcl::objectproperty ::class metaclass} 1 -? {::xotcl::relation ::class class} ::class -? {::xotcl::relation ::class superclass} ::object +? {::next::core::objectproperty ::class object} 1 +? {::next::core::objectproperty ::class class} 1 +? {::next::core::objectproperty ::class metaclass} 1 +? {::next::core::relation ::class class} ::class +? {::next::core::relation ::class superclass} ::object # define non-standard methos to create/destroy objects and classes -::xotcl::alias ::class + ::xotcl::cmd::Class::create -::xotcl::alias ::object - ::xotcl::cmd::Object::destroy +::next::core::alias ::class + ::next::core::cmd::Class::create +::next::core::alias ::object - ::next::core::cmd::Object::destroy # create a class named C ::class + C -? {::xotcl::objectproperty ::C object} 1 -? {::xotcl::objectproperty ::C class} 1 -? {::xotcl::objectproperty ::C metaclass} 0 -? {::xotcl::relation ::C class} ::class -? {::xotcl::relation ::C superclass} ::object +? {::next::core::objectproperty ::C object} 1 +? {::next::core::objectproperty ::C class} 1 +? {::next::core::objectproperty ::C metaclass} 0 +? {::next::core::relation ::C class} ::class +? {::next::core::relation ::C superclass} ::object # create an instance of C C + c1 -? {::xotcl::objectproperty ::c1 object} 1 -? {::xotcl::objectproperty ::c1 class} 0 -? {::xotcl::objectproperty ::c1 metaclass} 0 -? {::xotcl::relation ::c1 class} ::C +? {::next::core::objectproperty ::c1 object} 1 +? {::next::core::objectproperty ::c1 class} 0 +? {::next::core::objectproperty ::c1 metaclass} 0 +? {::next::core::relation ::c1 class} ::C # destroy instance and class c1 - -? {::xotcl::objectproperty ::c1 object} 0 -? {::xotcl::objectproperty ::C class} 1 +? {::next::core::objectproperty ::c1 object} 0 +? {::next::core::objectproperty ::C class} 1 C - -? {::xotcl::objectproperty ::C class} 0 +? {::next::core::objectproperty ::C class} 0 puts stderr ===EXIT Index: tests/parameters.xotcl =================================================================== diff -u -r9474936bd01f25c80caa91f9b3164a3072457f66 -r81c800c8b9cb42ef6743d9b80ac2be5ca211a69a --- tests/parameters.xotcl (.../parameters.xotcl) (revision 9474936bd01f25c80caa91f9b3164a3072457f66) +++ tests/parameters.xotcl (.../parameters.xotcl) (revision 81c800c8b9cb42ef6743d9b80ac2be5ca211a69a) @@ -7,9 +7,9 @@ set o [Object create o] puts o=$o - ? {::xotcl::is ::o object} 1 + ? {::next::core::objectproperty ::o object} 1 } -? {::xotcl::is ::o object} 0 +? {::next::core::objectproperty ::o object} 0 #exit ####################################################### @@ -24,49 +24,49 @@ Class create M c1 mixin M - ? {::xotcl::parametercheck object o1} 1 - ? {::xotcl::parametercheck integer 1} 1 + ? {::next::core::parametercheck object o1} 1 + ? {::next::core::parametercheck integer 1} 1 - ? {::xotcl::objectproperty o1 object} 1 - ? {::xotcl::objectproperty c1 type C} 1 + ? {::next::core::objectproperty o1 object} 1 + ? {::next::core::objectproperty c1 type C} 1 - ? {::xotcl::is c1 object -type C} 1 - ? {::xotcl::is c1 object -hasmixin M -type C} 1 - ? {::xotcl::is c1 object -hasmixin M1 -type C} 0 - ? {::xotcl::is c1 object -hasmixin M -type C0} 0 - ? {::xotcl::is o1 object} 1 - ? {::xotcl::is 1 integer} 1 - ? {::xotcl::is c1 type C} 1 - ? {::xotcl::is o type C} 0 - ? {::xotcl::is o object -type C} 0 - ? {::xotcl::is o object -hasmixin C} 0 + ? {::next::core::is c1 object -type C} 1 + ? {::next::core::is c1 object -hasmixin M -type C} 1 + ? {::next::core::is c1 object -hasmixin M1 -type C} 0 + ? {::next::core::is c1 object -hasmixin M -type C0} 0 + ? {::next::core::is o1 object} 1 + ? {::next::core::is 1 integer} 1 + ? {::next::core::is c1 type C} 1 + ? {::next::core::is o type C} 0 + ? {::next::core::is o object -type C} 0 + ? {::next::core::is o object -hasmixin C} 0 #exit - ? {::xotcl::parametercheck class o1} {expected class but got "o1" for parameter value} - ? {::xotcl::parametercheck -nocomplain class o1} 0 - ? {::xotcl::parametercheck class Test} 1 - ? {::xotcl::parametercheck object,multivalued [list o1 Test]} 1 + ? {::next::core::parametercheck class o1} {expected class but got "o1" for parameter value} + ? {::next::core::parametercheck -nocomplain class o1} 0 + ? {::next::core::parametercheck class Test} 1 + ? {::next::core::parametercheck object,multivalued [list o1 Test]} 1 - ? {::xotcl::parametercheck integer,multivalued [list 1 2 3]} 1 - ? {::xotcl::parametercheck integer,multivalued [list 1 2 3 a]} \ + ? {::next::core::parametercheck integer,multivalued [list 1 2 3]} 1 + ? {::next::core::parametercheck integer,multivalued [list 1 2 3 a]} \ {invalid value in "1 2 3 a": expected integer but got "a" for parameter value} - ? {::xotcl::parametercheck object,type=::C c1} 1 - ? {::xotcl::parametercheck object,type=::C o} \ + ? {::next::core::parametercheck object,type=::C c1} 1 + ? {::next::core::parametercheck object,type=::C o} \ {expected object but got "o" for parameter value} \ "object, but different type" - ? {::xotcl::parametercheck object,type=::C c} \ + ? {::next::core::parametercheck object,type=::C c} \ {expected object but got "c" for parameter value} \ "no object" - ? {::xotcl::parametercheck object,type=::xotcl2::Object c1} 1 "general type" + ? {::next::core::parametercheck object,type=::next::Object c1} 1 "general type" # do not allow "currently unknown" user defined types in parametercheck - ? {::xotcl::parametercheck in1 aaa} {invalid value constraints "in1"} + ? {::next::core::parametercheck in1 aaa} {invalid value constraints "in1"} - ? {::xotcl::parametercheck lower c} 1 "lower case char" - ? {::xotcl::parametercheck lower abc} 1 "lower case chars" - ? {::xotcl::parametercheck lower Abc} {expected lower but got "Abc" for parameter value} + ? {::next::core::parametercheck lower c} 1 "lower case char" + ? {::next::core::parametercheck lower abc} 1 "lower case chars" + ? {::next::core::parametercheck lower Abc} {expected lower but got "Abc" for parameter value} ? {string is lower abc} 1 "tcl command 'string is lower'" - ? {::xotcl::parametercheck {i:integer 1} 2} {invalid value constraints "i:integer 1"} + ? {::next::core::parametercheck {i:integer 1} 2} {invalid value constraints "i:integer 1"} } ####################################################### @@ -81,7 +81,7 @@ } } - ? {::xotcl::parametercheck sex,slot=::paramManager female} "1" + ? {::next::core::parametercheck sex,slot=::paramManager female} "1" } ####################################################### # cononical feature table @@ -140,10 +140,10 @@ # ::xotcl::RelationSlot -superclass ::xotcl::Slot { # {multivalued true} # {type relation} -# {elementtype ::xotcl2::Class} +# {elementtype ::next::Class} # } -- sample instances: class superclass, mixin filter # -# ::xotcl::Attribute -superclass ::xotcl::Slot { +# ::next::Attribute -superclass ::xotcl::Slot { # {value_check once} # initcmd # valuecmd @@ -165,13 +165,13 @@ C create c1 ? {C eval {:objectparameter}} \ - "-object-mixin:relation,slot=::xotcl2::Class::slot::object-mixin -mixin:relation,arg=class-mixin,slot=::xotcl2::Class::slot::mixin -superclass:relation,slot=::xotcl2::Class::slot::superclass -object-filter:relation,slot=::xotcl2::Class::slot::object-filter -filter:relation,arg=class-filter,slot=::xotcl2::Class::slot::filter -class:relation,slot=::xotcl2::Object::slot::class -parameter:method,optional -noinit:method,optional,noarg -volatile:method,optional,noarg __initcmd:initcmd,optional" + "-object-mixin:relation,slot=::next::Class::slot::object-mixin -mixin:relation,arg=class-mixin,slot=::next::Class::slot::mixin -superclass:relation,slot=::next::Class::slot::superclass -object-filter:relation,slot=::next::Class::slot::object-filter -filter:relation,arg=class-filter,slot=::next::Class::slot::filter -class:relation,slot=::next::Object::slot::class -parameter:method,optional -noinit:method,optional,noarg -volatile:method,optional,noarg __initcmd:initcmd,optional" ? {c1 eval {:objectparameter}} \ - "-a:slot=::C::slot::a -b:boolean,slot=::C::slot::b {-c:slot=::C::slot::c 1} -mixin:relation,arg=object-mixin,slot=::xotcl2::Object::slot::mixin -filter:relation,slot=::xotcl2::Object::slot::filter -class:relation,slot=::xotcl2::Object::slot::class -noinit:method,optional,noarg -volatile:method,optional,noarg __initcmd:initcmd,optional" + "-a:slot=::C::slot::a -b:boolean,slot=::C::slot::b {-c:slot=::C::slot::c 1} -mixin:relation,arg=object-mixin,slot=::next::Object::slot::mixin -filter:relation,slot=::next::Object::slot::filter -class:relation,slot=::next::Object::slot::class -noinit:method,optional,noarg -volatile:method,optional,noarg __initcmd:initcmd,optional" } ####################################################### @@ -184,13 +184,13 @@ c1 class Object ? {c1 eval :objectparameter} \ - "-mixin:relation,arg=object-mixin,slot=::xotcl2::Object::slot::mixin -filter:relation,slot=::xotcl2::Object::slot::filter -class:relation,slot=::xotcl2::Object::slot::class -noinit:method,optional,noarg -volatile:method,optional,noarg __initcmd:initcmd,optional" + "-mixin:relation,arg=object-mixin,slot=::next::Object::slot::mixin -filter:relation,slot=::next::Object::slot::filter -class:relation,slot=::next::Object::slot::class -noinit:method,optional,noarg -volatile:method,optional,noarg __initcmd:initcmd,optional" Class create D -superclass C -parameter {d:required} D create d1 -d 100 ? {d1 eval :objectparameter} \ - "-d:required,slot=::D::slot::d -a:slot=::C::slot::a -b:boolean,slot=::C::slot::b {-c:slot=::C::slot::c 1} -mixin:relation,arg=object-mixin,slot=::xotcl2::Object::slot::mixin -filter:relation,slot=::xotcl2::Object::slot::filter -class:relation,slot=::xotcl2::Object::slot::class -noinit:method,optional,noarg -volatile:method,optional,noarg __initcmd:initcmd,optional" + "-d:required,slot=::D::slot::d -a:slot=::C::slot::a -b:boolean,slot=::C::slot::b {-c:slot=::C::slot::c 1} -mixin:relation,arg=object-mixin,slot=::next::Object::slot::mixin -filter:relation,slot=::next::Object::slot::filter -class:relation,slot=::next::Object::slot::class -noinit:method,optional,noarg -volatile:method,optional,noarg __initcmd:initcmd,optional" } ####################################################### @@ -206,28 +206,28 @@ Class create M2 -parameter {b2} D mixin M ? {d1 eval :objectparameter} \ - "-b:slot=::M::slot::b -m1:slot=::M::slot::m1 -m2:slot=::M::slot::m2 -d:required,slot=::D::slot::d -a:slot=::C::slot::a {-c:slot=::C::slot::c 1} -mixin:relation,arg=object-mixin,slot=::xotcl2::Object::slot::mixin -filter:relation,slot=::xotcl2::Object::slot::filter -class:relation,slot=::xotcl2::Object::slot::class -noinit:method,optional,noarg -volatile:method,optional,noarg __initcmd:initcmd,optional" \ + "-b:slot=::M::slot::b -m1:slot=::M::slot::m1 -m2:slot=::M::slot::m2 -d:required,slot=::D::slot::d -a:slot=::C::slot::a {-c:slot=::C::slot::c 1} -mixin:relation,arg=object-mixin,slot=::next::Object::slot::mixin -filter:relation,slot=::next::Object::slot::filter -class:relation,slot=::next::Object::slot::class -noinit:method,optional,noarg -volatile:method,optional,noarg __initcmd:initcmd,optional" \ "mixin added" M mixin M2 ? {d1 eval :objectparameter} \ - "-b2:slot=::M2::slot::b2 -b:slot=::M::slot::b -m1:slot=::M::slot::m1 -m2:slot=::M::slot::m2 -d:required,slot=::D::slot::d -a:slot=::C::slot::a {-c:slot=::C::slot::c 1} -mixin:relation,arg=object-mixin,slot=::xotcl2::Object::slot::mixin -filter:relation,slot=::xotcl2::Object::slot::filter -class:relation,slot=::xotcl2::Object::slot::class -noinit:method,optional,noarg -volatile:method,optional,noarg __initcmd:initcmd,optional" \ + "-b2:slot=::M2::slot::b2 -b:slot=::M::slot::b -m1:slot=::M::slot::m1 -m2:slot=::M::slot::m2 -d:required,slot=::D::slot::d -a:slot=::C::slot::a {-c:slot=::C::slot::c 1} -mixin:relation,arg=object-mixin,slot=::next::Object::slot::mixin -filter:relation,slot=::next::Object::slot::filter -class:relation,slot=::next::Object::slot::class -noinit:method,optional,noarg -volatile:method,optional,noarg __initcmd:initcmd,optional" \ "transitive mixin added" D mixin "" #we should have again the old interface ? {d1 eval :objectparameter} \ - "-d:required,slot=::D::slot::d -a:slot=::C::slot::a -b:boolean,slot=::C::slot::b {-c:slot=::C::slot::c 1} -mixin:relation,arg=object-mixin,slot=::xotcl2::Object::slot::mixin -filter:relation,slot=::xotcl2::Object::slot::filter -class:relation,slot=::xotcl2::Object::slot::class -noinit:method,optional,noarg -volatile:method,optional,noarg __initcmd:initcmd,optional" + "-d:required,slot=::D::slot::d -a:slot=::C::slot::a -b:boolean,slot=::C::slot::b {-c:slot=::C::slot::c 1} -mixin:relation,arg=object-mixin,slot=::next::Object::slot::mixin -filter:relation,slot=::next::Object::slot::filter -class:relation,slot=::next::Object::slot::class -noinit:method,optional,noarg -volatile:method,optional,noarg __initcmd:initcmd,optional" C mixin M ? {d1 eval :objectparameter} \ - "-b2:slot=::M2::slot::b2 -b:slot=::M::slot::b -m1:slot=::M::slot::m1 -m2:slot=::M::slot::m2 -d:required,slot=::D::slot::d -a:slot=::C::slot::a {-c:slot=::C::slot::c 1} -mixin:relation,arg=object-mixin,slot=::xotcl2::Object::slot::mixin -filter:relation,slot=::xotcl2::Object::slot::filter -class:relation,slot=::xotcl2::Object::slot::class -noinit:method,optional,noarg -volatile:method,optional,noarg __initcmd:initcmd,optional" \ + "-b2:slot=::M2::slot::b2 -b:slot=::M::slot::b -m1:slot=::M::slot::m1 -m2:slot=::M::slot::m2 -d:required,slot=::D::slot::d -a:slot=::C::slot::a {-c:slot=::C::slot::c 1} -mixin:relation,arg=object-mixin,slot=::next::Object::slot::mixin -filter:relation,slot=::next::Object::slot::filter -class:relation,slot=::next::Object::slot::class -noinit:method,optional,noarg -volatile:method,optional,noarg __initcmd:initcmd,optional" \ "mixin added" C mixin "" #we should have again the old interface ? {d1 eval :objectparameter} \ - "-d:required,slot=::D::slot::d -a:slot=::C::slot::a -b:boolean,slot=::C::slot::b {-c:slot=::C::slot::c 1} -mixin:relation,arg=object-mixin,slot=::xotcl2::Object::slot::mixin -filter:relation,slot=::xotcl2::Object::slot::filter -class:relation,slot=::xotcl2::Object::slot::class -noinit:method,optional,noarg -volatile:method,optional,noarg __initcmd:initcmd,optional" + "-d:required,slot=::D::slot::d -a:slot=::C::slot::a -b:boolean,slot=::C::slot::b {-c:slot=::C::slot::c 1} -mixin:relation,arg=object-mixin,slot=::next::Object::slot::mixin -filter:relation,slot=::next::Object::slot::filter -class:relation,slot=::next::Object::slot::class -noinit:method,optional,noarg -volatile:method,optional,noarg __initcmd:initcmd,optional" } ####################################################### @@ -291,7 +291,7 @@ "don't allow relation option as method parameter" ? {D method foo {a:double} {return $a}} \ - {::xotcl::classes::D::foo} \ + {::next::core::classes::D::foo} \ "allow 'string is XXXX' for argument checking" ? {d1 foo 1} 1 "check int as double" ? {d1 foo 1.1} 1.1 "check double as double" @@ -391,7 +391,7 @@ Class create Bar -superclass D -parameter { {s "[self]"} {literal "\\[self\\]"} - {c "[my info class]"} + {c "[:info class]"} {d "literal $d"} {switch:switch} } @@ -498,7 +498,7 @@ D create d1 # create a userdefined type - ::xotcl::methodParameterSlot method type=mytype {name value args} { + ::next::methodParameterSlot method type=mytype {name value args} { if {$value < 1 || $value > 3} { error "Value '$value' of parameter $name is not between 1 and 3" } @@ -519,11 +519,11 @@ } ? {d1 foo 10} \ - "::xotcl::methodParameterSlot: unable to dispatch method 'type=unknowntype'" \ + "::next::methodParameterSlot: unable to dispatch method 'type=unknowntype'" \ "missing type checker" # create a userdefined type with a simple argument - ::xotcl::methodParameterSlot method type=in {name value arg} { + ::next::methodParameterSlot method type=in {name value arg} { if {$value ni [split $arg |]} { error "Value '$value' of parameter $name not in permissible values $arg" } @@ -549,7 +549,7 @@ "Value 'very good' of parameter b not in permissible values good|bad" \ "invalid value (not included)" - ::xotcl::methodParameterSlot method type=range {name value arg} { + ::next::methodParameterSlot method type=range {name value arg} { foreach {min max} [split $arg -] break if {$value < $min || $value > $max} { error "Value '$value' of parameter $name not between $min and $max" @@ -575,7 +575,7 @@ # # handling of arg with spaces/arg as list # - ::xotcl::methodParameterSlot method type=list {name value arg} { + ::next::methodParameterSlot method type=list {name value arg} { #puts $value/$arg return $value } @@ -611,7 +611,7 @@ ? {D info method parameter foo-hasmixin} "x:hasmixin,arg=::M" ? {D info method parameter foo-type} "x:object,type=::C" - ? {d1 foo-base ::xotcl2::Object} "::xotcl2::Object" + ? {d1 foo-base ::next::Object} "::next::Object" ? {d1 foo-base C} \ {expected baseclass but got "C" for parameter x} \ "not a base class" @@ -624,9 +624,9 @@ {expected class but got "o" for parameter x} \ "not a class" - ? {d1 foo-meta ::xotcl2::Class} "::xotcl2::Class" - ? {d1 foo-meta ::xotcl2::Object} \ - {expected metaclass but got "::xotcl2::Object" for parameter x} \ + ? {d1 foo-meta ::next::Class} "::next::Class" + ? {d1 foo-meta ::next::Object} \ + {expected metaclass but got "::next::Object" for parameter x} \ "not a base class" ? {d1 foo-hasmixin c1} "c1" @@ -792,7 +792,7 @@ "value is not an object" ParamTest slots { - ::xotcl::Attribute create os -type object -multivalued true + ::next::Attribute create os -type object -multivalued true } ? {p os o} \ @@ -812,7 +812,7 @@ ####################################################### Test case multivalued-app-converter { - ::xotcl::methodParameterSlot method type=sex {name value args} { + ::next::methodParameterSlot method type=sex {name value args} { #puts stderr "[self] slot specific converter" switch -glob $value { m* {return m} @@ -836,11 +836,11 @@ # values into emtpy strings. } - ? {::xotcl::parametercheck mType,slot=::tmpObj,multivalued {1 0}} \ + ? {::next::core::parametercheck mType,slot=::tmpObj,multivalued {1 0}} \ {invalid value in "1 0": expected false but got 1} \ "fail on first value" - ? {::xotcl::parametercheck mType,slot=::tmpObj,multivalued {0 0 0}} 1 "all pass" - ? {::xotcl::parametercheck mType,slot=::tmpObj,multivalued {0 1}} \ + ? {::next::core::parametercheck mType,slot=::tmpObj,multivalued {0 0 0}} 1 "all pass" + ? {::next::core::parametercheck mType,slot=::tmpObj,multivalued {0 1}} \ {invalid value in "0 1": expected false but got 1} \ "fail o last value" } @@ -860,7 +860,7 @@ } } - ? {::xotcl::parametercheck integer,slot=::mySlot 1} 1 + ? {::next::core::parametercheck integer,slot=::mySlot 1} 1 ? {o foo 3} 4 } @@ -895,17 +895,17 @@ Object create o Class create C - ? {::xotcl::setter o a} "::o::a" - ? {::xotcl::setter C c} "::xotcl::classes::C::c" + ? {::next::core::setter o a} "::o::a" + ? {::next::core::setter C c} "::next::core::classes::C::c" ? {o info method definition a} "::o setter a" ? {o info method parameter a} "a" ? {o info method args a} "a" ? {C info method definition c} "::C setter c" ? {o a 1} "1" - ? {::xotcl::setter o a:integer} "::o::a" - ? {::xotcl::setter o ints:integer,multivalued} "::o::ints" - ? {::xotcl::setter o o:object} "::o::o" + ? {::next::core::setter o a:integer} "::o::a" + ? {::next::core::setter o ints:integer,multivalued} "::o::ints" + ? {::next::core::setter o o:object} "::o::o" ? {o info method name ints} "::o::ints" ? {o info method definition ints} "::o setter ints:integer,multivalued" @@ -923,8 +923,8 @@ ? {o ints {10 100 1000}} {10 100 1000} ? {o ints hugo} {invalid value in "hugo": expected integer but got "hugo" for parameter ints} ? {o o o} o - ? {::xotcl::setter o {d default}} {parameter "d" is not allowed to have default "default"} - ? {::xotcl::setter o -x} {method name "-x" must not start with a dash} + ? {::next::core::setter o {d default}} {parameter "d" is not allowed to have default "default"} + ? {::next::core::setter o -x} {method name "-x" must not start with a dash} } ####################################################### Index: tests/persistence.test =================================================================== diff -u -rc72f9f638677608fab1502cd696c8f2d6b2952f9 -r81c800c8b9cb42ef6743d9b80ac2be5ca211a69a --- tests/persistence.test (.../persistence.test) (revision c72f9f638677608fab1502cd696c8f2d6b2952f9) +++ tests/persistence.test (.../persistence.test) (revision 81c800c8b9cb42ef6743d9b80ac2be5ca211a69a) @@ -1,5 +1,5 @@ #!../../src/xotclsh -# -*- Tcl -*- $Id: persistence.test,v 1.1 2004/05/23 22:50:39 neumann Exp $ +# -*- Tcl -*- package require XOTcl; namespace import -force xotcl::* @ @File { Index: tests/protected.xotcl =================================================================== diff -u -r210eab6d9149846d5d6a6a8e0fa74e232ca5b6de -r81c800c8b9cb42ef6743d9b80ac2be5ca211a69a --- tests/protected.xotcl (.../protected.xotcl) (revision 210eab6d9149846d5d6a6a8e0fa74e232ca5b6de) +++ tests/protected.xotcl (.../protected.xotcl) (revision 81c800c8b9cb42ef6743d9b80ac2be5ca211a69a) @@ -24,19 +24,19 @@ ? {c1 bar-SET} {1} ? {c1 bar-foo} {foo} -::xotcl::methodproperty C SET protected true +::next::core::methodproperty C SET protected true ? {catch {c1 SET x 1} errorMsg; set errorMsg} {::c1: unable to dispatch method 'SET'} -? {::xotcl::dispatch c1 SET x 2} {2} "dispatch of protected methods works" +? {::next::core::dispatch c1 SET x 2} {2} "dispatch of protected methods works" ? {c1 foo} {foo} ? {c1 bar} {bar} ? {c1 bar-SET} {1} ? {c1 bar-foo} {foo} ? {catch {c2 bar-SET} errorMsg; set errorMsg} {::c1: unable to dispatch method 'SET'} ? {c2 bar-foo} {foo} -::xotcl::methodproperty C foo protected true +::next::core::methodproperty C foo protected true ? {catch {c1 SET x 1} errorMsg; set errorMsg} {::c1: unable to dispatch method 'SET'} -? {::xotcl::dispatch c1 SET x 2} {2} "dispatch of protected methods works" +? {::next::core::dispatch c1 SET x 2} {2} "dispatch of protected methods works" ? {c1 bar} {bar} "other method work" ? {catch {c1 foo} errorMsg; set errorMsg} {::c1: unable to dispatch method 'foo'} ? {c1 bar-SET} {1} "internal call of protected C implementend method" @@ -45,15 +45,15 @@ ? {catch {c2 bar-foo} errorMsg; set errorMsg} {::c1: unable to dispatch method 'foo'} # unset protected -? {::xotcl::methodproperty C SET protected} 1 -::xotcl::methodproperty C SET protected false -? {::xotcl::methodproperty C SET protected} 0 -? {::xotcl::methodproperty C foo protected} 1 -::xotcl::methodproperty C foo protected false -? {::xotcl::methodproperty C foo protected} 0 +? {::next::core::methodproperty C SET protected} 1 +::next::core::methodproperty C SET protected false +? {::next::core::methodproperty C SET protected} 0 +? {::next::core::methodproperty C foo protected} 1 +::next::core::methodproperty C foo protected false +? {::next::core::methodproperty C foo protected} 0 ? {c1 SET x 3} 3 -? {::xotcl::dispatch c1 SET x 2} {2} +? {::next::core::dispatch c1 SET x 2} {2} ? {c1 foo} {foo} ? {c1 bar} {bar} ? {c1 bar-SET} {1} @@ -63,28 +63,28 @@ # define a protected method C protected method foo {} {return [self proc]} -? {::xotcl::methodproperty C SET protected} 0 +? {::next::core::methodproperty C SET protected} 0 ? {c1 SET x 3} 3 -? {::xotcl::dispatch c1 SET x 4} {4} +? {::next::core::dispatch c1 SET x 4} {4} ? {catch {c1 foo} errorMsg; set errorMsg} {::c1: unable to dispatch method 'foo'} ? {c1 bar} {bar} ? {c1 bar-SET} {1} ? {c1 bar-foo} foo ? {c2 bar-SET} 1 ? {catch {c2 bar-foo} errorMsg; set errorMsg} {::c1: unable to dispatch method 'foo'} -? {::xotcl::methodproperty C SET redefine-protected true} 1 +? {::next::core::methodproperty C SET redefine-protected true} 1 ? {catch {C method SET {a b c} {...}} errorMsg; set errorMsg} \ {Method 'SET' of ::C can not be overwritten. Derive e.g. a sub-class!} -? {::xotcl::methodproperty C foo redefine-protected true} 1 +? {::next::core::methodproperty C foo redefine-protected true} 1 ? {catch {C method foo {a b c} {...}} errorMsg; set errorMsg} \ {Method 'foo' of ::C can not be overwritten. Derive e.g. a sub-class!} # check a predefined protection -? {catch {::xotcl2::Class method dealloc {a b c} {...}} errorMsg; set errorMsg} \ - {Method 'dealloc' of ::xotcl2::Class can not be overwritten. Derive e.g. a sub-class!} +? {catch {::next::Class method dealloc {a b c} {...}} errorMsg; set errorMsg} \ + {Method 'dealloc' of ::next::Class can not be overwritten. Derive e.g. a sub-class!} # try to redefined via alias -? {catch {::xotcl::alias Class dealloc ::set} errorMsg; set errorMsg} \ - {Method 'dealloc' of ::xotcl2::Class can not be overwritten. Derive e.g. a sub-class!} +? {catch {::next::core::alias Class dealloc ::set} errorMsg; set errorMsg} \ + {Method 'dealloc' of ::next::Class can not be overwritten. Derive e.g. a sub-class!} # try to redefine via forward ? {catch {C forward SET ::set} errorMsg; set errorMsg} \ {Method 'SET' of ::C can not be overwritten. Derive e.g. a sub-class!} @@ -95,7 +95,7 @@ # overwrite-protect object specific method Object create o o method foo {} {return 13} -::xotcl::methodproperty o foo redefine-protected true +::next::core::methodproperty o foo redefine-protected true ? {catch {o method foo {} {return 14}} errorMsg; set errorMsg} \ {Method 'foo' of ::o can not be overwritten. Derive e.g. a sub-class!} Index: tests/slottest.xotcl =================================================================== diff -u -r2c0baf4a8ccba0820da0b4f318be18d2051e00ae -r81c800c8b9cb42ef6743d9b80ac2be5ca211a69a --- tests/slottest.xotcl (.../slottest.xotcl) (revision 2c0baf4a8ccba0820da0b4f318be18d2051e00ae) +++ tests/slottest.xotcl (.../slottest.xotcl) (revision 81c800c8b9cb42ef6743d9b80ac2be5ca211a69a) @@ -1,4 +1,4 @@ -package require XOTcl; xotcl::use xotcl1 +package require XOTcl; namespace import ::xotcl::* package require xotcl::test Test parameter count 1000 @@ -97,7 +97,7 @@ # "class" is not multivalued, therefore we should not add (or remove) add/delete # from the set of subcommands... -? {::xotcl::RelationSlot class} "::xotcl::MetaSlot" +? {::next::RelationSlot class} "::next::MetaSlot" O o1 ? {o1 class} "::O" o1 class Object @@ -111,7 +111,7 @@ #? {O2 superclass O} "superclass 1" ? {O superclass} "::xotcl::Object" -::xotcl::ObjectParameterSlot method slot {object name property} { +::next::ObjectParameterSlot method slot {object name property} { switch $property { self {return [self]} domain {return [my domain]} @@ -169,18 +169,18 @@ Object o1 o1 set i 0 -::xotcl::alias o1 Incr -objscope ::incr +::next::core::alias o1 Incr -objscope ::incr ? {o1 incr i} 1 "method incr" ? {o1 Incr i} 1002 "aliased tcl incr" ? {o1 incr i} 2003 "method incr" ? {o1 Incr i} 3004 "aliased tcl incr" -::xotcl::alias ::xotcl::Object Set -objscope ::set +::next::core::alias ::xotcl::Object Set -objscope ::set ? {o1 set i 1} 1 "method set" ? {o1 set i} 1 "method set" ? {o1 Set i 1} 1 "aliased tcl set" ? {o1 Set i} 1 "aliased tcl set" -::xotcl::alias o1 Set -objscope ::set +::next::core::alias o1 Set -objscope ::set ? {o1 Set i 1} 1 "aliased object tcl set" ? {o1 Set i} 1 "aliased object tcl set" ::xotcl::Object instforward SSet -earlybinding -objscope ::set @@ -191,15 +191,15 @@ o1 set z 100 #o1 forward z o1 [list %argclindex [list set set]] %proc #o1 proc get name {my set $name} -o1 forward get -earlybinding ::xotcl::setvar %self %1 +o1 forward get -earlybinding ::next::core::setvar %self %1 ? {o1 get z 101} 101 ? {o1 get z} "101" ? {o1 get z} 101 "get value via new parametercmd get" ? {o1 get z 124} 124 "set value via new parametercmd get" -o1 forward zz -earlybinding ::xotcl::setvar %self %proc +o1 forward zz -earlybinding ::next::core::setvar %self %proc ? {o1 zz 123} 123 ? {o1 zz} 123 @@ -251,7 +251,7 @@ # } # } -::xotcl::Attribute mixin delete ::xotcl::Attribute::Optimizer +::xotcl::Attribute mixin delete ::next::Attribute::Optimizer Class C1 -parameter {a {b 10} {c "Hello World"}} C1 c1 -a 1 @@ -277,7 +277,7 @@ ? {c2 a} 1 "new indirect parametercmd" ? {c2 a 1} 1 "new indirect parametercmd" -::xotcl::Attribute mixin add ::xotcl::Attribute::Optimizer +::xotcl::Attribute mixin add ::next::Attribute::Optimizer Class C3 -slots { Attribute create a @@ -319,7 +319,7 @@ ? {a0 procsearch f3} "::a0 proc f3" ? {a0 procsearch f4} "::a0 forward f4" ? {a0 procsearch set} "::xotcl::Object instcmd set" -? {A slot foo info callable -which assign} "::xotcl::ObjectParameterSlot alias assign ::xotcl::setvar" +? {A slot foo info callable -which assign} "::next::ObjectParameterSlot alias assign ::next::core::setvar" # redefine setter for foo of class A A slot foo method assign {domain var val} { @@ -362,7 +362,7 @@ #p1 projects add some-other-value #? {p1 projects} "some-other-value ::project1" -::xotcl::ObjectParameterSlot method check { +::next::ObjectParameterSlot method check { {-keep_old_value:boolean true} value predicate type obj var } { @@ -378,7 +378,7 @@ if {$keep_old_value} {$obj set __oldvalue($var) $value} } -::xotcl::ObjectParameterSlot method checkall {values predicate type obj var} { +::next::ObjectParameterSlot method checkall {values predicate type obj var} { foreach value $values { my check -keep_old_value false $value $predicate $type $obj $var } @@ -536,7 +536,7 @@ ? {o1 myf 100} 200 o1 set x 42 -o1 forward x -earlybinding ::xotcl::setvar %self %proc +o1 forward x -earlybinding ::next::core::setvar %self %proc ? [list o1 x] 42 ? [list o1 x 41] 41 ? {o1 x} "get parametercmd via forward (earlybinding)" @@ -559,7 +559,7 @@ ? {o1 myfdset y} "get instvar value via forward -earlybinding" ? {o1 myfdset y 123} "set instvar value via forward -earlybinding" -::xotcl::alias o1 myset -objscope ::set +::next::core::alias o1 myset -objscope ::set o1 myset x 101 ? {o1 myset x} 101 @@ -575,7 +575,7 @@ P create p2 -age 345 -s 567 ? {p2 age} "parametercmd read" -? {::xotcl::setvar p2 age} "via setinstvar" +? {::next::core::setvar p2 age} "via setinstvar" ? {p2 s} "parameter read with setter" Index: tests/speedtest.xotcl =================================================================== diff -u -r210eab6d9149846d5d6a6a8e0fa74e232ca5b6de -r81c800c8b9cb42ef6743d9b80ac2be5ca211a69a --- tests/speedtest.xotcl (.../speedtest.xotcl) (revision 210eab6d9149846d5d6a6a8e0fa74e232ca5b6de) +++ tests/speedtest.xotcl (.../speedtest.xotcl) (revision 81c800c8b9cb42ef6743d9b80ac2be5ca211a69a) @@ -1,7 +1,5 @@ #memory trace on -# $Id: speedtest.xotcl,v 1.10 2007/08/14 16:38:27 neumann Exp $ -package require XOTcl; xotcl::use xotcl1 -#lappend auto_path [file dirname [info script]]/.. +package require XOTcl; namespace import ::xotcl::* package require xotcl::test Test parameter count 1000 @@ -13,17 +11,11 @@ } set ccount 20 -set ocount 1014 -set ocount [expr {$ccount + 206}] -set ocount [expr {$ccount + 15}] -set ocount [expr {$ccount + 6}] +#set ocount 1014 +#set ocount [expr {$ccount + 206}] +#set ocount [expr {$ccount + 15}] +set ocount [expr {$ccount + 7}] -set startObjects [Object info instances] -set x [llength [Object info instances]] -set y [set _ [llength [Object info instances]]] -set z [llength $startObjects] -#puts stderr "x=$x, y=$y, z=$z, ocount=$ocount" - Class M1; Class M2 Class C -parameter {{p 99} {q 98} r} C instproc f args {next} @@ -194,6 +186,7 @@ #Test new -cmd {set x [llength [c info children]]} -count 1 -expected 999 Test new -cmd {llength [c info children]} -count 1 -expected $ccount Test new -cmd {set x [llength [c info children]]} -count 1 -expected $ccount +puts stderr XXX-[llength [Object info instances]]-[lsort [Object info instances]] Test new -cmd {set x [llength [Object info instances]]} -count 1 -expected $ocount Test new -cmd {llength [Object info instances]} -count 1 -expected $ocount @@ -260,14 +253,14 @@ # should be still the same number as above Test new -count 1 -cmd {llength [Object info instances]} -expected $ocount -Test new -cmd {Object new -volatile} -expected ::xotcl::__\#F9 -count 2000 \ - -post {foreach o [Object info instances ::xotcl::__*] {$o destroy}} +Test new -cmd {Object new -volatile} -expected ::next::core::__\#F9 -count 2000 \ + -post {foreach o [Object info instances ::next::core::__*] {$o destroy}} # should be still the same number as above Test new -count 1 -cmd {llength [Object info instances]} -expected $ocount -Test new -cmd {Object new} -expected ::xotcl::__\#lQ -count 2000 \ - -post {foreach o [Object info instances ::xotcl::__*] {$o destroy}} +Test new -cmd {Object new} -expected ::next::core::__\#lQ -count 2000 \ + -post {foreach o [Object info instances ::next::core::__*] {$o destroy}} # should be still the same number as above Test new -count 1 -cmd {llength [Object info instances]} -expected $ocount Index: tests/testo.xotcl =================================================================== diff -u -rf9807b1cea03590c9573b5a521760538d53ee90f -r81c800c8b9cb42ef6743d9b80ac2be5ca211a69a --- tests/testo.xotcl (.../testo.xotcl) (revision f9807b1cea03590c9573b5a521760538d53ee90f) +++ tests/testo.xotcl (.../testo.xotcl) (revision 81c800c8b9cb42ef6743d9b80ac2be5ca211a69a) @@ -1,4 +1,3 @@ -# $Id: testo.xotcl,v 1.9 2007/08/14 16:38:27 neumann Exp $ # # Copyright 1993 Massachusetts Institute of Technology # @@ -12,7 +11,7 @@ # suitability of this software for any purpose. It is provided "as is" # without express or implied warranty. # -package require XOTcl; xotcl::use xotcl1 +package require XOTcl; namespace import ::xotcl::* @ @File {description { This is a class which provides regression test objects Index: tests/testx.xotcl =================================================================== diff -u -r091d3c94b06fd94c8e2bf39f806c43483909e2af -r81c800c8b9cb42ef6743d9b80ac2be5ca211a69a --- tests/testx.xotcl (.../testx.xotcl) (revision 091d3c94b06fd94c8e2bf39f806c43483909e2af) +++ tests/testx.xotcl (.../testx.xotcl) (revision 81c800c8b9cb42ef6743d9b80ac2be5ca211a69a) @@ -1,5 +1,5 @@ -#$Id: testx.xotcl,v 1.36 2007/10/12 19:53:32 neumann Exp $ -package require XOTcl; xotcl::use xotcl1 +# -*- Tcl -*- +package require XOTcl; namespace import ::xotcl::* proc ::errorCheck {got expected msg} { if {$got != $expected} { @@ -517,12 +517,12 @@ o m ::errorCheck [o set count] 2 "filter count" o filter "" - set filterstate [::xotcl::configure filter off] + set filterstate [::next::core::configure filter off] o set count 0 o m ::errorCheck [o set count]-$filterstate 0-1 "filter off + old state" o filter "" - ::xotcl::configure filter on + ::next::core::configure filter on set ::r "" Object instproc f args { @@ -3153,7 +3153,7 @@ xotcl::interp create in set ::r [in eval { - xotcl::use xotcl1 + package req XOTcl; namespace import ::xotcl::* Object o }] xotcl::interp delete in Index: tests/varresolutiontest.xotcl =================================================================== diff -u -r02aed4cae11ab394396aaff86d08ee22d1e2c910 -r81c800c8b9cb42ef6743d9b80ac2be5ca211a69a --- tests/varresolutiontest.xotcl (.../varresolutiontest.xotcl) (revision 02aed4cae11ab394396aaff86d08ee22d1e2c910) +++ tests/varresolutiontest.xotcl (.../varresolutiontest.xotcl) (revision 81c800c8b9cb42ef6743d9b80ac2be5ca211a69a) @@ -5,12 +5,12 @@ Test parameter count 1 -::xotcl::alias ::xotcl2::Object objeval -objscope ::eval -::xotcl::alias ::xotcl2::Object array -objscope ::array -::xotcl::alias ::xotcl2::Object lappend -objscope ::lappend -::xotcl::alias ::xotcl2::Object incr -objscope ::incr -::xotcl::alias ::xotcl2::Object set -objscope ::set -::xotcl::alias ::xotcl2::Object unset -objscope ::unset +::next::core::alias ::next::Object objeval -objscope ::eval +::next::core::alias ::next::Object array -objscope ::array +::next::core::alias ::next::Object lappend -objscope ::lappend +::next::core::alias ::next::Object incr -objscope ::incr +::next::core::alias ::next::Object set -objscope ::set +::next::core::alias ::next::Object unset -objscope ::unset ########################################### @@ -46,9 +46,9 @@ o objeval { # require an namespace within an objscoped frame; it is necessary to replace # vartables on the stack - my requireNamespace + :requireNamespace global g - ::xotcl::importvar o2 i + ::next::core::importvar o2 i set x 1 set :y 2 set ::z 3 @@ -78,9 +78,9 @@ Object create o2 {set :i 1} Object create o { - my requireNamespace + :requireNamespace global g - ::xotcl::importvar o2 i + ::next::core::importvar o2 i set x 1 set :y 2 set ::z 3 @@ -121,7 +121,7 @@ ? {::o set x} 3 ? {namespace eval ::o {info exists x}} 1 ? {::o unset x} "" -? {::xotcl::existsvar o x} 0 +? {::next::core::existsvar o x} 0 ? {o exists x} 0 ? {info vars ::x} "" ? {namespace eval ::o {info exists x}} 0 @@ -352,13 +352,13 @@ array set ::tmpArray {key value} Class create ::C -::xotcl::alias ::C Set -objscope ::set -::xotcl::alias ::C Unset -objscope ::unset +::next::core::alias ::C Set -objscope ::set +::next::core::alias ::C Unset -objscope ::unset ::C create ::c namespace eval ::c {} ? {namespace exists ::c} 1 -? {::xotcl::is ::c object} 1 +? {::next::core::objectproperty ::c object} 1 ? {::c info hasnamespace} 0 ? {::c Set w 2; expr {[::c Set w] == $::w}} 0 @@ -380,9 +380,9 @@ # with a required namespace and without ################################################## Test case eval-variants -::xotcl::alias ::xotcl2::Object objeval -objscope ::eval -::xotcl::alias ::xotcl2::Object softeval -nonleaf ::eval -::xotcl::alias ::xotcl2::Object softeval2 ::eval +::next::core::alias ::next::Object objeval -objscope ::eval +::next::core::alias ::next::Object softeval -nonleaf ::eval +::next::core::alias ::next::Object softeval2 ::eval set G 1 @@ -544,9 +544,9 @@ # Test with proc scopes ################################################## Test case proc-scopes -::xotcl::alias ::xotcl2::Object objscoped-eval -objscope ::eval -::xotcl::alias ::xotcl2::Object nonleaf-eval -nonleaf ::eval -::xotcl::alias ::xotcl2::Object plain-eval ::eval +::next::core::alias ::next::Object objscoped-eval -objscope ::eval +::next::core::alias ::next::Object nonleaf-eval -nonleaf ::eval +::next::core::alias ::next::Object plain-eval ::eval proc foo-via-initcmd {} { foreach v {x xxx} {unset -nocomplain ::$v} @@ -642,10 +642,10 @@ Class create M2 C mixin M1 - ? {::xotcl::relation C class-mixin} "::module::M1" + ? {::next::core::relation C class-mixin} "::module::M1" C mixin add M2 - ? {::xotcl::relation C class-mixin} "::module::M2 ::module::M1" + ? {::next::core::relation C class-mixin} "::module::M2 ::module::M1" } Index: tests/xoRDF.test =================================================================== diff -u -rc72f9f638677608fab1502cd696c8f2d6b2952f9 -r81c800c8b9cb42ef6743d9b80ac2be5ca211a69a --- tests/xoRDF.test (.../xoRDF.test) (revision c72f9f638677608fab1502cd696c8f2d6b2952f9) +++ tests/xoRDF.test (.../xoRDF.test) (revision 81c800c8b9cb42ef6743d9b80ac2be5ca211a69a) @@ -1,5 +1,4 @@ -#!../../src/xotclsh -# $Id: xoRDF.test,v 1.5 2007/08/14 16:38:27 neumann Exp $ +# -*- Tcl -*- # package require XOTcl; namespace import -force xotcl::* Index: tests/xocomm.test =================================================================== diff -u -r4ce2a0659cf44b3dbb7262f63fadb3333c968751 -r81c800c8b9cb42ef6743d9b80ac2be5ca211a69a --- tests/xocomm.test (.../xocomm.test) (revision 4ce2a0659cf44b3dbb7262f63fadb3333c968751) +++ tests/xocomm.test (.../xocomm.test) (revision 81c800c8b9cb42ef6743d9b80ac2be5ca211a69a) @@ -1,6 +1,6 @@ -#!../../xotcl-0.9.4/xotclsh -# $Id: xocomm.test,v 1.4 2005/09/09 21:09:01 neumann Exp $ -package require XOTcl; xotcl::use xotcl1 +# -*- Tcl -*- + +package require XOTcl; namespace import ::xotcl::* lappend auto_path [file dirname [info script]]/.. package require xotcl::test Index: unix/tclAppInit.c =================================================================== diff -u -r0b76b5c7d5046151bab89be28b7f2f21e97b27d5 -r81c800c8b9cb42ef6743d9b80ac2be5ca211a69a --- unix/tclAppInit.c (.../tclAppInit.c) (revision 0b76b5c7d5046151bab89be28b7f2f21e97b27d5) +++ unix/tclAppInit.c (.../tclAppInit.c) (revision 81c800c8b9cb42ef6743d9b80ac2be5ca211a69a) @@ -150,13 +150,13 @@ */ #if 0 - if (Xotcl_Init(interp) == TCL_ERROR) { + if (Next_Init(interp) == TCL_ERROR) { return TCL_ERROR; } - Tcl_StaticPackage(interp, "XOTcl", Xotcl_Init, 0); + Tcl_StaticPackage(interp, "next", Next_Init, 0); #else - if (Tcl_PkgRequire(interp, "XOTcl", XOTCLVERSION, 1) == NULL) { + if (Tcl_PkgRequire(interp, "next", XOTCLVERSION, 1) == NULL) { return TCL_ERROR; } #endif