Index: generic/gentclAPI.decls =================================================================== diff -u -rd58e86e7557ee729a2a687854c4107d4b212cf35 -rf9e18344d59553044453d08e464acce46664ffcf --- generic/gentclAPI.decls (.../gentclAPI.decls) (revision d58e86e7557ee729a2a687854c4107d4b212cf35) +++ generic/gentclAPI.decls (.../gentclAPI.decls) (revision f9e18344d59553044453d08e464acce46664ffcf) @@ -54,7 +54,7 @@ xotclCmd is XOTclIsCmd { {-argName "object" -required 1 -type tclobj} {-argName "objectkind" -type "type|object|class|metaclass|mixin"} - {-argName "value" -required 0 -type class} + {-argName "value" -required 0 -type tclobj} } xotclCmd methodproperty XOTclMethodPropertyCmd { {-argName "object" -required 1 -type object} @@ -134,21 +134,6 @@ objectMethod invar XOTclOInvariantsMethod { {-argName "invariantlist" -required 1 -type tclobj} } -objectMethod isclass XOTclOIsClassMethod { - {-argName "class" -type tclobj} -} -objectMethod ismetaclass XOTclOIsMetaClassMethod { - {-argName "metaclass" -type tclobj} -} -objectMethod ismixin XOTclOIsMixinMethod { - {-argName "class" -required 1 -type tclobj} -} -objectMethod isobject XOTclOIsObjectMethod { - {-argName "object" -required 1 -type tclobj} -} -objectMethod istype XOTclOIsTypeMethod { - {-argName "class" -required 1 -type tclobj} -} objectMethod mixinguard XOTclOMixinGuardMethod { {-argName "mixin" -required 1} {-argName "guard" -required 1 -type tclobj} Index: generic/predefined.h =================================================================== diff -u -r16696cd93d38760506be3dfc95fb2bb7ae972d2f -rf9e18344d59553044453d08e464acce46664ffcf --- generic/predefined.h (.../predefined.h) (revision 16696cd93d38760506be3dfc95fb2bb7ae972d2f) +++ generic/predefined.h (.../predefined.h) (revision f9e18344d59553044453d08e464acce46664ffcf) @@ -59,7 +59,7 @@ "::xotcl::classInfo proc unknown {method args} {\n" "error \"unknown info option \\\"$method\\\"; [my info info]\"}\n" "# info instargs\n" -"# istype??\n" +"# istype\n" "proc ::xotcl::info_args {inst o method} {\n" "set result [list]\n" "foreach \\\n" @@ -95,6 +95,11 @@ "::xotcl::classInfo proc instdefault {o method arg var} {::xotcl::info_default inst $o $method $arg $var}\n" "::xotcl::classInfo proc default {o method arg var} {::xotcl::info_default \"\" $o $method $arg $var}\n" "::xotcl::objectInfo proc default {o method arg var} {::xotcl::info_default \"\" $o $method $arg $var}\n" +"::xotcl::Object instproc isobject {{object:substdefault \"[self]\"}} {::xotcl::is $object object}\n" +"::xotcl::Object instproc isclass {{class:substdefault \"[self]\"}} {::xotcl::is $class class}\n" +"::xotcl::Object instproc ismetaclass {{class:substdefault \"[self]\"}} {::xotcl::is $class metaclass}\n" +"::xotcl::Object instproc ismixin {class} {::xotcl::is [self] mixin $class}\n" +"::xotcl::Object instproc istype {class} {::xotcl::is [self] type $class}\n" "::xotcl::Object create ::xotcl::@\n" "::xotcl::@ proc unknown args {}\n" "proc ::xotcl::myproc {args} {linsert $args 0 [::xotcl::self]}\n" @@ -213,10 +218,10 @@ "set value ::$value}\n" "return [$obj $prop [lsearch -all -not -glob -inline $old $value]]} elseif {[my elementtype] ne \"\"} {\n" "if {[string first :: $value] == -1} {\n" -"if {![my isobject $value]} {\n" +"if {![::xotcl::is $value object]} {\n" "error \"$value does not appear to be an object\"}\n" "set value [$value self]}\n" -"if {![$value isclass [my elementtype]]} {\n" +"if {![::xotcl::is [my elementtype] class]} {\n" "error \"$value does not appear to be of type [my elementtype]\"}}\n" "set p [lsearch -exact $old $value]\n" "if {$p > -1} {\n" @@ -276,9 +281,9 @@ "set __initcmd \"\"\n" "if {[::xotcl::my exists type]} {\n" "::xotcl::my instvar type name\n" -"if {[::xotcl::Object isclass $type]} {\n" +"if {[::xotcl::is $type class]} {\n" "set predicate [subst -nocommands {\n" -"[::xotcl::Object isobject \\$value] && [\\$value istype $type]}]} elseif {[llength $type]>1} {\n" +"[::xotcl::is \\$value object] && [::xotcl::is \\$value type $type]}]} elseif {[llength $type]>1} {\n" "set predicate \"\\[$type \\$value\\]\"} else {\n" "set predicate \"\\[[self] type=$type $name \\$value\\]\"}\n" "::xotcl::my append valuechangedcmd [subst {\n" @@ -324,7 +329,7 @@ "::xotcl::ScopedNew instproc init {} {\n" "::xotcl::my instproc new {-childof args} {\n" "[::xotcl::self class] instvar {inobject object} withclass\n" -"if {![::xotcl::my isobject $object]} {\n" +"if {![::xotcl::is $object object]} {\n" "$withclass create $object}\n" "eval ::xotcl::next -childof $object $args}}\n" "::xotcl::Object instproc contains {\n" @@ -333,7 +338,7 @@ "{-class ::xotcl::Object}\n" "cmds} {\n" "if {![info exists object]} {set object [::xotcl::self]}\n" -"if {![::xotcl::my isobject $object]} {$class create $object}\n" +"if {![::xotcl::is $object object]} {$class create $object}\n" "$object requireNamespace\n" "if {$withnew} {\n" "set m [::xotcl::ScopedNew new \\\n" @@ -399,8 +404,8 @@ "::xotcl::Object instproc defaultmethod {} {\n" "return [::xotcl::self]}\n" "::xotcl::Object instproc hasclass cl {\n" -"if {[::xotcl::my ismixin $cl]} {return 1}\n" -"::xotcl::my istype $cl}\n" +"if {[::xotcl::is [self] mixin $cl]} {return 1}\n" +"::xotcl::is [self] type $cl}\n" "::xotcl::Class instproc allinstances {} {\n" "return [::xotcl::my info instances -closure]}\n" "::xotcl::Object proc unsetExitHandler {} {\n" @@ -427,12 +432,12 @@ "objLength}\n" "::xotcl::Object::CopyHandler instproc makeTargetList t {\n" "::xotcl::my lappend targetList $t\n" -"if {[::xotcl::my isobject $t]} {\n" +"if {[::xotcl::is $t object]} {\n" "if {[$t info hasnamespace]} {\n" "set children [$t info children]} else {\n" "return}}\n" "foreach c [namespace children $t] {\n" -"if {![::xotcl::my isobject $c]} {\n" +"if {![::xotcl::is $c object]} {\n" "lappend children [namespace children $t]}}\n" "foreach c $children {\n" "::xotcl::my makeTargetList $c}}\n" @@ -445,8 +450,8 @@ "::xotcl::Object::CopyHandler instproc copyTargets {} {\n" "foreach origin [::xotcl::my set targetList] {\n" "set dest [::xotcl::my getDest $origin]\n" -"if {[::xotcl::my isobject $origin]} {\n" -"if {[::xotcl::my isclass $origin]} {\n" +"if {[::xotcl::is $origin object]} {\n" +"if {[::xotcl::is $origin class]} {\n" "set cl [[$origin info class] create $dest -noinit]\n" "set obj $cl\n" "$cl superclass [$origin info superclass]\n" @@ -465,7 +470,7 @@ "::xotcl::my copyNSVarsAndCmds $origin $dest\n" "foreach i [$origin info forward] {\n" "eval [concat $dest forward $i [$origin info forward -definition $i]]}\n" -"if {[::xotcl::my isclass $origin]} {\n" +"if {[::xotcl::is $origin class]} {\n" "foreach i [$origin info instforward] {\n" "eval [concat $dest instforward $i [$origin info instforward -definition $i]]}}\n" "set traces [list]\n" @@ -478,7 +483,7 @@ "set def [concat $dest [lrange $def 1 end]]}\n" "$dest trace add variable $var $op $def}}}}\n" "foreach origin [::xotcl::my set targetList] {\n" -"if {[::xotcl::my isclass $origin]} {\n" +"if {[::xotcl::is $origin class]} {\n" "set dest [::xotcl::my getDest $origin]\n" "foreach oldslot [$origin info slots] {\n" "set newslot ${dest}::slot::[namespace tail $oldslot]\n" @@ -496,7 +501,7 @@ "if {[string trimleft $newName :] ne [string trimleft [::xotcl::self] :]} {\n" "if {$newName ne \"\"} {\n" "::xotcl::my copy $newName}\n" -"if {[::xotcl::my isclass [::xotcl::self]] && $newName ne \"\"} {\n" +"if {[::xotcl::is [::xotcl::self] class] && $newName ne \"\"} {\n" "foreach subclass [::xotcl::my info subclass] {\n" "set scl [$subclass info superclass]\n" "if {[set index [lsearch -exact $scl [::xotcl::self]]] != -1} {\n" Index: generic/predefined.xotcl =================================================================== diff -u -rd58e86e7557ee729a2a687854c4107d4b212cf35 -rf9e18344d59553044453d08e464acce46664ffcf --- generic/predefined.xotcl (.../predefined.xotcl) (revision d58e86e7557ee729a2a687854c4107d4b212cf35) +++ generic/predefined.xotcl (.../predefined.xotcl) (revision f9e18344d59553044453d08e464acce46664ffcf) @@ -155,12 +155,12 @@ # # already emulated: # - # => info params + # => info params .... replaces # info args # info nonposargs # info default # - # => info instparams + # => info instparams .... replaces # info instargs # info instnonposargs # info instdefault @@ -172,12 +172,12 @@ # # TODO: not yet emulated: # - # => info is + # => info is (bzw. ::xotcl::is) replaces # isobject # isclass # ismetaclass # ismixin - # istype?? + # istype # # => method (should get pre- and postconditions via positional params) # proc @@ -240,6 +240,13 @@ ::xotcl::classInfo proc default {o method arg var} {::xotcl::info_default "" $o $method $arg $var} ::xotcl::objectInfo proc default {o method arg var} {::xotcl::info_default "" $o $method $arg $var} + # emulation of isobject, ... + ::xotcl::Object instproc isobject {{object:substdefault "[self]"}} {::xotcl::is $object object} + ::xotcl::Object instproc isclass {{class:substdefault "[self]"}} {::xotcl::is $class class} + ::xotcl::Object instproc ismetaclass {{class:substdefault "[self]"}} {::xotcl::is $class metaclass} + ::xotcl::Object instproc ismixin {class} {::xotcl::is [self] mixin $class} + ::xotcl::Object instproc istype {class} {::xotcl::is [self] type $class} + # documentation stub object -> just ignore per default. # if xoDoc is loaded, documentation will be activated ::xotcl::Object create ::xotcl::@ @@ -467,12 +474,12 @@ return [$obj $prop [lsearch -all -not -glob -inline $old $value]] } elseif {[my elementtype] ne ""} { if {[string first :: $value] == -1} { - if {![my isobject $value]} { + if {![::xotcl::is $value object]} { error "$value does not appear to be an object" } set value [$value self] } - if {![$value isclass [my elementtype]]} { + if {![::xotcl::is [my elementtype] class]} { error "$value does not appear to be of type [my elementtype]" } } @@ -581,9 +588,9 @@ set __initcmd "" if {[::xotcl::my exists type]} { ::xotcl::my instvar type name - if {[::xotcl::Object isclass $type]} { + if {[::xotcl::is $type class]} { set predicate [subst -nocommands { - [::xotcl::Object isobject \$value] && [\$value istype $type] + [::xotcl::is \$value object] && [::xotcl::is \$value type $type] }] } elseif {[llength $type]>1} { set predicate "\[$type \$value\]" @@ -663,7 +670,7 @@ ::xotcl::ScopedNew instproc init {} { ::xotcl::my instproc new {-childof args} { [::xotcl::self class] instvar {inobject object} withclass - if {![::xotcl::my isobject $object]} { + if {![::xotcl::is $object object]} { $withclass create $object } eval ::xotcl::next -childof $object $args @@ -681,7 +688,7 @@ {-class ::xotcl::Object} cmds} { if {![info exists object]} {set object [::xotcl::self]} - if {![::xotcl::my isobject $object]} {$class create $object} + if {![::xotcl::is $object object]} {$class create $object} $object requireNamespace if {$withnew} { set m [::xotcl::ScopedNew new \ @@ -788,8 +795,8 @@ # support for XOTcl specific convenience routines ::xotcl::Object instproc hasclass cl { - if {[::xotcl::my ismixin $cl]} {return 1} - ::xotcl::my istype $cl + if {[::xotcl::is [self] mixin $cl]} {return 1} + ::xotcl::is [self] type $cl } ::xotcl::Class instproc allinstances {} { # TODO: mark it deprecated @@ -840,7 +847,7 @@ ::xotcl::Object::CopyHandler instproc makeTargetList t { ::xotcl::my lappend targetList $t # if it is an object without namespace, it is a leaf - if {[::xotcl::my isobject $t]} { + if {[::xotcl::is $t object]} { if {[$t info hasnamespace]} { # make target list from all children set children [$t info children] @@ -852,7 +859,7 @@ # now append all namespaces that are in the obj, but that # are not objects foreach c [namespace children $t] { - if {![::xotcl::my isobject $c]} { + if {![::xotcl::is $c object]} { lappend children [namespace children $t] } } @@ -879,9 +886,9 @@ #puts stderr "COPY will copy targetList = [::xotcl::my set targetList]" foreach origin [::xotcl::my set targetList] { set dest [::xotcl::my getDest $origin] - if {[::xotcl::my isobject $origin]} { + if {[::xotcl::is $origin object]} { # copy class information - if {[::xotcl::my isclass $origin]} { + if {[::xotcl::is $origin class]} { set cl [[$origin info class] create $dest -noinit] # class object set obj $cl @@ -909,7 +916,7 @@ foreach i [$origin info forward] { eval [concat $dest forward $i [$origin info forward -definition $i]] } - if {[::xotcl::my isclass $origin]} { + if {[::xotcl::is $origin class]} { foreach i [$origin info instforward] { eval [concat $dest instforward $i [$origin info instforward -definition $i]] } @@ -932,7 +939,7 @@ } # alter 'domain' and 'manager' in slot objects for classes foreach origin [::xotcl::my set targetList] { - if {[::xotcl::my isclass $origin]} { + if {[::xotcl::is $origin class]} { set dest [::xotcl::my getDest $origin] foreach oldslot [$origin info slots] { set newslot ${dest}::slot::[namespace tail $oldslot] @@ -967,7 +974,7 @@ ::xotcl::my copy $newName } ### let all subclasses get the copied class as superclass - if {[::xotcl::my isclass [::xotcl::self]] && $newName ne ""} { + if {[::xotcl::is [::xotcl::self] class] && $newName ne ""} { foreach subclass [::xotcl::my info subclass] { set scl [$subclass info superclass] if {[set index [lsearch -exact $scl [::xotcl::self]]] != -1} { Index: generic/tclAPI.h =================================================================== diff -u -rd58e86e7557ee729a2a687854c4107d4b212cf35 -rf9e18344d59553044453d08e464acce46664ffcf --- generic/tclAPI.h (.../tclAPI.h) (revision d58e86e7557ee729a2a687854c4107d4b212cf35) +++ generic/tclAPI.h (.../tclAPI.h) (revision f9e18344d59553044453d08e464acce46664ffcf) @@ -118,11 +118,6 @@ static int XOTclOForwardMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclOInstVarMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclOInvariantsMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); -static int XOTclOIsClassMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); -static int XOTclOIsMetaClassMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); -static int XOTclOIsMixinMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); -static int XOTclOIsObjectMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); -static int XOTclOIsTypeMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclOMixinGuardMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclONextMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclONoinitMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); @@ -223,11 +218,6 @@ static int XOTclOForwardMethod(Tcl_Interp *interp, XOTclObject *obj, Tcl_Obj *method, Tcl_Obj *withDefault, int withEarlybinding, Tcl_Obj *withMethodprefix, int withObjscope, Tcl_Obj *withOnerror, int withVerbose, Tcl_Obj *target, int nobjc, Tcl_Obj *CONST nobjv[]); static int XOTclOInstVarMethod(Tcl_Interp *interp, XOTclObject *obj, int objc, Tcl_Obj *CONST objv[]); static int XOTclOInvariantsMethod(Tcl_Interp *interp, XOTclObject *obj, Tcl_Obj *invariantlist); -static int XOTclOIsClassMethod(Tcl_Interp *interp, XOTclObject *obj, Tcl_Obj *class); -static int XOTclOIsMetaClassMethod(Tcl_Interp *interp, XOTclObject *obj, Tcl_Obj *metaclass); -static int XOTclOIsMixinMethod(Tcl_Interp *interp, XOTclObject *obj, Tcl_Obj *class); -static int XOTclOIsObjectMethod(Tcl_Interp *interp, XOTclObject *obj, Tcl_Obj *object); -static int XOTclOIsTypeMethod(Tcl_Interp *interp, XOTclObject *obj, Tcl_Obj *class); static int XOTclOMixinGuardMethod(Tcl_Interp *interp, XOTclObject *obj, char *mixin, Tcl_Obj *guard); static int XOTclONextMethod(Tcl_Interp *interp, XOTclObject *obj, int objc, Tcl_Obj *CONST objv[]); static int XOTclONoinitMethod(Tcl_Interp *interp, XOTclObject *obj); @@ -249,7 +239,7 @@ static int XOTclFinalizeObjCmd(Tcl_Interp *interp); static int XOTclInstvarCmd(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); static int XOTclInterpObjCmd(Tcl_Interp *interp, char *name, int objc, Tcl_Obj *CONST objv[]); -static int XOTclIsCmd(Tcl_Interp *interp, Tcl_Obj *object, int objectkind, XOTclClass *value); +static int XOTclIsCmd(Tcl_Interp *interp, Tcl_Obj *object, int objectkind, Tcl_Obj *value); static int XOTclMethodPropertyCmd(Tcl_Interp *interp, XOTclObject *object, char *methodName, int withPer_object, int methodproperty, Tcl_Obj *value); static int XOTclMyCmd(Tcl_Interp *interp, int withLocal, Tcl_Obj *method, int nobjc, Tcl_Obj *CONST nobjv[]); static int XOTclNSCopyCmds(Tcl_Interp *interp, Tcl_Obj *fromNs, Tcl_Obj *toNs); @@ -329,11 +319,6 @@ XOTclOForwardMethodIdx, XOTclOInstVarMethodIdx, XOTclOInvariantsMethodIdx, - XOTclOIsClassMethodIdx, - XOTclOIsMetaClassMethodIdx, - XOTclOIsMixinMethodIdx, - XOTclOIsObjectMethodIdx, - XOTclOIsTypeMethodIdx, XOTclOMixinGuardMethodIdx, XOTclONextMethodIdx, XOTclONoinitMethodIdx, @@ -1803,101 +1788,6 @@ } static int -XOTclOIsClassMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { - parseContext pc; - XOTclObject *obj = (XOTclObject *)clientData; - if (!obj) return XOTclObjErrType(interp, objv[0], "Object"); - if (ArgumentParse(interp, objc, objv, obj, objv[0], - method_definitions[XOTclOIsClassMethodIdx].paramDefs, - method_definitions[XOTclOIsClassMethodIdx].nrParameters, - &pc) != TCL_OK) { - return TCL_ERROR; - } else { - Tcl_Obj *class = (Tcl_Obj *)pc.clientData[0]; - - parseContextRelease(&pc); - return XOTclOIsClassMethod(interp, obj, class); - - } -} - -static int -XOTclOIsMetaClassMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { - parseContext pc; - XOTclObject *obj = (XOTclObject *)clientData; - if (!obj) return XOTclObjErrType(interp, objv[0], "Object"); - if (ArgumentParse(interp, objc, objv, obj, objv[0], - method_definitions[XOTclOIsMetaClassMethodIdx].paramDefs, - method_definitions[XOTclOIsMetaClassMethodIdx].nrParameters, - &pc) != TCL_OK) { - return TCL_ERROR; - } else { - Tcl_Obj *metaclass = (Tcl_Obj *)pc.clientData[0]; - - parseContextRelease(&pc); - return XOTclOIsMetaClassMethod(interp, obj, metaclass); - - } -} - -static int -XOTclOIsMixinMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { - parseContext pc; - XOTclObject *obj = (XOTclObject *)clientData; - if (!obj) return XOTclObjErrType(interp, objv[0], "Object"); - if (ArgumentParse(interp, objc, objv, obj, objv[0], - method_definitions[XOTclOIsMixinMethodIdx].paramDefs, - method_definitions[XOTclOIsMixinMethodIdx].nrParameters, - &pc) != TCL_OK) { - return TCL_ERROR; - } else { - Tcl_Obj *class = (Tcl_Obj *)pc.clientData[0]; - - parseContextRelease(&pc); - return XOTclOIsMixinMethod(interp, obj, class); - - } -} - -static int -XOTclOIsObjectMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { - parseContext pc; - XOTclObject *obj = (XOTclObject *)clientData; - if (!obj) return XOTclObjErrType(interp, objv[0], "Object"); - if (ArgumentParse(interp, objc, objv, obj, objv[0], - method_definitions[XOTclOIsObjectMethodIdx].paramDefs, - method_definitions[XOTclOIsObjectMethodIdx].nrParameters, - &pc) != TCL_OK) { - return TCL_ERROR; - } else { - Tcl_Obj *object = (Tcl_Obj *)pc.clientData[0]; - - parseContextRelease(&pc); - return XOTclOIsObjectMethod(interp, obj, object); - - } -} - -static int -XOTclOIsTypeMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { - parseContext pc; - XOTclObject *obj = (XOTclObject *)clientData; - if (!obj) return XOTclObjErrType(interp, objv[0], "Object"); - if (ArgumentParse(interp, objc, objv, obj, objv[0], - method_definitions[XOTclOIsTypeMethodIdx].paramDefs, - method_definitions[XOTclOIsTypeMethodIdx].nrParameters, - &pc) != TCL_OK) { - return TCL_ERROR; - } else { - Tcl_Obj *class = (Tcl_Obj *)pc.clientData[0]; - - parseContextRelease(&pc); - return XOTclOIsTypeMethod(interp, obj, class); - - } -} - -static int XOTclOMixinGuardMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; XOTclObject *obj = (XOTclObject *)clientData; @@ -2271,7 +2161,7 @@ } else { Tcl_Obj *object = (Tcl_Obj *)pc.clientData[0]; int objectkind = (int )pc.clientData[1]; - XOTclClass *value = (XOTclClass *)pc.clientData[2]; + Tcl_Obj *value = (Tcl_Obj *)pc.clientData[2]; parseContextRelease(&pc); return XOTclIsCmd(interp, object, objectkind, value); @@ -2718,21 +2608,6 @@ {"::xotcl::cmd::Object::invar", XOTclOInvariantsMethodStub, 1, { {"invariantlist", 1, 0, convertToTclobj}} }, -{"::xotcl::cmd::Object::isclass", XOTclOIsClassMethodStub, 1, { - {"class", 0, 0, convertToTclobj}} -}, -{"::xotcl::cmd::Object::ismetaclass", XOTclOIsMetaClassMethodStub, 1, { - {"metaclass", 0, 0, convertToTclobj}} -}, -{"::xotcl::cmd::Object::ismixin", XOTclOIsMixinMethodStub, 1, { - {"class", 1, 0, convertToTclobj}} -}, -{"::xotcl::cmd::Object::isobject", XOTclOIsObjectMethodStub, 1, { - {"object", 1, 0, convertToTclobj}} -}, -{"::xotcl::cmd::Object::istype", XOTclOIsTypeMethodStub, 1, { - {"class", 1, 0, convertToTclobj}} -}, {"::xotcl::cmd::Object::mixinguard", XOTclOMixinGuardMethodStub, 2, { {"mixin", 1, 0, convertToString}, {"guard", 1, 0, convertToTclobj}} @@ -2817,7 +2692,7 @@ {"::xotcl::is", XOTclIsCmdStub, 3, { {"object", 1, 0, convertToTclobj}, {"type|object|class|metaclass|mixin", 0, 0, convertToObjectkind}, - {"value", 0, 0, convertToClass}} + {"value", 0, 0, convertToTclobj}} }, {"::xotcl::methodproperty", XOTclMethodPropertyCmdStub, 5, { {"object", 1, 0, convertToObject}, Index: generic/xotcl.c =================================================================== diff -u -rd58e86e7557ee729a2a687854c4107d4b212cf35 -rf9e18344d59553044453d08e464acce46664ffcf --- generic/xotcl.c (.../xotcl.c) (revision d58e86e7557ee729a2a687854c4107d4b212cf35) +++ generic/xotcl.c (.../xotcl.c) (revision f9e18344d59553044453d08e464acce46664ffcf) @@ -9699,36 +9699,41 @@ } -static int XOTclIsCmd(Tcl_Interp *interp, Tcl_Obj *object, int objectkind, XOTclClass *value) { +static int XOTclIsCmd(Tcl_Interp *interp, Tcl_Obj *object, int objectkind, Tcl_Obj *value) { int success = TCL_ERROR; XOTclObject *obj; + XOTclClass *cl; switch (objectkind) { case objectkindTypeIdx: - if (value == NULL) return XOTclObjErrArgCnt(interp, NULL, NULL, "type "); - success = (GetObjectFromObj(interp, object, &obj) == TCL_OK) && isSubType(obj->cl, value); + if (value == NULL) return XOTclObjErrArgCnt(interp, NULL, NULL, " type "); + success = (GetObjectFromObj(interp, object, &obj) == TCL_OK) + && (GetClassFromObj(interp, value, &cl, 0) == TCL_OK) + && isSubType(obj->cl, cl); break; case objectkindObjectIdx: - if (value != NULL) return XOTclObjErrArgCnt(interp, NULL, NULL, "object "); + if (value != NULL) return XOTclObjErrArgCnt(interp, NULL, NULL, " object"); success = (GetObjectFromObj(interp, object, &obj) == TCL_OK); break; case objectkindClassIdx: - if (value != NULL) return XOTclObjErrArgCnt(interp, NULL, NULL, "class "); + if (value != NULL) return XOTclObjErrArgCnt(interp, NULL, NULL, " class"); success = (GetObjectFromObj(interp, object, &obj) == TCL_OK) && XOTclObjectIsClass(obj); break; case objectkindMetaclassIdx: - if (value != NULL) return XOTclObjErrArgCnt(interp, NULL, NULL, "metaclass "); + if (value != NULL) return XOTclObjErrArgCnt(interp, NULL, NULL, " metaclass"); success = (GetObjectFromObj(interp, object, &obj) == TCL_OK) - && XOTclObjectIsClass(obj) && IsMetaClass(interp, (XOTclClass*)obj, 1); + && XOTclObjectIsClass(obj) + && IsMetaClass(interp, (XOTclClass*)obj, 1); break; case objectkindMixinIdx: - if (value == NULL) return XOTclObjErrArgCnt(interp, NULL, NULL, "mixin "); - success = (GetObjectFromObj(interp, object, &obj) == TCL_OK) && - (hasMixin(interp, obj, value) == TCL_OK); + if (value == NULL) return XOTclObjErrArgCnt(interp, NULL, NULL, " mixin "); + success = (GetObjectFromObj(interp, object, &obj) == TCL_OK) + && (GetClassFromObj(interp, value, &cl, 0) == TCL_OK) + && hasMixin(interp, obj, cl); break; } @@ -10836,12 +10841,6 @@ return TCL_OK; } -static int XOTclOIsObjectMethod(Tcl_Interp *interp, XOTclObject *obj, Tcl_Obj *object) { - XOTclObject *o; - Tcl_SetIntObj(Tcl_GetObjResult(interp), (GetObjectFromObj(interp, object, &o) == TCL_OK)); - return TCL_OK; -} - static int XOTclOIsTypeMethod(Tcl_Interp *interp, XOTclObject *obj, Tcl_Obj *class) { XOTclClass *cl; int success = 0; Index: tests/testx.xotcl =================================================================== diff -u -rd3d3eb10074ac56bbc77650c1bdd4239f0d97ca8 -rf9e18344d59553044453d08e464acce46664ffcf --- tests/testx.xotcl (.../testx.xotcl) (revision d3d3eb10074ac56bbc77650c1bdd4239f0d97ca8) +++ tests/testx.xotcl (.../testx.xotcl) (revision f9e18344d59553044453d08e464acce46664ffcf) @@ -3062,14 +3062,14 @@ ::errorCheck [lsort [b info methods]] "__next abstract append array autoname check class cleanup configure contains copy defaultmethod destroy eval exists extractConfigureArg f filter filterguard filtersearch forward hasclass incr info init instvar invar isclass ismetaclass ismixin isobject istype lappend method mixin mixinguard move myProc myProc2 myProcMix1 myProcMix2 noinit objectparameter objproc parametercmd proc procsearch requireNamespace self set setFilter setvalues signature subst trace unset uplevel upvar volatile vwait" "b info methods" - ::errorCheck [lsort [b info methods -nocmds]] "abstract contains copy defaultmethod extractConfigureArg f hasclass init method move myProc myProc2 myProcMix1 myProcMix2 objectparameter objproc self setFilter signature" "b info methods -nocmds" + ::errorCheck [lsort [b info methods -nocmds]] "abstract contains copy defaultmethod extractConfigureArg f hasclass init isclass ismetaclass ismixin isobject istype method move myProc myProc2 myProcMix1 myProcMix2 objectparameter objproc self setFilter signature" "b info methods -nocmds" - ::errorCheck [lsort [b info methods -noprocs]] "__next append array autoname check class cleanup configure destroy eval exists filter filterguard filtersearch forward incr info instvar invar isclass ismetaclass ismixin isobject istype lappend mixin mixinguard noinit parametercmd proc procsearch requireNamespace set setvalues subst trace unset uplevel upvar volatile vwait" "b info methods -noprocs" - ::errorCheck [lsort [b info methods -nocmds -nomixins]] "abstract contains copy defaultmethod extractConfigureArg f hasclass init method move myProc myProc2 objectparameter objproc self setFilter signature" "b info methods -nocmds -nomixins" + ::errorCheck [lsort [b info methods -noprocs]] "__next append array autoname check class cleanup configure destroy eval exists filter filterguard filtersearch forward incr info instvar invar lappend mixin mixinguard noinit parametercmd proc procsearch requireNamespace set setvalues subst trace unset uplevel upvar volatile vwait" "b info methods -noprocs" + ::errorCheck [lsort [b info methods -nocmds -nomixins]] "abstract contains copy defaultmethod extractConfigureArg f hasclass init isclass ismetaclass ismixin isobject istype method move myProc myProc2 objectparameter objproc self setFilter signature" "b info methods -nocmds -nomixins" ::errorCheck [b info methods -nocmds -noprocs] "" "b info methods -nocmds -noprocs" - ::errorCheck [lsort [B info methods -nocmds]] "abstract allinstances contains copy defaultmethod extractConfigureArg f hasclass init method move objectparameter parameter self setFilter signature uses" "B info methods -nocmds" + ::errorCheck [lsort [B info methods -nocmds]] "abstract allinstances contains copy defaultmethod extractConfigureArg f hasclass init isclass ismetaclass ismixin isobject istype method move objectparameter parameter self setFilter signature uses" "B info methods -nocmds" namespace eval a { proc o args {return o}