Index: generic/predefined.h =================================================================== diff -u -rcfee325944ac90fe94485cba109a7e99465073b5 -r147831f1098cb9b96a28d4d5b0f9f3ccea35b9da --- generic/predefined.h (.../predefined.h) (revision cfee325944ac90fe94485cba109a7e99465073b5) +++ generic/predefined.h (.../predefined.h) (revision 147831f1098cb9b96a28d4d5b0f9f3ccea35b9da) @@ -442,10 +442,10 @@ "proc createBootstrapAttributeSlots {} {}}\n" "::xotcl2::Class create ::xotcl::ScopedNew -superclass ::xotcl2::Class -parameter {\n" "{withclass ::xotcl2::Object}\n" -"inobject}\n" +"container}\n" "::xotcl::ScopedNew protected method init {} {\n" ":public method new {-childof args} {\n" -"::xotcl::importvar [::xotcl::self class] {inobject object} withclass\n" +"::xotcl::importvar [::xotcl::self class] {container object} withclass\n" "if {![::xotcl::is $object object]} {\n" "$withclass create $object}\n" "eval ::xotcl::next -childof $object $args}}\n" @@ -458,11 +458,13 @@ "if {![::xotcl::is $object object]} {$class create $object}\n" "$object requireNamespace\n" "if {$withnew} {\n" -"set m [::xotcl::ScopedNew new \\\n" -"-inobject $object -withclass $class -volatile]\n" +"set m [::xotcl::ScopedNew new -volatile \\\n" +"-container $object -withclass $class]\n" "::xotcl2::Class mixin add $m end\n" +"if {[::xotcl::is ::xotcl::Class class]} {::xotcl::Class instmixin add $m end}\n" "namespace eval $object $cmds\n" -"::xotcl2::Class mixin delete $m} else {\n" +"::xotcl2::Class mixin delete $m\n" +"if {[::xotcl::is ::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::self] -objscope ::subst [::xotcl::self]::slot}\n" Index: generic/predefined.xotcl =================================================================== diff -u -rcfee325944ac90fe94485cba109a7e99465073b5 -r147831f1098cb9b96a28d4d5b0f9f3ccea35b9da --- generic/predefined.xotcl (.../predefined.xotcl) (revision cfee325944ac90fe94485cba109a7e99465073b5) +++ generic/predefined.xotcl (.../predefined.xotcl) (revision 147831f1098cb9b96a28d4d5b0f9f3ccea35b9da) @@ -847,18 +847,18 @@ proc createBootstrapAttributeSlots {} {} } -# Create a mixin class to overload method "new", such it does not allocate -# new objects in ::xotcl::*, but in the specified object (without -# syntactic overhead). +# Create a mixin class to overload method "new" such it does not +# allocate new objects in ::xotcl::*, but in the specified object +# (without syntactic overhead). # ::xotcl2::Class create ::xotcl::ScopedNew -superclass ::xotcl2::Class -parameter { {withclass ::xotcl2::Object} - inobject + container } ::xotcl::ScopedNew protected method init {} { :public method new {-childof args} { - ::xotcl::importvar [::xotcl::self class] {inobject object} withclass - if {![::xotcl::is $object object]} { + ::xotcl::importvar [::xotcl::self class] {container object} withclass + if {![::xotcl::is $object object]} { $withclass create $object } eval ::xotcl::next -childof $object $args @@ -880,11 +880,14 @@ if {![::xotcl::is $object object]} {$class create $object} $object requireNamespace if {$withnew} { - set m [::xotcl::ScopedNew new \ - -inobject $object -withclass $class -volatile] + set m [::xotcl::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::is ::xotcl::Class class]} {::xotcl::Class instmixin add $m end} namespace eval $object $cmds ::xotcl2::Class mixin delete $m + if {[::xotcl::is ::xotcl::Class class]} {::xotcl::Class instmixin delete $m} } else { namespace eval $object $cmds } Index: generic/xotcl.c =================================================================== diff -u -r16664bdf30d1848e76699ac1859e97b6a427bdcb -r147831f1098cb9b96a28d4d5b0f9f3ccea35b9da --- generic/xotcl.c (.../xotcl.c) (revision 16664bdf30d1848e76699ac1859e97b6a427bdcb) +++ generic/xotcl.c (.../xotcl.c) (revision 147831f1098cb9b96a28d4d5b0f9f3ccea35b9da) @@ -8594,6 +8594,7 @@ ": can't find variable on ", objectName(object), (char *) NULL); } + /* * if newName == NULL -> there is no alias, use varName * as target link name @@ -8636,6 +8637,7 @@ } varPtr = VarHashCreateVar(tablePtr, newName, &new); } + /* * if we define an alias (newName != varName), be sure that * the target does not exist already @@ -8658,7 +8660,7 @@ /* We have already a variable with the same name imported from a different object. Get rid of this old variable - */ + */ VarHashRefCount(linkPtr)--; if (TclIsVarUndefined(linkPtr)) { CleanupVar(linkPtr, (Var *) NULL); @@ -8687,14 +8689,17 @@ #endif VarHashRefCount(otherPtr)++; - /* - { - Var85 *p = (Var85 *)varPtr; - fprintf(stderr, "defining an alias var='%s' in obj %s fwd %d flags %x isLink %d isTraced %d isUndefined %d\n", - ObjStr(newName), objectName(obj), forwardCompatibleMode, - varFlags(varPtr), - TclIsVarLink(varPtr), TclIsVarTraced(varPtr), TclIsVarUndefined(varPtr)); - } + + /* fprintf(stderr, "defining an alias var='%s' in obj %s fwd %d flags %x isLink %d isTraced %d isUndefined %d\n", + ObjStr(newName), objectName(object), +#if FORWARD_COMPATIBLE + forwardCompatibleMode, + varFlags(varPtr), +#else + 0, + varPtr->flags, +#endif + TclIsVarLink(varPtr), TclIsVarTraced(varPtr), TclIsVarUndefined(varPtr)); */ } return TCL_OK; @@ -11257,7 +11262,7 @@ XOTclImportvarCmd(Tcl_Interp *interp, XOTclObject *object, int objc, Tcl_Obj *CONST objv[]) { int i, result = TCL_OK; - for (i=1; i 99} { - error "$value is not in the range of 0 .. 99" + Attribute create foo -default 1 { + :method assign { domain var value} { + if {$value < 0 || $value > 99} { + error "$value is not in the range of 0 .. 99" + } + $domain set $var $value } - $domain set $var $value } }