Index: generic/gentclAPI.decls =================================================================== diff -u -rb1f416527fc1e567ff1db9ad5a720b3bbc5678ee -r29267f0c9db8387f58b03ffc124fc138ad88e463 --- generic/gentclAPI.decls (.../gentclAPI.decls) (revision b1f416527fc1e567ff1db9ad5a720b3bbc5678ee) +++ generic/gentclAPI.decls (.../gentclAPI.decls) (revision 29267f0c9db8387f58b03ffc124fc138ad88e463) @@ -87,8 +87,10 @@ {-argName "value" -required 0 -type tclobj} } xotclCmd is2 XOTclIs2Cmd { - {-argName "constraint" -required 1 -type tclobj} {-argName "value" -required 1 -type tclobj} + {-argName "constraint" -required 1 -type tclobj} + {-argName "-hasmixin" -required 0 -nrargs 1 -type tclobj} + {-argName "-type" -required 0 -nrargs 1 -type tclobj} {-argName "arg" -required 0 -type tclobj} } xotclCmd method XOTclMethodCmd { @@ -379,16 +381,12 @@ {-argName "class" -required 1 -type class} {-argName "mixin" -required 1} } -infoClassMethod class-mixin-of XOTclClassInfoClassMixinOfMethod { +infoClassMethod mixinof XOTclClassInfoMixinOfMethod { {-argName "class" -required 1 -type class} {-argName "-closure"} + {-argName "-scope" -required 0 -nrargs 1 -type "all|class|object"} {-argName "pattern" -type objpattern} } -infoClassMethod object-mixin-of XOTclClassInfoObjectMixinOfMethod { - {-argName "class" -required 1 -type class} - {-argName "-closure"} - {-argName "pattern" -type objpattern} -} infoClassMethod parameter XOTclClassInfoParameterMethod { {-argName "class" -required 1 -type class} } Index: generic/predefined.h =================================================================== diff -u -rb1f416527fc1e567ff1db9ad5a720b3bbc5678ee -r29267f0c9db8387f58b03ffc124fc138ad88e463 --- generic/predefined.h (.../predefined.h) (revision b1f416527fc1e567ff1db9ad5a720b3bbc5678ee) +++ generic/predefined.h (.../predefined.h) (revision 29267f0c9db8387f58b03ffc124fc138ad88e463) @@ -97,15 +97,6 @@ ":method unknown {method obj args} {\n" "error \"[::xotcl::self] unknown info option \\\"$method\\\"; [$obj info info]\"}}\n" "classInfo eval {\n" -":public method mixinof {obj -closure:switch {-scope all} pattern:optional} {\n" -"set withClosure [expr {$closure ? \"-closure\" : \"\"}]\n" -"set withPattern [expr {[info exists pattern] ? $pattern : \"\"}]\n" -"if {$scope eq \"all\"} {\n" -"set r [::xotcl::cmd::ClassInfo::object-mixin-of $obj {*}$withClosure {*}$withPattern]\n" -"foreach c [::xotcl::cmd::ClassInfo::class-mixin-of $obj {*}$withClosure] {\n" -"lappend r {*}[$c info instances {*}$withPattern]}\n" -"return [lsort -unique $r]} else {\n" -"return [::xotcl::cmd::ClassInfo::$scope-mixin-of $obj {*}$withClosure {*}$withPattern]}}\n" ":alias is ::xotcl::is\n" ":alias classparent ::xotcl::cmd::ObjectInfo::parent\n" ":alias classchildren ::xotcl::cmd::ObjectInfo::children\n" Index: generic/predefined.xotcl =================================================================== diff -u -r4d21376ac1245e34cb5a5f52da893072f311d3a9 -r29267f0c9db8387f58b03ffc124fc138ad88e463 --- generic/predefined.xotcl (.../predefined.xotcl) (revision 4d21376ac1245e34cb5a5f52da893072f311d3a9) +++ generic/predefined.xotcl (.../predefined.xotcl) (revision 29267f0c9db8387f58b03ffc124fc138ad88e463) @@ -206,20 +206,6 @@ } classInfo eval { - :public method mixinof {obj -closure:switch {-scope all} pattern:optional} { - # scope eq "all" or "object" returns objects, scope eq "class" returns classes - set withClosure [expr {$closure ? "-closure" : ""}] - set withPattern [expr {[info exists pattern] ? $pattern : ""}] - if {$scope eq "all"} { - set r [::xotcl::cmd::ClassInfo::object-mixin-of $obj {*}$withClosure {*}$withPattern] - foreach c [::xotcl::cmd::ClassInfo::class-mixin-of $obj {*}$withClosure] { - lappend r {*}[$c info instances {*}$withPattern] - } - return [lsort -unique $r] - } else { - return [::xotcl::cmd::ClassInfo::$scope-mixin-of $obj {*}$withClosure {*}$withPattern] - } - } :alias is ::xotcl::is :alias classparent ::xotcl::cmd::ObjectInfo::parent :alias classchildren ::xotcl::cmd::ObjectInfo::children Index: generic/tclAPI.h =================================================================== diff -u -rb1f416527fc1e567ff1db9ad5a720b3bbc5678ee -r29267f0c9db8387f58b03ffc124fc138ad88e463 --- generic/tclAPI.h (.../tclAPI.h) (revision b1f416527fc1e567ff1db9ad5a720b3bbc5678ee) +++ generic/tclAPI.h (.../tclAPI.h) (revision 29267f0c9db8387f58b03ffc124fc138ad88e463) @@ -32,6 +32,17 @@ } enum CallprotectionIdx {CallprotectionNULL, CallprotectionAllIdx, CallprotectionProtectedIdx, CallprotectionPublicIdx}; +static int convertToScope(Tcl_Interp *interp, Tcl_Obj *objPtr, XOTclParam CONST *pPtr, + ClientData *clientData, Tcl_Obj **outObjPtr) { + int index, result; + static CONST char *opts[] = {"all", "class", "object", NULL}; + result = Tcl_GetIndexFromObj(interp, objPtr, opts, "-scope", 0, &index); + *clientData = (ClientData) INT2PTR(index + 1); + *outObjPtr = objPtr; + return result; +} +enum ScopeIdx {ScopeNULL, ScopeAllIdx, ScopeClassIdx, ScopeObjectIdx}; + static int convertToAssertionsubcmd(Tcl_Interp *interp, Tcl_Obj *objPtr, XOTclParam CONST *pPtr, ClientData *clientData, Tcl_Obj **outObjPtr) { int index, result; @@ -131,7 +142,6 @@ static int XOTclCMixinGuardMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclCNewMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclCRecreateMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); -static int XOTclClassInfoClassMixinOfMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclClassInfoFilterMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclClassInfoFilterguardMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclClassInfoForwardMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); @@ -140,8 +150,8 @@ static int XOTclClassInfoMethodMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclClassInfoMethodsMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclClassInfoMixinMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); +static int XOTclClassInfoMixinOfMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclClassInfoMixinguardMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); -static int XOTclClassInfoObjectMixinOfMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclClassInfoParameterMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclClassInfoSlotsMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclClassInfoSubclassMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); @@ -213,7 +223,6 @@ static int XOTclCMixinGuardMethod(Tcl_Interp *interp, XOTclClass *cl, char *mixin, Tcl_Obj *guard); static int XOTclCNewMethod(Tcl_Interp *interp, XOTclClass *cl, XOTclObject *withChildof, int nobjc, Tcl_Obj *CONST nobjv[]); static int XOTclCRecreateMethod(Tcl_Interp *interp, XOTclClass *cl, Tcl_Obj *name, int objc, Tcl_Obj *CONST objv[]); -static int XOTclClassInfoClassMixinOfMethod(Tcl_Interp *interp, XOTclClass *class, int withClosure, char *patternString, XOTclObject *patternObj); static int XOTclClassInfoFilterMethod(Tcl_Interp *interp, XOTclClass *class, int withGuards, char *pattern); static int XOTclClassInfoFilterguardMethod(Tcl_Interp *interp, XOTclClass *class, char *filter); static int XOTclClassInfoForwardMethod(Tcl_Interp *interp, XOTclClass *class, int withDefinition, char *name); @@ -222,8 +231,8 @@ static int XOTclClassInfoMethodMethod(Tcl_Interp *interp, XOTclClass *class, int infomethodsubcmd, char *name); static int XOTclClassInfoMethodsMethod(Tcl_Interp *interp, XOTclClass *object, int withMethodtype, int withCallprotection, int withNomixins, int withIncontext, char *pattern); static int XOTclClassInfoMixinMethod(Tcl_Interp *interp, XOTclClass *class, int withClosure, int withGuards, char *patternString, XOTclObject *patternObj); +static int XOTclClassInfoMixinOfMethod(Tcl_Interp *interp, XOTclClass *class, int withClosure, int withScope, char *patternString, XOTclObject *patternObj); static int XOTclClassInfoMixinguardMethod(Tcl_Interp *interp, XOTclClass *class, char *mixin); -static int XOTclClassInfoObjectMixinOfMethod(Tcl_Interp *interp, XOTclClass *class, int withClosure, char *patternString, XOTclObject *patternObj); static int XOTclClassInfoParameterMethod(Tcl_Interp *interp, XOTclClass *class); static int XOTclClassInfoSlotsMethod(Tcl_Interp *interp, XOTclClass *class); static int XOTclClassInfoSubclassMethod(Tcl_Interp *interp, XOTclClass *class, int withClosure, char *patternString, XOTclObject *patternObj); @@ -274,7 +283,7 @@ static int XOTclGetSelfObjCmd(Tcl_Interp *interp, int selfoption); static int XOTclImportvarCmd(Tcl_Interp *interp, XOTclObject *object, int nobjc, Tcl_Obj *CONST nobjv[]); static int XOTclInterpObjCmd(Tcl_Interp *interp, char *name, int objc, Tcl_Obj *CONST objv[]); -static int XOTclIs2Cmd(Tcl_Interp *interp, Tcl_Obj *constraint, Tcl_Obj *value, Tcl_Obj *arg); +static int XOTclIs2Cmd(Tcl_Interp *interp, Tcl_Obj *value, Tcl_Obj *constraint, Tcl_Obj *withHasmixin, Tcl_Obj *withType, Tcl_Obj *arg); static int XOTclIsCmd(Tcl_Interp *interp, Tcl_Obj *object, int objectkind, Tcl_Obj *value); static int XOTclMethodCmd(Tcl_Interp *interp, XOTclObject *object, int withInner_namespace, int withPer_object, int withPublic, Tcl_Obj *name, Tcl_Obj *args, Tcl_Obj *body, Tcl_Obj *withPrecondition, Tcl_Obj *withPostcondition); static int XOTclMethodPropertyCmd(Tcl_Interp *interp, XOTclObject *object, int withPer_object, Tcl_Obj *methodName, int methodproperty, Tcl_Obj *value); @@ -296,7 +305,6 @@ XOTclCMixinGuardMethodIdx, XOTclCNewMethodIdx, XOTclCRecreateMethodIdx, - XOTclClassInfoClassMixinOfMethodIdx, XOTclClassInfoFilterMethodIdx, XOTclClassInfoFilterguardMethodIdx, XOTclClassInfoForwardMethodIdx, @@ -305,8 +313,8 @@ XOTclClassInfoMethodMethodIdx, XOTclClassInfoMethodsMethodIdx, XOTclClassInfoMixinMethodIdx, + XOTclClassInfoMixinOfMethodIdx, XOTclClassInfoMixinguardMethodIdx, - XOTclClassInfoObjectMixinOfMethodIdx, XOTclClassInfoParameterMethodIdx, XOTclClassInfoSlotsMethodIdx, XOTclClassInfoSubclassMethodIdx, @@ -527,40 +535,6 @@ } static int -XOTclClassInfoClassMixinOfMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { - parseContext pc; - - if (ArgumentParse(interp, objc, objv, NULL, objv[0], - method_definitions[XOTclClassInfoClassMixinOfMethodIdx].paramDefs, - method_definitions[XOTclClassInfoClassMixinOfMethodIdx].nrParameters, - &pc) != TCL_OK) { - return TCL_ERROR; - } else { - XOTclClass *class = (XOTclClass *)pc.clientData[0]; - int withClosure = (int )PTR2INT(pc.clientData[1]); - char *patternString = NULL; - XOTclObject *patternObj = NULL; - Tcl_Obj *pattern = (Tcl_Obj *)pc.clientData[2]; - int returnCode; - - if (getMatchObject(interp, pattern, objv[2], &patternObj, &patternString) == -1) { - if (pattern) { - DECR_REF_COUNT(pattern); - } - return TCL_OK; - } - - parseContextRelease(&pc); - returnCode = XOTclClassInfoClassMixinOfMethod(interp, class, withClosure, patternString, patternObj); - - if (pattern) { - DECR_REF_COUNT(pattern); - } - return returnCode; - } -} - -static int XOTclClassInfoFilterMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; @@ -751,50 +725,32 @@ } static int -XOTclClassInfoMixinguardMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { +XOTclClassInfoMixinOfMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; if (ArgumentParse(interp, objc, objv, NULL, objv[0], - method_definitions[XOTclClassInfoMixinguardMethodIdx].paramDefs, - method_definitions[XOTclClassInfoMixinguardMethodIdx].nrParameters, + method_definitions[XOTclClassInfoMixinOfMethodIdx].paramDefs, + method_definitions[XOTclClassInfoMixinOfMethodIdx].nrParameters, &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclClass *class = (XOTclClass *)pc.clientData[0]; - char *mixin = (char *)pc.clientData[1]; - - parseContextRelease(&pc); - return XOTclClassInfoMixinguardMethod(interp, class, mixin); - - } -} - -static int -XOTclClassInfoObjectMixinOfMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { - parseContext pc; - - if (ArgumentParse(interp, objc, objv, NULL, objv[0], - method_definitions[XOTclClassInfoObjectMixinOfMethodIdx].paramDefs, - method_definitions[XOTclClassInfoObjectMixinOfMethodIdx].nrParameters, - &pc) != TCL_OK) { - return TCL_ERROR; - } else { - XOTclClass *class = (XOTclClass *)pc.clientData[0]; int withClosure = (int )PTR2INT(pc.clientData[1]); + int withScope = (int )PTR2INT(pc.clientData[2]); char *patternString = NULL; XOTclObject *patternObj = NULL; - Tcl_Obj *pattern = (Tcl_Obj *)pc.clientData[2]; + Tcl_Obj *pattern = (Tcl_Obj *)pc.clientData[3]; int returnCode; - if (getMatchObject(interp, pattern, objv[2], &patternObj, &patternString) == -1) { + if (getMatchObject(interp, pattern, objv[3], &patternObj, &patternString) == -1) { if (pattern) { DECR_REF_COUNT(pattern); } return TCL_OK; } parseContextRelease(&pc); - returnCode = XOTclClassInfoObjectMixinOfMethod(interp, class, withClosure, patternString, patternObj); + returnCode = XOTclClassInfoMixinOfMethod(interp, class, withClosure, withScope, patternString, patternObj); if (pattern) { DECR_REF_COUNT(pattern); @@ -804,6 +760,25 @@ } static int +XOTclClassInfoMixinguardMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { + parseContext pc; + + if (ArgumentParse(interp, objc, objv, NULL, objv[0], + method_definitions[XOTclClassInfoMixinguardMethodIdx].paramDefs, + method_definitions[XOTclClassInfoMixinguardMethodIdx].nrParameters, + &pc) != TCL_OK) { + return TCL_ERROR; + } else { + XOTclClass *class = (XOTclClass *)pc.clientData[0]; + char *mixin = (char *)pc.clientData[1]; + + parseContextRelease(&pc); + return XOTclClassInfoMixinguardMethod(interp, class, mixin); + + } +} + +static int XOTclClassInfoParameterMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; @@ -1746,12 +1721,14 @@ &pc) != TCL_OK) { return TCL_ERROR; } else { - Tcl_Obj *constraint = (Tcl_Obj *)pc.clientData[0]; - Tcl_Obj *value = (Tcl_Obj *)pc.clientData[1]; - Tcl_Obj *arg = (Tcl_Obj *)pc.clientData[2]; + Tcl_Obj *value = (Tcl_Obj *)pc.clientData[0]; + Tcl_Obj *constraint = (Tcl_Obj *)pc.clientData[1]; + Tcl_Obj *withHasmixin = (Tcl_Obj *)pc.clientData[2]; + Tcl_Obj *withType = (Tcl_Obj *)pc.clientData[3]; + Tcl_Obj *arg = (Tcl_Obj *)pc.clientData[4]; parseContextRelease(&pc); - return XOTclIs2Cmd(interp, constraint, value, arg); + return XOTclIs2Cmd(interp, value, constraint, withHasmixin, withType, arg); } } @@ -2009,11 +1986,6 @@ {"name", 1, 0, convertToTclobj}, {"args", 0, 0, convertToNothing}} }, -{"::xotcl::cmd::ClassInfo::class-mixin-of", XOTclClassInfoClassMixinOfMethodStub, 3, { - {"class", 1, 0, convertToClass}, - {"-closure", 0, 0, convertToString}, - {"pattern", 0, 0, convertToObjpattern}} -}, {"::xotcl::cmd::ClassInfo::filter", XOTclClassInfoFilterMethodStub, 3, { {"class", 1, 0, convertToClass}, {"-guards", 0, 0, convertToString}, @@ -2056,15 +2028,16 @@ {"-guards", 0, 0, convertToString}, {"pattern", 0, 0, convertToObjpattern}} }, -{"::xotcl::cmd::ClassInfo::mixinguard", XOTclClassInfoMixinguardMethodStub, 2, { +{"::xotcl::cmd::ClassInfo::mixinof", XOTclClassInfoMixinOfMethodStub, 4, { {"class", 1, 0, convertToClass}, - {"mixin", 1, 0, convertToString}} -}, -{"::xotcl::cmd::ClassInfo::object-mixin-of", XOTclClassInfoObjectMixinOfMethodStub, 3, { - {"class", 1, 0, convertToClass}, {"-closure", 0, 0, convertToString}, + {"-scope", 0, 1, convertToScope}, {"pattern", 0, 0, convertToObjpattern}} }, +{"::xotcl::cmd::ClassInfo::mixinguard", XOTclClassInfoMixinguardMethodStub, 2, { + {"class", 1, 0, convertToClass}, + {"mixin", 1, 0, convertToString}} +}, {"::xotcl::cmd::ClassInfo::parameter", XOTclClassInfoParameterMethodStub, 1, { {"class", 1, 0, convertToClass}} }, @@ -2279,9 +2252,11 @@ {"name", 0, 0, convertToString}, {"args", 0, 0, convertToNothing}} }, -{"::xotcl::is2", XOTclIs2CmdStub, 3, { - {"constraint", 1, 0, convertToTclobj}, +{"::xotcl::is2", XOTclIs2CmdStub, 5, { {"value", 1, 0, convertToTclobj}, + {"constraint", 1, 0, convertToTclobj}, + {"-hasmixin", 0, 1, convertToTclobj}, + {"-type", 0, 1, convertToTclobj}, {"arg", 0, 0, convertToTclobj}} }, {"::xotcl::is", XOTclIsCmdStub, 3, { Index: generic/xotcl.c =================================================================== diff -u -rb1f416527fc1e567ff1db9ad5a720b3bbc5678ee -r29267f0c9db8387f58b03ffc124fc138ad88e463 --- generic/xotcl.c (.../xotcl.c) (revision b1f416527fc1e567ff1db9ad5a720b3bbc5678ee) +++ generic/xotcl.c (.../xotcl.c) (revision 29267f0c9db8387f58b03ffc124fc138ad88e463) @@ -12518,28 +12518,47 @@ /* xotclCmd is2 XOTclIs2Cmd { - {-argName "constraint" -required 1 -type tclobj} {-argName "value" -required 1 -type tclobj} + {-argName "constraint" -required 1 -type tclobj} + {-argName "-hasmixin" -required 0 -nrargs 1 -type tclobj} + {-argName "-type" -required 0 -nrargs 1 -type tclobj} {-argName "arg" -required 0 -type tclobj} } */ -static int XOTclIs2Cmd(Tcl_Interp *interp, Tcl_Obj *constraintObj, Tcl_Obj *value, Tcl_Obj *arg) { - int result = TCL_OK; +static int XOTclIs2Cmd(Tcl_Interp *interp, Tcl_Obj *value, Tcl_Obj *constraintObj, + Tcl_Obj *withHasmixin, Tcl_Obj *withType, Tcl_Obj *arg) { + int result = TCL_OK, success; char *constraintString = ObjStr(constraintObj); XOTclObject *object; - XOTclClass *cl; + XOTclClass *typeClass, *mixinClass; - if (value == NULL) return XOTclObjErrArgCnt(interp, NULL, NULL, " ??"); - if (isTypeString(constraintString)) { - int success; if (arg== NULL) return XOTclObjErrArgCnt(interp, NULL, NULL, "type "); success = (GetObjectFromObj(interp, value, &object) == TCL_OK) - && (GetClassFromObj(interp, arg, &cl, 0) == TCL_OK) - && isSubType(object->cl, cl); + && (GetClassFromObj(interp, arg, &typeClass, 0) == TCL_OK) + && isSubType(object->cl, typeClass); Tcl_SetIntObj(Tcl_GetObjResult(interp), success); + } else if (withHasmixin || withType) { + if ((!isObjectString(constraintString) && !isClassString(constraintString)) || arg != NULL) { + return XOTclObjErrArgCnt(interp, NULL, NULL, "object|class ?-hasmixin cl? ?-type cl?"); + } + if (*constraintString == 'o') { + success = (GetObjectFromObj(interp, value, &object) == TCL_OK); + } else { + success = (GetClassFromObj(interp, value, (XOTclClass **)&object, 0) == TCL_OK); + } + if (success && withType) { + success = (GetClassFromObj(interp, withType, &typeClass, 0) == TCL_OK) + && isSubType(object->cl, typeClass); + } + if (success && withHasmixin) { + success = (GetClassFromObj(interp, withHasmixin, &mixinClass, 0) == TCL_OK) + && hasMixin(interp, object, mixinClass); + } + Tcl_SetIntObj(Tcl_GetObjResult(interp), success); + } else if (arg != NULL) { Tcl_Obj *paramObj = Tcl_DuplicateObj(value); @@ -13859,48 +13878,49 @@ return class->opt ? GuardList(interp, class->opt->classmixins, mixin) : TCL_OK; } -static int XOTclClassInfoClassMixinOfMethod(Tcl_Interp *interp, XOTclClass * class, int withClosure, - char *patternString, XOTclObject *patternObj) { +static int XOTclClassInfoMixinOfMethod(Tcl_Interp *interp, XOTclClass * class, int withClosure, int withScope, + char *patternString, XOTclObject *patternObj) { XOTclClassOpt *opt = class->opt; + int perClass, perObject; int rc; - if (opt) { - if (withClosure) { - Tcl_HashTable objTable, *commandTable = &objTable; - MEM_COUNT_ALLOC("Tcl_InitHashTable", commandTable); - Tcl_InitHashTable(commandTable, TCL_ONE_WORD_KEYS); - rc = getAllClassMixinsOf(interp, commandTable, class, 0, 1, patternString, patternObj); - MEM_COUNT_FREE("Tcl_InitHashTable", commandTable); - } else { - rc = AppendMatchingElementsFromCmdList(interp, opt->isClassMixinOf, - patternString, patternObj); - } - if (patternObj) { - Tcl_SetObjResult(interp, rc ? patternObj->cmdName : XOTclGlobalObjects[XOTE_EMPTY]); - } + if (withScope == ScopeNULL || withScope == ScopeAllIdx) { + perClass = 1; + perObject = 1; + } else if (withScope == ScopeClassIdx) { + perClass = 1; + perObject = 0; + } else { + perClass = 0; + perObject = 1; } - return TCL_OK; -} -static int XOTclClassInfoObjectMixinOfMethod(Tcl_Interp *interp, XOTclClass * class, int withClosure, - char *patternString, XOTclObject *patternObj) { - XOTclClassOpt *opt = class->opt; - int rc = 0; - if (opt && !withClosure) { - rc = AppendMatchingElementsFromCmdList(interp, opt->isObjectMixinOf, patternString, patternObj); + if (perClass) { + rc = AppendMatchingElementsFromCmdList(interp, opt->isClassMixinOf, patternString, patternObj); + if (rc && patternObj) {goto finished;} + } + if (perObject) { + rc = AppendMatchingElementsFromCmdList(interp, opt->isObjectMixinOf, patternString, patternObj); + } } else if (withClosure) { Tcl_HashTable objTable, *commandTable = &objTable; MEM_COUNT_ALLOC("Tcl_InitHashTable", commandTable); Tcl_InitHashTable(commandTable, TCL_ONE_WORD_KEYS); - rc = getAllObjectMixinsOf(interp, commandTable, class, 0, 1, patternString, patternObj); + if (perClass) { + rc = getAllClassMixinsOf(interp, commandTable, class, 0, 1, patternString, patternObj); + if (rc && patternObj) {goto finished;} + } + if (perObject) { + rc = getAllObjectMixinsOf(interp, commandTable, class, 0, 1, patternString, patternObj); + } MEM_COUNT_FREE("Tcl_InitHashTable", commandTable); } - + + finished: if (patternObj) { Tcl_SetObjResult(interp, rc ? patternObj->cmdName : XOTclGlobalObjects[XOTE_EMPTY]); } - return TCL_OK; } Index: generic/xotclInt.h =================================================================== diff -u -rb1f416527fc1e567ff1db9ad5a720b3bbc5678ee -r29267f0c9db8387f58b03ffc124fc138ad88e463 --- generic/xotclInt.h (.../xotclInt.h) (revision b1f416527fc1e567ff1db9ad5a720b3bbc5678ee) +++ generic/xotclInt.h (.../xotclInt.h) (revision 29267f0c9db8387f58b03ffc124fc138ad88e463) @@ -140,6 +140,12 @@ #define isTypeString(m) (\ *m == 't' && m[1] == 'y' && m[2] == 'p' && m[3] == 'e' && \ m[4] == '\0') +#define isObjectString(m) (\ + *m == 'o' && m[1] == 'b' && m[2] == 'j' && m[3] == 'e' && \ + m[4] == 'c' && m[5] == 't' && m[6] == '\0') +#define isClassString(m) (\ + *m == 'c' && m[1] == 'l' && m[2] == 'a' && m[3] == 's' && \ + m[4] == 's' && m[5] == '\0') #if (defined(sun) || defined(__hpux)) && !defined(__GNUC__) # define USE_ALLOCA Index: library/lib/xotcl1.xotcl =================================================================== diff -u -r464811a4aaa475de10e834b0a009521446163fc0 -r29267f0c9db8387f58b03ffc124fc138ad88e463 --- library/lib/xotcl1.xotcl (.../xotcl1.xotcl) (revision 464811a4aaa475de10e834b0a009521446163fc0) +++ library/lib/xotcl1.xotcl (.../xotcl1.xotcl) (revision 29267f0c9db8387f58b03ffc124fc138ad88e463) @@ -349,7 +349,7 @@ foreach cmd [::info command ::xotcl::cmd::ClassInfo::*] { set cmdName [namespace tail $cmd] if {$cmdName in [list "forward" "method" "methods" \ - "class-mixin-of" "object-mixin-of" \ + "mixinof" "object-mixin-of" \ "filter" "filterguard" \ "mixin" "mixinguard"]} continue ::xotcl::alias ::xotcl::classInfo $cmdName $cmd @@ -361,11 +361,14 @@ ::xotcl::alias ::xotcl::classInfo classchildren ::xotcl::cmd::ObjectInfo::children ::xotcl::alias ::xotcl::classInfo instmixin ::xotcl::cmd::ClassInfo::mixin ::xotcl::alias ::xotcl::classInfo instmixinguard ::xotcl::cmd::ClassInfo::mixinguard - ::xotcl::alias ::xotcl::classInfo instmixinof ::xotcl::cmd::ClassInfo::class-mixin-of + #::xotcl::alias ::xotcl::classInfo 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::alias ::xotcl::classInfo mixinof ::xotcl::cmd::ClassInfo::object-mixin-of + ::xotcl::forward ::xotcl::classInfo mixinof ::xotcl::cmd::ClassInfo::mixinof %1 -scope object + # assertion handling ::xotcl::alias ::xotcl::classInfo invar objectInfo::invar ::xotcl::alias ::xotcl::classInfo check objectInfo::check Index: tests/mixinoftest.xotcl =================================================================== diff -u -reef622da1b387cfd1dd68babeb0bfecfbae5caa3 -r29267f0c9db8387f58b03ffc124fc138ad88e463 --- tests/mixinoftest.xotcl (.../mixinoftest.xotcl) (revision eef622da1b387cfd1dd68babeb0bfecfbae5caa3) +++ tests/mixinoftest.xotcl (.../mixinoftest.xotcl) (revision 29267f0c9db8387f58b03ffc124fc138ad88e463) @@ -481,31 +481,35 @@ ########################################### # testing simple per object mixins ########################################### -Test case xotcl2-mixinof -Class create M -Class create A -Class create C -C create c1 -mixin A -C create c2 -? {c1 mixin} ::A -? {c1 info mixin} ::A -? {A info mixinof} ::c1 -? {M info mixinof} "" -C mixin M -? {M info mixinof} "::c1 ::c2" -? {M info mixinof -scope object} "" -? {M info mixinof -scope class} "::C" -? {A info mixinof} "::c1" -? {A info mixinof -scope object} "::c1" -? {A info mixinof -scope class} "" +Test case xotcl2-mixinof { + Class create M + Class create A + Class create C + C create c1 -mixin A + C create c2 + Class create C2 -mixin A + C2 create c22 -c1 destroy -? {A info mixinof} "" -? {M info mixinof} "::c2" -c2 destroy -? {M info mixinof} "" + ? {c1 mixin} ::A + ? {c1 info mixin} ::A + ? {lsort [A info mixinof]} "::C2 ::c1" + ? {M info mixinof} "" + C mixin M + #? {M info mixinof -scope object} "::c1 ::c2" + ? {M info mixinof -scope object} "" + ? {M info mixinof -scope class} "::C" + ? {M info mixinof -scope all} "::C" + ? {M info mixinof} "::C" -A destroy -C destroy -M destroy + ? {lsort [A info mixinof]} "::C2 ::c1" + ? {A info mixinof -scope object} "::c1" + ? {A info mixinof -scope class} "::C2" + + c1 destroy + ? {A info mixinof} "::C2" + ? {M info mixinof} "::C" + C destroy + ? {M info mixinof} "" +} + Index: tests/parameters.xotcl =================================================================== diff -u -rb1f416527fc1e567ff1db9ad5a720b3bbc5678ee -r29267f0c9db8387f58b03ffc124fc138ad88e463 --- tests/parameters.xotcl (.../parameters.xotcl) (revision b1f416527fc1e567ff1db9ad5a720b3bbc5678ee) +++ tests/parameters.xotcl (.../parameters.xotcl) (revision 29267f0c9db8387f58b03ffc124fc138ad88e463) @@ -21,16 +21,24 @@ Object create o1 Class create C -parameter {a {b:boolean} {c 1}} C create c1 + Class create M + c1 mixin M ? {::xotcl::valuecheck object o1} 1 ? {::xotcl::valuecheck integer 1} 1 ? {::xotcl::is o1 object} 1 ? {::xotcl::is c1 type C} 1 - ? {::xotcl::is2 object o1} 1 - ? {::xotcl::is2 integer 1} 1 - ? {::xotcl::is2 type c1 C} 1 - ? {::xotcl::is2 type o C} 0 - + ? {::xotcl::is2 c1 object -type C} 1 + ? {::xotcl::is2 c1 object -hasmixin M -type C} 1 + ? {::xotcl::is2 c1 object -hasmixin M1 -type C} 0 + ? {::xotcl::is2 c1 object -hasmixin M -type C0} 0 + ? {::xotcl::is2 o1 object} 1 + ? {::xotcl::is2 1 integer} 1 + ? {::xotcl::is2 c1 type C} 1 + ? {::xotcl::is2 o type C} 0 + ? {::xotcl::is2 o object -type C} 0 + ? {::xotcl::is2 o object -hasmixin C} 0 +#exit ? {::xotcl::valuecheck class o1} {expected class but got "o1" for parameter value} ? {::xotcl::valuecheck -nocomplain class o1} 0 ? {::xotcl::valuecheck class Test} 1