Index: ChangeLog =================================================================== diff -u -r80dbbc5075b96ca2d25ebf426204398f68411e17 -raf52afc76c89bbf7ef89aca74745aea87f73b764 --- ChangeLog (.../ChangeLog) (revision 80dbbc5075b96ca2d25ebf426204398f68411e17) +++ ChangeLog (.../ChangeLog) (revision af52afc76c89bbf7ef89aca74745aea87f73b764) @@ -67,7 +67,7 @@ - objv-stubs for all 23 class info methods - changed " info hasNamespace" to " info hasnamespace" (all commands and info options are lowercase only, no underscore) - - 11 " info" commands generated + - all " info" commands generated 2009-06-27 - changed method name "instdestroy" into "dealloc" Index: generic/gentclAPI.tcl =================================================================== diff -u -r80dbbc5075b96ca2d25ebf426204398f68411e17 -raf52afc76c89bbf7ef89aca74745aea87f73b764 --- generic/gentclAPI.tcl (.../gentclAPI.tcl) (revision 80dbbc5075b96ca2d25ebf426204398f68411e17) +++ generic/gentclAPI.tcl (.../gentclAPI.tcl) (revision af52afc76c89bbf7ef89aca74745aea87f73b764) @@ -201,6 +201,63 @@ infoObjectMethod hasnamespace XOTclObjInfoHasnamespaceMethod { {-argName "object" -required 1 -type object} } +infoObjectMethod invar XOTclObjInfoInvarMethod { + {-argName "object" -required 1 -type object} +} +infoObjectMethod methods XOTclObjInfoMethodsMethod { + {-argName "object" -required 1 -type object} + {-argName "-noprocs"} + {-argName "-nocmds"} + {-argName "-nomixins"} + {-argName "-incontext"} + {-argName "pattern"} +} +infoObjectMethod mixin XOTclObjInfoMixinMethod { + {-argName "object" -required 1 -type object} + {-argName "-guards"} + {-argName "-order"} + {-argName "pattern" -type objpattern} +} +infoObjectMethod mixinguard XOTclObjInfoMixinguardMethod { + {-argName "object" -required 1 -type object} + {-argName "mixin" -required 1} +} +infoObjectMethod nonposargs XOTclObjInfoNonposargsMethod { + {-argName "object" -required 1 -type object} + {-argName "methodName" -required 1} +} +infoObjectMethod parent XOTclObjInfoParentMethod { + {-argName "object" -required 1 -type object} +} +infoObjectMethod parametercmd XOTclObjInfoParametercmdMethod { + {-argName "object" -required 1 -type object} + {-argName "pattern"} +} +infoObjectMethod post XOTclObjInfoPostMethod { + {-argName "object" -required 1 -type object} + {-argName "methodName" -required 1} +} +infoObjectMethod pre XOTclObjInfoPreMethod { + {-argName "object" -required 1 -type object} + {-argName "methodName" -required 1} +} +infoObjectMethod precedence XOTclObjInfoPrecedenceMethod { + {-argName "object" -required 1 -type object} + {-argName "-intrinsic"} + {-argName "pattern" -required 0} +} +infoObjectMethod procs XOTclObjInfoProcsMethod { + {-argName "object" -required 1 -type object} + {-argName "pattern" -required 0} +} +infoObjectMethod slotobjects XOTclObjInfoSlotObjectsMethod { + {-argName "object" -required 1 -type object} + {-argName "pattern" -required 0} +} +infoObjectMethod vars XOTclObjInfoVarsMethod { + {-argName "object" -required 1 -type object} + {-argName "pattern" -required 0} +} # Index: generic/tclAPI.h =================================================================== diff -u -r80dbbc5075b96ca2d25ebf426204398f68411e17 -raf52afc76c89bbf7ef89aca74745aea87f73b764 --- generic/tclAPI.h (.../tclAPI.h) (revision 80dbbc5075b96ca2d25ebf426204398f68411e17) +++ generic/tclAPI.h (.../tclAPI.h) (revision af52afc76c89bbf7ef89aca74745aea87f73b764) @@ -44,6 +44,19 @@ static int XOTclObjInfoFilterguardMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclObjInfoForwardMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclObjInfoHasnamespaceMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); +static int XOTclObjInfoInvarMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); +static int XOTclObjInfoMethodsMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); +static int XOTclObjInfoMixinMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); +static int XOTclObjInfoMixinguardMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); +static int XOTclObjInfoNonposargsMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); +static int XOTclObjInfoParametercmdMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); +static int XOTclObjInfoParentMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); +static int XOTclObjInfoPostMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); +static int XOTclObjInfoPreMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); +static int XOTclObjInfoPrecedenceMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); +static int XOTclObjInfoProcsMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); +static int XOTclObjInfoSlotObjectsMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); +static int XOTclObjInfoVarsMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclClassInfoHeritageMethod(Tcl_Interp *interp, XOTclClass *class, char *pattern); static int XOTclClassInfoInstancesMethod(Tcl_Interp *interp, XOTclClass *class, int withClosure, char *patternString, XOTclObject *patternObj); @@ -79,6 +92,19 @@ static int XOTclObjInfoFilterguardMethod(Tcl_Interp *interp, XOTclObject *object, char *filter); static int XOTclObjInfoForwardMethod(Tcl_Interp *interp, XOTclObject *object, int withDefinition, char *methodName); static int XOTclObjInfoHasnamespaceMethod(Tcl_Interp *interp, XOTclObject *object); +static int XOTclObjInfoInvarMethod(Tcl_Interp *interp, XOTclObject *object); +static int XOTclObjInfoMethodsMethod(Tcl_Interp *interp, XOTclObject *object, int withNoprocs, int withNocmds, int withNomixins, int withIncontext, char *pattern); +static int XOTclObjInfoMixinMethod(Tcl_Interp *interp, XOTclObject *object, int withGuards, int withOrder, char *patternString, XOTclObject *patternObj); +static int XOTclObjInfoMixinguardMethod(Tcl_Interp *interp, XOTclObject *object, char *mixin); +static int XOTclObjInfoNonposargsMethod(Tcl_Interp *interp, XOTclObject *object, char *methodName); +static int XOTclObjInfoParametercmdMethod(Tcl_Interp *interp, XOTclObject *object, char *pattern); +static int XOTclObjInfoParentMethod(Tcl_Interp *interp, XOTclObject *object); +static int XOTclObjInfoPostMethod(Tcl_Interp *interp, XOTclObject *object, char *methodName); +static int XOTclObjInfoPreMethod(Tcl_Interp *interp, XOTclObject *object, char *methodName); +static int XOTclObjInfoPrecedenceMethod(Tcl_Interp *interp, XOTclObject *object, int withIntrinsic, char *pattern); +static int XOTclObjInfoProcsMethod(Tcl_Interp *interp, XOTclObject *object, char *pattern); +static int XOTclObjInfoSlotObjectsMethod(Tcl_Interp *interp, XOTclObject *object, char *pattern); +static int XOTclObjInfoVarsMethod(Tcl_Interp *interp, XOTclObject *object, char *pattern); enum { XOTclClassInfoHeritageMethodIdx, @@ -114,7 +140,20 @@ XOTclObjInfoFilterMethodIdx, XOTclObjInfoFilterguardMethodIdx, XOTclObjInfoForwardMethodIdx, - XOTclObjInfoHasnamespaceMethodIdx + XOTclObjInfoHasnamespaceMethodIdx, + XOTclObjInfoInvarMethodIdx, + XOTclObjInfoMethodsMethodIdx, + XOTclObjInfoMixinMethodIdx, + XOTclObjInfoMixinguardMethodIdx, + XOTclObjInfoNonposargsMethodIdx, + XOTclObjInfoParametercmdMethodIdx, + XOTclObjInfoParentMethodIdx, + XOTclObjInfoPostMethodIdx, + XOTclObjInfoPreMethodIdx, + XOTclObjInfoPrecedenceMethodIdx, + XOTclObjInfoProcsMethodIdx, + XOTclObjInfoSlotObjectsMethodIdx, + XOTclObjInfoVarsMethodIdx } XOTclMethods; @@ -634,6 +673,199 @@ } } +static int +XOTclObjInfoInvarMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { + parseContext pc; + if (parse2(clientData, interp, objc, objv, XOTclObjInfoInvarMethodIdx, &pc) != TCL_OK) { + return TCL_ERROR; + } else { + XOTclObject * object = (XOTclObject *)pc.clientData[0]; + + return XOTclObjInfoInvarMethod(interp, object); + + } +} + +static int +XOTclObjInfoMethodsMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { + parseContext pc; + if (parse2(clientData, interp, objc, objv, XOTclObjInfoMethodsMethodIdx, &pc) != TCL_OK) { + return TCL_ERROR; + } else { + XOTclObject * object = (XOTclObject *)pc.clientData[0]; + int withNoprocs = (int )pc.clientData[1]; + int withNocmds = (int )pc.clientData[2]; + int withNomixins = (int )pc.clientData[3]; + int withIncontext = (int )pc.clientData[4]; + char * pattern = (char *)pc.clientData[5]; + + return XOTclObjInfoMethodsMethod(interp, object, withNoprocs, withNocmds, withNomixins, withIncontext, pattern); + + } +} + +static int +XOTclObjInfoMixinMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { + parseContext pc; + if (parse2(clientData, interp, objc, objv, XOTclObjInfoMixinMethodIdx, &pc) != TCL_OK) { + return TCL_ERROR; + } else { + XOTclObject * object = (XOTclObject *)pc.clientData[0]; + int withGuards = (int )pc.clientData[1]; + int withOrder = (int )pc.clientData[2]; + char *patternString = NULL; + XOTclObject *patternObj = NULL; + Tcl_Obj * pattern = (Tcl_Obj *)pc.clientData[3]; + + if (getMatchObject3(interp, pattern, &pc, &patternObj, &patternString) == -1) { + return TCL_OK; + } + + return XOTclObjInfoMixinMethod(interp, object, withGuards, withOrder, patternString, patternObj); + + } +} + +static int +XOTclObjInfoMixinguardMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { + parseContext pc; + if (parse2(clientData, interp, objc, objv, XOTclObjInfoMixinguardMethodIdx, &pc) != TCL_OK) { + return TCL_ERROR; + } else { + XOTclObject * object = (XOTclObject *)pc.clientData[0]; + char * mixin = (char *)pc.clientData[1]; + + return XOTclObjInfoMixinguardMethod(interp, object, mixin); + + } +} + +static int +XOTclObjInfoNonposargsMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { + parseContext pc; + if (parse2(clientData, interp, objc, objv, XOTclObjInfoNonposargsMethodIdx, &pc) != TCL_OK) { + return TCL_ERROR; + } else { + XOTclObject * object = (XOTclObject *)pc.clientData[0]; + char * methodName = (char *)pc.clientData[1]; + + return XOTclObjInfoNonposargsMethod(interp, object, methodName); + + } +} + +static int +XOTclObjInfoParametercmdMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { + parseContext pc; + if (parse2(clientData, interp, objc, objv, XOTclObjInfoParametercmdMethodIdx, &pc) != TCL_OK) { + return TCL_ERROR; + } else { + XOTclObject * object = (XOTclObject *)pc.clientData[0]; + char * pattern = (char *)pc.clientData[1]; + + return XOTclObjInfoParametercmdMethod(interp, object, pattern); + + } +} + +static int +XOTclObjInfoParentMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { + parseContext pc; + if (parse2(clientData, interp, objc, objv, XOTclObjInfoParentMethodIdx, &pc) != TCL_OK) { + return TCL_ERROR; + } else { + XOTclObject * object = (XOTclObject *)pc.clientData[0]; + + return XOTclObjInfoParentMethod(interp, object); + + } +} + +static int +XOTclObjInfoPostMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { + parseContext pc; + if (parse2(clientData, interp, objc, objv, XOTclObjInfoPostMethodIdx, &pc) != TCL_OK) { + return TCL_ERROR; + } else { + XOTclObject * object = (XOTclObject *)pc.clientData[0]; + char * methodName = (char *)pc.clientData[1]; + + return XOTclObjInfoPostMethod(interp, object, methodName); + + } +} + +static int +XOTclObjInfoPreMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { + parseContext pc; + if (parse2(clientData, interp, objc, objv, XOTclObjInfoPreMethodIdx, &pc) != TCL_OK) { + return TCL_ERROR; + } else { + XOTclObject * object = (XOTclObject *)pc.clientData[0]; + char * methodName = (char *)pc.clientData[1]; + + return XOTclObjInfoPreMethod(interp, object, methodName); + + } +} + +static int +XOTclObjInfoPrecedenceMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { + parseContext pc; + if (parse2(clientData, interp, objc, objv, XOTclObjInfoPrecedenceMethodIdx, &pc) != TCL_OK) { + return TCL_ERROR; + } else { + XOTclObject * object = (XOTclObject *)pc.clientData[0]; + int withIntrinsic = (int )pc.clientData[1]; + char * pattern = (char *)pc.clientData[2]; + + return XOTclObjInfoPrecedenceMethod(interp, object, withIntrinsic, pattern); + + } +} + +static int +XOTclObjInfoProcsMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { + parseContext pc; + if (parse2(clientData, interp, objc, objv, XOTclObjInfoProcsMethodIdx, &pc) != TCL_OK) { + return TCL_ERROR; + } else { + XOTclObject * object = (XOTclObject *)pc.clientData[0]; + char * pattern = (char *)pc.clientData[1]; + + return XOTclObjInfoProcsMethod(interp, object, pattern); + + } +} + +static int +XOTclObjInfoSlotObjectsMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { + parseContext pc; + if (parse2(clientData, interp, objc, objv, XOTclObjInfoSlotObjectsMethodIdx, &pc) != TCL_OK) { + return TCL_ERROR; + } else { + XOTclObject * object = (XOTclObject *)pc.clientData[0]; + char * pattern = (char *)pc.clientData[1]; + + return XOTclObjInfoSlotObjectsMethod(interp, object, pattern); + + } +} + +static int +XOTclObjInfoVarsMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { + parseContext pc; + if (parse2(clientData, interp, objc, objv, XOTclObjInfoVarsMethodIdx, &pc) != TCL_OK) { + return TCL_ERROR; + } else { + XOTclObject * object = (XOTclObject *)pc.clientData[0]; + char * pattern = (char *)pc.clientData[1]; + + return XOTclObjInfoVarsMethod(interp, object, pattern); + + } +} + static methodDefinition2 methodDefinitons[] = { {"instances", XOTclClassInfoHeritageMethodStub, { {"class", 1, 0, "class"}, @@ -780,6 +1012,63 @@ }, {"hasnamespace", XOTclObjInfoHasnamespaceMethodStub, { {"object", 1, 0, "object"}} +}, +{"invar", XOTclObjInfoInvarMethodStub, { + {"object", 1, 0, "object"}} +}, +{"methods", XOTclObjInfoMethodsMethodStub, { + {"object", 1, 0, "object"}, + {"-noprocs", 0, 0, NULL}, + {"-nocmds", 0, 0, NULL}, + {"-nomixins", 0, 0, NULL}, + {"-incontext", 0, 0, NULL}, + {"pattern", 0, 0, NULL}} +}, +{"mixin", XOTclObjInfoMixinMethodStub, { + {"object", 1, 0, "object"}, + {"-guards", 0, 0, NULL}, + {"-order", 0, 0, NULL}, + {"pattern", 0, 0, "objpattern"}} +}, +{"mixinguard", XOTclObjInfoMixinguardMethodStub, { + {"object", 1, 0, "object"}, + {"mixin", 1, 0, NULL}} +}, +{"nonposargs", XOTclObjInfoNonposargsMethodStub, { + {"object", 1, 0, "object"}, + {"methodName", 1, 0, NULL}} +}, +{"parametercmd", XOTclObjInfoParametercmdMethodStub, { + {"object", 1, 0, "object"}, + {"pattern", 0, 0, NULL}} +}, +{"parent", XOTclObjInfoParentMethodStub, { + {"object", 1, 0, "object"}} +}, +{"post", XOTclObjInfoPostMethodStub, { + {"object", 1, 0, "object"}, + {"methodName", 1, 0, NULL}} +}, +{"pre", XOTclObjInfoPreMethodStub, { + {"object", 1, 0, "object"}, + {"methodName", 1, 0, NULL}} +}, +{"precedence", XOTclObjInfoPrecedenceMethodStub, { + {"object", 1, 0, "object"}, + {"-intrinsic", 0, 0, NULL}, + {"pattern", 0, 0, NULL}} +}, +{"procs", XOTclObjInfoProcsMethodStub, { + {"object", 1, 0, "object"}, + {"pattern", 0, 0, NULL}} +}, +{"slotobjects", XOTclObjInfoSlotObjectsMethodStub, { + {"object", 1, 0, "object"}, + {"pattern", 0, 0, NULL}} +}, +{"vars", XOTclObjInfoVarsMethodStub, { + {"object", 1, 0, "object"}, + {"pattern", 0, 0, NULL}} } }; Index: generic/xotcl.c =================================================================== diff -u -r80dbbc5075b96ca2d25ebf426204398f68411e17 -raf52afc76c89bbf7ef89aca74745aea87f73b764 --- generic/xotcl.c (.../xotcl.c) (revision 80dbbc5075b96ca2d25ebf426204398f68411e17) +++ generic/xotcl.c (.../xotcl.c) (revision af52afc76c89bbf7ef89aca74745aea87f73b764) @@ -6660,24 +6660,6 @@ return TCL_OK; } - -static int -ListPrecedence(Tcl_Interp *interp, XOTclObject *obj, char *pattern, int intrinsicOnly) { - XOTclClasses *pl, *precedenceList; - - /*fprintf(stderr, "ListPrecedence %s pattern '%s', intrinsic %d\n", - objectName(obj), pattern, intrinsicOnly);*/ - - Tcl_ResetResult(interp); - precedenceList = ComputePrecedenceList(interp, obj, pattern, !intrinsicOnly); - for (pl = precedenceList; pl; pl = pl->nextPtr) { - char *name = className(pl->cl); - Tcl_AppendElement(interp, name); - } - XOTclClassListFree(pl); - return TCL_OK; -} - static Proc* FindProc(Tcl_Interp *interp, Tcl_HashTable *table, char *name) { Tcl_HashEntry *hPtr = table ? XOTcl_FindHashEntry(table, name) : 0; @@ -6971,16 +6953,6 @@ return TCL_OK; } - - -static int -ListParent(Tcl_Interp *interp, XOTclObject *obj) { - if (obj->id) { - Tcl_SetResult(interp, NSCmdFullName(obj->id), TCL_VOLATILE); - } - return TCL_OK; -} - static XOTclClass* FindCalledClass(Tcl_Interp *interp, XOTclObject *obj) { XOTclCallStackContent *csc = CallStackGetTopFrame(interp); @@ -9004,299 +8976,116 @@ return TCL_OK; } -/*************************** - * End Object Info Methods - ***************************/ - - - -static int -XOTclObjInfoParametercmdMethod(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { - XOTclObject *obj; - if (objc < 2 || objc > 3) return XOTclObjErrArgCnt(interp, objv[0], NULL, " ?pattern?"); - if (XOTclObjConvertObject(interp, objv[1], &obj) != TCL_OK) - return XOTclObjErrType(interp, objv[1], "Object"); - - if (obj->nsPtr) { - return ListMethodKeys(interp, Tcl_Namespace_cmdTable(obj->nsPtr), objc == 3 ? ObjStr(objv[2]) : NULL, 1, 0, 0, 0, 1); - } else { - return TCL_OK; +static int +XOTclObjInfoInvarMethod(Tcl_Interp *interp, XOTclObject *object) { + if (object->opt && object->opt->assertions) { + Tcl_SetObjResult(interp, AssertionList(interp, object->opt->assertions->invariants)); } + return TCL_OK; } - -static int -XOTclObjInfoSlotObjectsMethod(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { - XOTclObject *obj; - - if (objc < 2 || objc > 3) return XOTclObjErrArgCnt(interp, objv[0], NULL, " ?pattern?"); - if (XOTclObjConvertObject(interp, objv[1], &obj) != TCL_OK) - return XOTclObjErrType(interp, objv[1], "Object"); - - return ListSlotObjects(interp, obj, objc == 3 ? ObjStr(objv[2]) : NULL); +static int +XOTclObjInfoMethodsMethod(Tcl_Interp *interp, XOTclObject *object, int withNoprocs, + int withNocmds, int withNomixins, int withIncontext, char *pattern) { + return ListMethods(interp, object, pattern, withNoprocs, withNocmds, withNomixins, withIncontext); } - -static int -XOTclObjInfoInvarMethod(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { - XOTclObject *obj; - XOTclObjectOpt *opt; - - if (objc != 2) return XOTclObjErrArgCnt(interp, objv[0], NULL, ""); - if (XOTclObjConvertObject(interp, objv[1], &obj) != TCL_OK) - return XOTclObjErrType(interp, objv[1], "Object"); - - opt = obj->opt; - if (opt && opt->assertions) { - Tcl_SetObjResult(interp, AssertionList(interp, opt->assertions->invariants)); - } - return TCL_OK; -} - -static int -XOTclObjInfoMixinMethod(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { - XOTclObject *obj, *matchObject; - XOTclObjectOpt *opt; - int idx, nobjc, withGuards = 0, withOrder = 0; - static CONST char *options[] = {"-guards", "-order", NULL}; - enum options {guardsIdx, orderIdx}; - Tcl_DString ds, *dsPtr = &ds; - char *pattern = NULL; - - for (idx = 2; idx < objc; idx++) { - char *name; - int index; - - name = Tcl_GetString(objv[idx]); - if (name[0] != '-') { - break; - } - if (Tcl_GetIndexFromObj(interp, objv[idx], options, "switch", TCL_EXACT, &index) != TCL_OK) { - return TCL_ERROR; - } - switch ((enum options) index) { - case guardsIdx: withGuards = 1; break; - case orderIdx: withOrder = 1; break; - } - } - nobjc = objc-idx; - - if (objc < 2 || nobjc > 1 || objc > 4) - return XOTclObjErrArgCnt(interp, objv[0], NULL, " ?-guards|-order? ?pattern?"); - - if (XOTclObjConvertObject(interp, objv[1], &obj) != TCL_OK) - return XOTclObjErrType(interp, objv[1], "Object"); - - if (idxflags & XOTCL_MIXIN_ORDER_VALID)) - MixinComputeDefined(interp, obj); - return MixinInfo(interp, obj->mixinOrder, pattern, - withGuards, matchObject); + if (!(object->flags & XOTCL_MIXIN_ORDER_VALID)) + MixinComputeDefined(interp, object); + return MixinInfo(interp, object->mixinOrder, patternString, + withGuards, patternObj); } - - opt = obj->opt; - return opt ? MixinInfo(interp, opt->mixins, pattern, withGuards, matchObject) : TCL_OK; + return object->opt ? MixinInfo(interp, object->opt->mixins, patternString, withGuards, patternObj) : TCL_OK; } -static int -XOTclObjInfoMixinguardMethod(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { - XOTclObject *obj; - XOTclObjectOpt *opt; - - if (objc != 3) return XOTclObjErrArgCnt(interp, objv[0], NULL, " mixin"); - if (XOTclObjConvertObject(interp, objv[1], &obj) != TCL_OK) - return XOTclObjErrType(interp, objv[1], "Object"); - - opt = obj->opt; - return opt ? GuardList(interp, opt->mixins, ObjStr(objv[2])) : TCL_OK; +static int +XOTclObjInfoMixinguardMethod(Tcl_Interp *interp, XOTclObject *object, char *mixin) { + return object->opt ? GuardList(interp, object->opt->mixins, mixin) : TCL_OK; } -static int -XOTclObjInfoMethodsMethod(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { - XOTclObject *obj; - int idx, nobj, noprocs = 0, nocmds = 0, nomixins = 0, inContext = 0; - static CONST char *options[] = {"-noprocs", "-nocmds", "-nomixins", "-incontext", NULL}; - enum options {noprocsIdx, nocmdsIdx, nomixinsIdx, incontextIdx}; - - for (idx = 2; idx < objc; idx++) { - char *name; - int index; - - name = Tcl_GetString(objv[idx]); - if (name[0] != '-') { - break; - } - if (Tcl_GetIndexFromObj(interp, objv[idx], options, "switch", TCL_EXACT, &index) != TCL_OK) { - return TCL_ERROR; - } - switch ((enum options) index) { - case noprocsIdx: noprocs = 1; break; - case nocmdsIdx: nocmds = 1; break; - case nomixinsIdx: nomixins = 1; break; - case incontextIdx: inContext = 1; break; - } - } - nobj = objc-idx; - - if (nobj > 1) - return XOTclObjErrArgCnt(interp, objv[0], NULL, - " ?-noprocs? ?-nocmds? ?-nomixins? ?-incontext? ?pattern?"); - if (XOTclObjConvertObject(interp, objv[1], &obj) != TCL_OK) - return XOTclObjErrType(interp, objv[1], "Object"); - - return ListMethods(interp, obj, nobj == 1 ? ObjStr(objv[idx]) : NULL, - noprocs, nocmds, nomixins, inContext); -} - - - - - -static int -XOTclObjInfoNonposargsMethod(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { - XOTclObject *obj; - - if (objc != 3) return XOTclObjErrArgCnt(interp, objv[0], objv[1], ""); - if (XOTclObjConvertObject(interp, objv[1], &obj) != TCL_OK) - return XOTclObjErrType(interp, objv[1], "Object"); - - if (obj->nonposArgsTable) { - XOTclNonposArgs *nonposArgs = NonposArgsGet(obj->nonposArgsTable, ObjStr(objv[2])); +static int +XOTclObjInfoNonposargsMethod(Tcl_Interp *interp, XOTclObject *object, char *methodName) { + if (object->nonposArgsTable) { + XOTclNonposArgs *nonposArgs = NonposArgsGet(object->nonposArgsTable, methodName); if (nonposArgs) { Tcl_SetObjResult(interp, NonposArgsFormat(interp, nonposArgs->nonposArgs)); } } return TCL_OK; } -static int -XOTclObjInfoProcsMethod(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { - XOTclObject *obj; - Tcl_Namespace *nsp; +static int +XOTclObjInfoParametercmdMethod(Tcl_Interp *interp, XOTclObject *object, char *pattern) { + if (object->nsPtr) { + return ListMethodKeys(interp, Tcl_Namespace_cmdTable(object->nsPtr), pattern, 1, 0, 0, 0, 1); + } + return TCL_OK; +} - if (objc < 2 || objc > 3) return XOTclObjErrArgCnt(interp, objv[0], NULL, " ?pattern?"); - if (XOTclObjConvertObject(interp, objv[1], &obj) != TCL_OK) - return XOTclObjErrType(interp, objv[1], "Object"); - - nsp = obj->nsPtr; - return nsp ? ListMethodKeys(interp, Tcl_Namespace_cmdTable(nsp), - objc == 3 ? ObjStr(objv[2]) : NULL, - /*noProcs*/ 0, /*noCmds*/ 1, NULL, 0, 0) : TCL_OK; +static int +XOTclObjInfoParentMethod(Tcl_Interp *interp, XOTclObject *object) { + if (object->id) { + Tcl_SetResult(interp, NSCmdFullName(object->id), TCL_VOLATILE); + } + return TCL_OK; } -static int -XOTclObjInfoParentMethod(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { - XOTclObject *obj; - - if (objc != 2) return XOTclObjErrArgCnt(interp, objv[0], NULL, ""); - if (XOTclObjConvertObject(interp, objv[1], &obj) != TCL_OK) - return XOTclObjErrType(interp, objv[1], "Object"); - - return ListParent(interp, obj); +static int +XOTclObjInfoPostMethod(Tcl_Interp *interp, XOTclObject *object, char *methodName) { + if (object->opt) { + XOTclProcAssertion *procs = AssertionFindProcs(object->opt->assertions, methodName); + if (procs) Tcl_SetObjResult(interp, AssertionList(interp, procs->post)); + } + return TCL_OK; } -static int -XOTclObjInfoPreMethod(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { - XOTclObject *obj; - XOTclObjectOpt *opt; - - if (objc != 3) return XOTclObjErrArgCnt(interp, objv[0], NULL, " "); - if (XOTclObjConvertObject(interp, objv[1], &obj) != TCL_OK) - return XOTclObjErrType(interp, objv[1], "Object"); - - opt = obj->opt; - if (opt) { - XOTclProcAssertion *procs = AssertionFindProcs(opt->assertions, ObjStr(objv[2])); +static int +XOTclObjInfoPreMethod(Tcl_Interp *interp, XOTclObject *object, char *methodName) { + if (object->opt) { + XOTclProcAssertion *procs = AssertionFindProcs(object->opt->assertions, methodName); if (procs) Tcl_SetObjResult(interp, AssertionList(interp, procs->pre)); } return TCL_OK; } -static int -XOTclObjInfoPostMethod(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { - XOTclObject *obj; - XOTclObjectOpt *opt; +static int +XOTclObjInfoPrecedenceMethod(Tcl_Interp *interp, XOTclObject *object, int withIntrinsicOnly, char *pattern) { + XOTclClasses *precedenceList = NULL, *pl; - if (objc != 3) return XOTclObjErrArgCnt(interp, objv[0], NULL, " "); - if (XOTclObjConvertObject(interp, objv[1], &obj) != TCL_OK) - return XOTclObjErrType(interp, objv[1], "Object"); - - opt = obj->opt; - if (opt) { - XOTclProcAssertion *procs = AssertionFindProcs(opt->assertions, ObjStr(objv[2])); - if (procs) Tcl_SetObjResult(interp, AssertionList(interp, procs->post)); + precedenceList = ComputePrecedenceList(interp, object, pattern, !withIntrinsicOnly); + for (pl = precedenceList; pl; pl = pl->nextPtr) { + char *name = className(pl->cl); + Tcl_AppendElement(interp, name); } + XOTclClassListFree(pl); return TCL_OK; } -static int -getModifiers(int objc, int offset, Tcl_Obj *CONST objv[], CONST char *options[], int *set) { - int i, j, found, count = 0; - char *to; +static int +XOTclObjInfoProcsMethod(Tcl_Interp *interp, XOTclObject *object, char *pattern) { + return object->nsPtr ? ListMethodKeys(interp, Tcl_Namespace_cmdTable(object->nsPtr), + pattern, /*noProcs*/ 0, /*noCmds*/ 1, NULL, 0, 0) : TCL_OK; +} - *set = 0; - for (i = offset; i < objc; i++) { - to = ObjStr(objv[i]); - if (to[0] == '-') { - found = 0; - for (j=0; options[j]; j++) { - /*fprintf(stderr, "getMod '%s' '%s' => %d\n",to, options[j],strcmp(to,options[j]));*/ - if (strcmp(to,options[j]) == 0) { - count++; - *set |= 1 << j; - found = 1; - } - } - /* if we find a modifier that was not given, stop processing */ - if (!found) break; - /* '--' stops modifiers */ - if (to[1] == '-') break; - } - } - return count; +static int +XOTclObjInfoSlotObjectsMethod(Tcl_Interp *interp, XOTclObject *object, char *pattern) { + return ListSlotObjects(interp, object, pattern); } -static int -XOTclObjInfoPrecedenceMethod(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { - XOTclObject *obj; - static CONST char *options[] = {"-intrinsic", NULL}; - int modifiers, withPrecedence, set, args; - char *pattern; - - modifiers = getModifiers(objc, 2, objv, options, &set); - args = objc-modifiers; - - if (args < 2 || args > 3) - return XOTclObjErrArgCnt(interp, objv[0], NULL, " ?-intrinsic? ?pattern?"); - pattern = args == 3 ? ObjStr(objv[objc-1]) : NULL; - - if (XOTclObjConvertObject(interp, objv[1], &obj) != TCL_OK) - return XOTclObjErrType(interp, objv[1], "Object"); - - withPrecedence = (modifiers>0); - return ListPrecedence(interp, obj, pattern, withPrecedence); +static int +XOTclObjInfoVarsMethod(Tcl_Interp *interp, XOTclObject *object, char *pattern) { + return ListVars(interp, object, pattern); } -static int -XOTclObjInfoVarsMethod(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { - XOTclObject *obj; +/** TODO 2 calls above single List* occurance **/ - if (objc < 2 || objc > 3) return XOTclObjErrArgCnt(interp, objv[0], NULL, " ?pattern?"); - if (XOTclObjConvertObject(interp, objv[1], &obj) != TCL_OK) - return XOTclObjErrType(interp, objv[1], "Object"); - - return ListVars(interp, obj, objc == 3 ? ObjStr(objv[2]) : NULL); -} +/*************************** + * End Object Info Methods + ***************************/ static int XOTclOProcMethod(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]) { @@ -14186,19 +13975,19 @@ {"filterguard", XOTclObjInfoFilterguardMethodStub}, {"forward", XOTclObjInfoForwardMethodStub}, {"hasnamespace", XOTclObjInfoHasnamespaceMethodStub}, - {"invar", XOTclObjInfoInvarMethod}, - {"methods", XOTclObjInfoMethodsMethod}, - {"mixin", XOTclObjInfoMixinMethod}, - {"mixinguard", XOTclObjInfoMixinguardMethod}, - {"nonposargs", XOTclObjInfoNonposargsMethod}, - {"parent", XOTclObjInfoParentMethod}, - {"parametercmd", XOTclObjInfoParametercmdMethod}, - {"post", XOTclObjInfoPostMethod}, - {"pre", XOTclObjInfoPreMethod}, - {"procs", XOTclObjInfoProcsMethod}, - {"precedence", XOTclObjInfoPrecedenceMethod}, - {"slotobjects", XOTclObjInfoSlotObjectsMethod}, - {"vars", XOTclObjInfoVarsMethod} + {"invar", XOTclObjInfoInvarMethodStub}, + {"methods", XOTclObjInfoMethodsMethodStub}, + {"mixin", XOTclObjInfoMixinMethodStub}, + {"mixinguard", XOTclObjInfoMixinguardMethodStub}, + {"nonposargs", XOTclObjInfoNonposargsMethodStub}, + {"parent", XOTclObjInfoParentMethodStub}, + {"parametercmd", XOTclObjInfoParametercmdMethodStub}, + {"post", XOTclObjInfoPostMethodStub}, + {"pre", XOTclObjInfoPreMethodStub}, + {"procs", XOTclObjInfoProcsMethodStub}, + {"precedence", XOTclObjInfoPrecedenceMethodStub}, + {"slotobjects", XOTclObjInfoSlotObjectsMethodStub}, + {"vars", XOTclObjInfoVarsMethodStub} }; methodDefinition definitions5[] = { {"heritage", XOTclClassInfoHeritageMethodStub},