Index: TODO =================================================================== diff -u -ra74bd5cdede9d48d0a225a27e1d710a7189b65d1 -rb70d9bb2e0b19e3cb5f397a4b168d79d3047ceb9 --- TODO (.../TODO) (revision a74bd5cdede9d48d0a225a27e1d710a7189b65d1) +++ TODO (.../TODO) (revision b70d9bb2e0b19e3cb5f397a4b168d79d3047ceb9) @@ -1595,7 +1595,20 @@ from protection - serializer: experimental code to serialize submethods +- new option "-expand" for "obj|class info methods" to + return compound names (i.e. it lists the full ensemble names) + Example: + ::nx::Object info methods -expand "*filter*" + returns + filter {info filter guard} {info filter methods} {info lookup filter} +- allow ensemble names in nsf::methodproperty +- fix compound name lookups when aliases link to shared ensemble objects +- make objectName() NULL-safe +- fix option "-source application" when applied directly on base-classes +- extend regression test + TODO: +- check feasbility of "info lookup methods -expand" - handing of xo::at_cleanup in serializer (either generailization or move to OpenACS/aolserver init/naviserver init) - cleanup of xotcl-aol Index: generic/gentclAPI.decls =================================================================== diff -u -rca94e89f9a531dd4c58e22f1b87c0b941689799a -rb70d9bb2e0b19e3cb5f397a4b168d79d3047ceb9 --- generic/gentclAPI.decls (.../gentclAPI.decls) (revision ca94e89f9a531dd4c58e22f1b87c0b941689799a) +++ generic/gentclAPI.decls (.../gentclAPI.decls) (revision b70d9bb2e0b19e3cb5f397a4b168d79d3047ceb9) @@ -272,6 +272,7 @@ objectInfoMethod methods NsfObjInfoMethodsMethod { {-argName "-methodtype" -nrargs 1 -type "all|scripted|builtin|alias|forwarder|object|setter"} {-argName "-callprotection" -nrargs 1 -type "all|protected|public" -default public} + {-argName "-expand"} {-argName "-nomixins"} {-argName "-incontext"} {-argName "pattern"} @@ -324,6 +325,7 @@ classInfoMethod methods NsfClassInfoMethodsMethod { {-argName "-methodtype" -nrargs 1 -type "all|scripted|builtin|alias|forwarder|object|setter"} {-argName "-callprotection" -nrargs 1 -type "all|protected|public" -default public} + {-argName "-expand"} {-argName "-nomixins"} {-argName "-incontext"} {-argName "pattern"} Index: generic/nsf.c =================================================================== diff -u -rf9137631628e63299b75d53a3d502a39c21d67ad -rb70d9bb2e0b19e3cb5f397a4b168d79d3047ceb9 --- generic/nsf.c (.../nsf.c) (revision f9137631628e63299b75d53a3d502a39c21d67ad) +++ generic/nsf.c (.../nsf.c) (revision b70d9bb2e0b19e3cb5f397a4b168d79d3047ceb9) @@ -260,7 +260,7 @@ static int SetInstVar(Tcl_Interp *interp, NsfObject *object, Tcl_Obj *nameObj, Tcl_Obj *valueObj); static int ListDefinedMethods(Tcl_Interp *interp, NsfObject *object, CONST char *pattern, int withPer_object, int methodType, int withCallproctection, - int noMixins, int inContext); + int withExpand, int noMixins, int inContext); static int NextSearchAndInvoke(Tcl_Interp *interp, CONST char *methodName, int objc, Tcl_Obj *CONST objv[], NsfCallStackContent *cscPtr, int freeArgumentVector); @@ -1131,7 +1131,7 @@ * GetRegObject -- * * Try to get the object, on which the method was registered from a - * folly qaulified method handle + * fully qualified method handle * * Results: * NsfObject * or NULL on failure @@ -1160,7 +1160,7 @@ } Tcl_DStringFree(dsPtr); } - } + } /*fprintf(stderr, "GetRegObject cmd %p methodName '%s' => %p\n", cmd, methodName, regObject);*/ return regObject; @@ -1196,9 +1196,11 @@ char* methodName = ObjStr(methodObj); if (strchr(methodName, ' ') > 0) { + Tcl_Namespace *parentNsPtr; + NsfObject *ensembleObject; Tcl_Obj *methodHandleObj; - Tcl_Obj **ov; int oc, result, i; + Tcl_Obj **ov; /*fprintf(stderr, "name '%s' contains space \n", methodName);*/ @@ -1220,21 +1222,42 @@ */ *regObject = GetRegObject(interp, cmd, ObjStr(ov[0]), methodName1, fromClassNS); - /*fprintf(stderr, "... referenced object '%s' reg %p\n", - objectName(referencedObject), *regObject);*/ + /*fprintf(stderr, "... regObject object '%s' reg %p, fromClassNS %d\n", + objectName(referencedObject), *regObject, *fromClassNS);*/ /* * Build a fresh methodHandleObj to held method name and names of * subcmds. */ methodHandleObj = Tcl_DuplicateObj(referencedObject->cmdName); Tcl_DStringAppend(methodNameDs, Tcl_GetCommandName(interp, cmd), -1); + parentNsPtr = NULL; /* * Iterate over the objects and append to the handle and methodObj */ - for (i = 1; iid) != parentNsPtr) { + /* fprintf(stderr, "*** parent change saved parent %p %s computed parent %p %s\n", + parentNsPtr, parentNsPtr->fullName, + Tcl_Command_nsPtr(ensembleObject->id), + Tcl_Command_nsPtr(ensembleObject->id)->fullName);*/ + DECR_REF_COUNT(methodHandleObj); + methodHandleObj = Tcl_DuplicateObj(ensembleObject->cmdName); + } + parentNsPtr = ensembleObject->nsPtr; + Tcl_AppendLimitedToObj(methodHandleObj, "::", 2, INT_MAX, NULL); Tcl_AppendLimitedToObj(methodHandleObj, ObjStr(ov[i]), -1, INT_MAX, NULL); Tcl_DStringAppendElement(methodNameDs, ObjStr(ov[i])); @@ -1246,8 +1269,8 @@ */ *defObject = NsfGetObjectFromCmdPtr(cmd); - /* fprintf(stderr, "... handle '%s' last cmd %p defObject %p\n", - ObjStr(methodHandleObj), cmd, *defObject);*/ + /*fprintf(stderr, "... handle '%s' last cmd %p defObject %p\n", + ObjStr(methodHandleObj), cmd, *defObject);*/ /* * Obtain the command from the method handle and report back the @@ -1256,7 +1279,7 @@ cmd = Tcl_GetCommandFromObj(interp, methodHandleObj); *methodName1 = Tcl_DStringValue(methodNameDs); - /*fprintf(stderr, "... methodname1 '%s' \n", *methodName1);*/ + /*fprintf(stderr, "... methodname1 '%s' cmd %p\n", *methodName1, cmd);*/ DECR_REF_COUNT(methodHandleObj); } else if (*methodName == ':') { @@ -11190,7 +11213,7 @@ NsfObject *subObject = NsfGetObjectFromCmdPtr(cmd); if (subObject) { return ListDefinedMethods(interp, subObject, NULL, 1 /* per-object */, - NSF_METHODTYPE_ALL, CallprotectionAllIdx, 1, 0); + NSF_METHODTYPE_ALL, CallprotectionAllIdx, 0, 1, 0); } } /* all other cases return emtpy */ @@ -11393,7 +11416,7 @@ return result; } -static int MethodSourceMatches(Tcl_Interp *interp, int withSource, NsfClass *cl) { +static int MethodSourceMatches(Tcl_Interp *interp, int withSource, NsfClass *cl, NsfObject *object) { int isBaseClass; if (withSource == SourceAllIdx) { return 1; @@ -11402,7 +11425,7 @@ /* If the method is object specific, it can't be from a baseclass * and must be application specfic. */ - return (withSource == SourceApplicationIdx); + return (withSource == SourceApplicationIdx && !IsBaseClass((NsfClass *)object)); } isBaseClass = IsBaseClass(cl); if (withSource == SourceBaseclassesIdx && isBaseClass) { @@ -11415,14 +11438,20 @@ static int MethodTypeMatches(Tcl_Interp *interp, int methodType, Tcl_Command cmd, - NsfObject *object, CONST char *key, int withPer_object) { + NsfObject *object, CONST char *key, int withPer_object, int *isObject) { Tcl_Command importedCmd; Tcl_ObjCmdProc *proc, *resolvedProc; proc = Tcl_Command_objProc(cmd); importedCmd = GetOriginalCommand(cmd); resolvedProc = Tcl_Command_objProc(importedCmd); + /* + * Return always state isObject, since the cmd might be an ensemble, + * where we have to search further + */ + *isObject = (resolvedProc == NsfObjDispatch); + if (methodType == NSF_METHODTYPE_ALIAS) { if (!(proc == NsfProcAliasMethod || AliasGet(interp, object->cmdName, key, withPer_object))) { return 0; @@ -11451,30 +11480,37 @@ } static int -ListMethodKeys(Tcl_Interp *interp, Tcl_HashTable *tablePtr, CONST char *pattern, - int methodType, int withCallprotection, +ListMethodKeys(Tcl_Interp *interp, Tcl_HashTable *tablePtr, + Tcl_DString *prefix, CONST char *pattern, + int methodType, int withCallprotection, int withExpand, Tcl_HashTable *dups, NsfObject *object, int withPer_object) { Tcl_HashSearch hSrch; Tcl_HashEntry *hPtr, *duphPtr; Tcl_Command cmd; char *key; - int new; + int new, isObject, methodTypeMatch; + int prefixLength = prefix ? Tcl_DStringLength(prefix) : 0; - if (pattern && NoMetaChars(pattern)) { - /* We have a pattern that can be used for direct lookup; - * no need to iterate + if (pattern && NoMetaChars(pattern) && strchr(pattern, ' ') == 0) { + /* + * We have a pattern that can be used for direct lookup; no need + * to iterate */ hPtr = tablePtr ? Tcl_CreateHashEntry(tablePtr, pattern, NULL) : NULL; if (hPtr) { key = Tcl_GetHashKey(tablePtr, hPtr); cmd = (Tcl_Command)Tcl_GetHashValue(hPtr); + methodTypeMatch = MethodTypeMatches(interp, methodType, cmd, object, key, + withPer_object, &isObject); if (Tcl_Command_flags(cmd) & NSF_CMD_CLASS_ONLY_METHOD && !NsfObjectIsClass(object)) { return TCL_OK; } + if (isObject && withExpand) { + return TCL_OK; + } - if (ProtectionMatches(interp, withCallprotection, cmd) - && MethodTypeMatches(interp, methodType, cmd, object, key, withPer_object)) { + if (ProtectionMatches(interp, withCallprotection, cmd) && methodTypeMatch) { if (dups) { duphPtr = Tcl_CreateHashEntry(dups, key, &new); if (new) { @@ -11493,13 +11529,42 @@ for (; hPtr; hPtr = Tcl_NextHashEntry(&hSrch)) { key = Tcl_GetHashKey(tablePtr, hPtr); cmd = (Tcl_Command)Tcl_GetHashValue(hPtr); + if (prefixLength) {Tcl_DStringTrunc(prefix, prefixLength);} + methodTypeMatch = MethodTypeMatches(interp, methodType, cmd, object, key, + withPer_object, &isObject); + if (isObject && withExpand) { + Tcl_DString ds, *dsPtr = &ds; + NsfObject *ensembleObject = NsfGetObjectFromCmdPtr(cmd); + Tcl_HashTable *cmdTable = ensembleObject && ensembleObject->nsPtr ? + Tcl_Namespace_cmdTable(ensembleObject->nsPtr) : NULL; + + if (prefix == NULL) { + DSTRING_INIT(dsPtr); + Tcl_DStringAppend(dsPtr, key, -1); + Tcl_DStringAppend(dsPtr, " ", 1); + ListMethodKeys(interp, cmdTable, dsPtr, pattern, methodType, withCallprotection, + 1, dups, object, withPer_object); + DSTRING_FREE(dsPtr); + } else { + Tcl_DStringAppend(prefix, key, -1); + Tcl_DStringAppend(prefix, " ", 1); + ListMethodKeys(interp, cmdTable, prefix, pattern, methodType, withCallprotection, + 1, dups, object, withPer_object); + } + /* don't list ensembles by themselves */ + continue; + } + if (Tcl_Command_flags(cmd) & NSF_CMD_CLASS_ONLY_METHOD && !NsfObjectIsClass(object)) continue; + if (!ProtectionMatches(interp, withCallprotection, cmd) || !methodTypeMatch) continue; + + if (prefixLength) { + Tcl_DStringAppend(prefix, key, -1); + key = Tcl_DStringValue(prefix); + } + if (pattern && !Tcl_StringMatch(key, pattern)) continue; - if (!ProtectionMatches(interp, withCallprotection, cmd) - || !MethodTypeMatches(interp, methodType, cmd, object, key, withPer_object) - ) continue; - if (dups) { duphPtr = Tcl_CreateHashEntry(dups, key, &new); if (!new) continue; @@ -11581,21 +11646,22 @@ } return NsfVarErrMsg(interp, "'", pattern, "' is not a forwarder", (char *) NULL); } - return ListMethodKeys(interp, tablePtr, pattern, NSF_METHODTYPE_FORWARDER, CallprotectionAllIdx, NULL, NULL, 0); + return ListMethodKeys(interp, tablePtr, NULL, pattern, NSF_METHODTYPE_FORWARDER, + CallprotectionAllIdx, 0, NULL, NULL, 0); } static int ListDefinedMethods(Tcl_Interp *interp, NsfObject *object, CONST char *pattern, int withPer_object, int methodType, int withCallproctection, - int noMixins, int inContext) { + int withExpand, int noMixins, int inContext) { Tcl_HashTable *cmdTable; if (NsfObjectIsClass(object) && !withPer_object) { cmdTable = Tcl_Namespace_cmdTable(((NsfClass *)object)->nsPtr); } else { cmdTable = object->nsPtr ? Tcl_Namespace_cmdTable(object->nsPtr) : NULL; } - ListMethodKeys(interp, cmdTable, pattern, methodType, withCallproctection, + ListMethodKeys(interp, cmdTable, NULL, pattern, methodType, withCallproctection, withExpand, NULL, object, withPer_object); return TCL_OK; } @@ -12589,45 +12655,31 @@ static int NsfMethodPropertyCmd(Tcl_Interp *interp, NsfObject *object, int withPer_object, Tcl_Obj *methodObj, int methodproperty, Tcl_Obj *valueObj) { - CONST char *methodName = ObjStr(methodObj); + CONST char *methodName = ObjStr(methodObj), *methodName1 = NULL; + NsfObject *regObject, *defObject; + Tcl_DString ds, *dsPtr = &ds; Tcl_Command cmd = NULL; - + NsfClass *cl = withPer_object == 0 && NsfObjectIsClass(object) ? (NsfClass *)object : NULL; + int fromClassNS = cl != NULL; + + /*fprintf(stderr, "methodProperty for method '%s' prop %d value %s\n", methodName, methodproperty, valueObj ? ObjStr(valueObj) : "NULL");*/ + + Tcl_DStringInit(dsPtr); + cmd = ResolveMethodName(interp, cl ? cl->nsPtr : object->nsPtr, methodObj, + dsPtr, ®Object, &defObject, &methodName1, &fromClassNS); - if (*methodName == ':') { - cmd = Tcl_GetCommandFromObj(interp, methodObj); - if (!cmd) { - return NsfVarErrMsg(interp, "Cannot lookup object method '", - methodName, "' for object ", objectName(object), - (char *) NULL); - } - } else { - NsfClass *cl; + /*fprintf(stderr, "methodProperty for method '%s' prop %d value %s => cl %p cmd %p\n", + methodName, methodproperty, valueObj ? ObjStr(valueObj) : "NULL", cl, cmd);*/ - if (withPer_object) { - cl = NULL; - } else { - cl = NsfObjectIsClass(object) ? (NsfClass *)object : NULL; - } - - if (cl == NULL) { - if (object->nsPtr) - cmd = FindMethod(object->nsPtr, methodName); - if (!cmd) { - return NsfVarErrMsg(interp, "Cannot lookup object method '", - methodName, "' for object ", objectName(object), - (char *) NULL); - } - } else { - if (cl->nsPtr) - cmd = FindMethod(cl->nsPtr, methodName); - if (!cmd) - return NsfVarErrMsg(interp, "Cannot lookup method '", - methodName, "' from class ", objectName(object), - (char *) NULL); - } + if (!cmd) { + Tcl_DStringFree(dsPtr); + return NsfVarErrMsg(interp, "Cannot lookup object method '", + methodName, "' for object ", objectName(object), + (char *) NULL); } + Tcl_DStringFree(dsPtr); switch (methodproperty) { case MethodpropertyClass_onlyIdx: /* fall through */ @@ -14980,12 +15032,12 @@ case ObjectkindMetaclassIdx: success = NsfObjectIsClass(object) - && IsMetaClass(interp, (NsfClass*)object, 1); + && IsMetaClass(interp, (NsfClass *)object, 1); break; case ObjectkindBaseclassIdx: success = NsfObjectIsClass(object) - && IsBaseClass((NsfClass*)object); + && IsBaseClass((NsfClass *)object); break; } Tcl_SetIntObj(Tcl_GetObjResult(interp), success); @@ -15085,8 +15137,8 @@ Tcl_InitHashTable(dups, TCL_STRING_KEYS); if (object->nsPtr) { cmdTable = Tcl_Namespace_cmdTable(object->nsPtr); - if (MethodSourceMatches(interp, withSource, NULL)) { - ListMethodKeys(interp, cmdTable, pattern, methodType, withCallprotection, + if (MethodSourceMatches(interp, withSource, NULL, object)) { + ListMethodKeys(interp, cmdTable, NULL, pattern, methodType, withCallprotection, 0, dups, object, withPer_object); } } @@ -15108,8 +15160,8 @@ } if (mixin && guardOk == TCL_OK) { Tcl_HashTable *cmdTable = Tcl_Namespace_cmdTable(mixin->nsPtr); - if (!MethodSourceMatches(interp, withSource, mixin)) continue; - ListMethodKeys(interp, cmdTable, pattern, methodType, withCallprotection, + if (!MethodSourceMatches(interp, withSource, mixin, NULL)) continue; + ListMethodKeys(interp, cmdTable, NULL, pattern, methodType, withCallprotection, 0, dups, object, withPer_object); } } @@ -15119,8 +15171,8 @@ /* append method keys from inheritance order */ for (pl = ComputeOrder(object->cl, object->cl->order, Super); pl; pl = pl->nextPtr) { Tcl_HashTable *cmdTable = Tcl_Namespace_cmdTable(pl->cl->nsPtr); - if (!MethodSourceMatches(interp, withSource, pl->cl)) continue; - ListMethodKeys(interp, cmdTable, pattern, methodType, withCallprotection, + if (!MethodSourceMatches(interp, withSource, pl->cl, NULL)) continue; + ListMethodKeys(interp, cmdTable, NULL, pattern, methodType, withCallprotection, 0, dups, object, withPer_object); } Tcl_DeleteHashTable(dups); @@ -15182,18 +15234,19 @@ objectInfoMethod methods NsfObjInfoMethodsMethod { {-argName "-methodtype" -nrargs 1 -type "all|scripted|builtin|alias|forwarder|object|setter"} {-argName "-callprotection" -nrargs 1 -type "all|protected|public" -default public} + {-argName "-expand"} {-argName "-nomixins"} {-argName "-incontext"} {-argName "pattern"} } */ static int NsfObjInfoMethodsMethod(Tcl_Interp *interp, NsfObject *object, - int withMethodtype, int withCallproctection, - int withNomixins, int withIncontext, CONST char *pattern) { + int withMethodtype, int withCallproctection, int withExpand, + int withNomixins, int withIncontext, CONST char *pattern) { return ListDefinedMethods(interp, object, pattern, 1 /* per-object */, AggregatedMethodType(withMethodtype), withCallproctection, - withNomixins, withIncontext); + withExpand, withNomixins, withIncontext); } /* @@ -15365,7 +15418,7 @@ hPtr = Tcl_NextHashEntry(&search)) { NsfObject *inst = (NsfObject*) Tcl_GetHashKey(tablePtr, hPtr); /*fprintf(stderr, "match '%s' %p %p '%s'\n", - matchObject ? objectName(matchObject) : "NULL", matchObject, inst, objectName(inst));*/ + objectName(matchObject), matchObject, inst, objectName(inst));*/ if (matchObject && inst == matchObject) { Tcl_SetObjResult(interp, matchObject->cmdName); return 1; @@ -15430,6 +15483,7 @@ classInfoMethod methods NsfClassInfoMethodsMethod { {-argName "-methodtype" -nrargs 1 -type "all|scripted|builtin|alias|forwarder|object|setter"} {-argName "-callprotection" -nrargs 1 -type "all|protected|public" -default public} + {-argName "-expand"} {-argName "-nomixins"} {-argName "-incontext"} {-argName "pattern"} @@ -15438,10 +15492,11 @@ static int NsfClassInfoMethodsMethod(Tcl_Interp *interp, NsfClass *class, int withMethodtype, int withCallproctection, - int withNomixins, int withIncontext, CONST char *pattern) { + int withExpand, int withNomixins, int withIncontext, + CONST char *pattern) { return ListDefinedMethods(interp, &class->object, pattern, 0 /* per-object */, - AggregatedMethodType(withMethodtype), withCallproctection, - withNomixins, withIncontext); + AggregatedMethodType(withMethodtype), withCallproctection, + withExpand, withNomixins, withIncontext); } /* @@ -15803,7 +15858,7 @@ if (object->refCount != 1) { fprintf(stderr, "*** have to fix refcount for obj %p refcount %d",object, object->refCount); if (object->refCount > 1) { - fprintf(stderr, " (name %s)",objectName(object)); + fprintf(stderr, " (name %s)", objectName(object)); } fprintf(stderr, "\n"); object->refCount = 1; Index: generic/nsfInt.h =================================================================== diff -u -r16ecd9a1e7a06eb966b2d51d4a1c59457ab25d11 -rb70d9bb2e0b19e3cb5f397a4b168d79d3047ceb9 --- generic/nsfInt.h (.../nsfInt.h) (revision 16ecd9a1e7a06eb966b2d51d4a1c59457ab25d11) +++ generic/nsfInt.h (.../nsfInt.h) (revision b70d9bb2e0b19e3cb5f397a4b168d79d3047ceb9) @@ -230,8 +230,8 @@ # define PRINTOBJ(ctx,obj) #endif -#define className(cl) (cl ? ObjStr(cl->object.cmdName) : "") -#define objectName(obj) (ObjStr(obj->cmdName)) +#define className(cl) (((cl) ? ObjStr(cl->object.cmdName) : "NULL")) +#define objectName(obj) (((obj) ? ObjStr(obj->cmdName) : "NULL")) #define LONG_AS_STRING 32 Index: generic/tclAPI.h =================================================================== diff -u -rca94e89f9a531dd4c58e22f1b87c0b941689799a -rb70d9bb2e0b19e3cb5f397a4b168d79d3047ceb9 --- generic/tclAPI.h (.../tclAPI.h) (revision ca94e89f9a531dd4c58e22f1b87c0b941689799a) +++ generic/tclAPI.h (.../tclAPI.h) (revision b70d9bb2e0b19e3cb5f397a4b168d79d3047ceb9) @@ -242,7 +242,7 @@ static int NsfClassInfoHeritageMethod(Tcl_Interp *interp, NsfClass *cl, CONST char *pattern); static int NsfClassInfoInstancesMethod(Tcl_Interp *interp, NsfClass *cl, int withClosure, CONST char *patternString, NsfObject *patternObj); static int NsfClassInfoMethodMethod(Tcl_Interp *interp, NsfClass *cl, int infomethodsubcmd, Tcl_Obj *name); -static int NsfClassInfoMethodsMethod(Tcl_Interp *interp, NsfClass *cl, int withMethodtype, int withCallprotection, int withNomixins, int withIncontext, CONST char *pattern); +static int NsfClassInfoMethodsMethod(Tcl_Interp *interp, NsfClass *cl, int withMethodtype, int withCallprotection, int withExpand, int withNomixins, int withIncontext, CONST char *pattern); static int NsfClassInfoMixinOfMethod(Tcl_Interp *interp, NsfClass *cl, int withClosure, int withScope, CONST char *patternString, NsfObject *patternObj); static int NsfClassInfoMixinclassesMethod(Tcl_Interp *interp, NsfClass *cl, int withClosure, int withGuards, CONST char *patternString, NsfObject *patternObj); static int NsfClassInfoMixinguardMethod(Tcl_Interp *interp, NsfClass *cl, CONST char *mixin); @@ -305,7 +305,7 @@ static int NsfObjInfoLookupMethodsMethod(Tcl_Interp *interp, NsfObject *obj, int withMethodtype, int withCallprotection, int withSource, int withNomixins, int withIncontext, CONST char *pattern); static int NsfObjInfoLookupSlotsMethod(Tcl_Interp *interp, NsfObject *obj, NsfClass *withType); static int NsfObjInfoMethodMethod(Tcl_Interp *interp, NsfObject *obj, int infomethodsubcmd, Tcl_Obj *name); -static int NsfObjInfoMethodsMethod(Tcl_Interp *interp, NsfObject *obj, int withMethodtype, int withCallprotection, int withNomixins, int withIncontext, CONST char *pattern); +static int NsfObjInfoMethodsMethod(Tcl_Interp *interp, NsfObject *obj, int withMethodtype, int withCallprotection, int withExpand, int withNomixins, int withIncontext, CONST char *pattern); static int NsfObjInfoMixinclassesMethod(Tcl_Interp *interp, NsfObject *obj, int withGuards, int withOrder, CONST char *patternString, NsfObject *patternObj); static int NsfObjInfoMixinguardMethod(Tcl_Interp *interp, NsfObject *obj, CONST char *mixin); static int NsfObjInfoParentMethod(Tcl_Interp *interp, NsfObject *obj); @@ -678,12 +678,13 @@ } else { int withMethodtype = (int )PTR2INT(pc.clientData[0]); int withCallprotection = (int )PTR2INT(pc.clientData[1]); - int withNomixins = (int )PTR2INT(pc.clientData[2]); - int withIncontext = (int )PTR2INT(pc.clientData[3]); - CONST char *pattern = (CONST char *)pc.clientData[4]; + int withExpand = (int )PTR2INT(pc.clientData[2]); + int withNomixins = (int )PTR2INT(pc.clientData[3]); + int withIncontext = (int )PTR2INT(pc.clientData[4]); + CONST char *pattern = (CONST char *)pc.clientData[5]; ParseContextRelease(&pc); - return NsfClassInfoMethodsMethod(interp, cl, withMethodtype, withCallprotection, withNomixins, withIncontext, pattern); + return NsfClassInfoMethodsMethod(interp, cl, withMethodtype, withCallprotection, withExpand, withNomixins, withIncontext, pattern); } } @@ -1906,12 +1907,13 @@ } else { int withMethodtype = (int )PTR2INT(pc.clientData[0]); int withCallprotection = (int )PTR2INT(pc.clientData[1]); - int withNomixins = (int )PTR2INT(pc.clientData[2]); - int withIncontext = (int )PTR2INT(pc.clientData[3]); - CONST char *pattern = (CONST char *)pc.clientData[4]; + int withExpand = (int )PTR2INT(pc.clientData[2]); + int withNomixins = (int )PTR2INT(pc.clientData[3]); + int withIncontext = (int )PTR2INT(pc.clientData[4]); + CONST char *pattern = (CONST char *)pc.clientData[5]; ParseContextRelease(&pc); - return NsfObjInfoMethodsMethod(interp, obj, withMethodtype, withCallprotection, withNomixins, withIncontext, pattern); + return NsfObjInfoMethodsMethod(interp, obj, withMethodtype, withCallprotection, withExpand, withNomixins, withIncontext, pattern); } } @@ -2077,9 +2079,10 @@ {"infomethodsubcmd", 0, 0, ConvertToInfomethodsubcmd}, {"name", 0, 0, ConvertToTclobj}} }, -{"::nsf::methods::class::info::methods", NsfClassInfoMethodsMethodStub, 5, { +{"::nsf::methods::class::info::methods", NsfClassInfoMethodsMethodStub, 6, { {"-methodtype", 0, 1, ConvertToMethodtype}, {"-callprotection", 0, 1, ConvertToCallprotection}, + {"-expand", 0, 0, ConvertToString}, {"-nomixins", 0, 0, ConvertToString}, {"-incontext", 0, 0, ConvertToString}, {"pattern", 0, 0, ConvertToString}} @@ -2342,9 +2345,10 @@ {"infomethodsubcmd", 0, 0, ConvertToInfomethodsubcmd}, {"name", 0, 0, ConvertToTclobj}} }, -{"::nsf::methods::object::info::methods", NsfObjInfoMethodsMethodStub, 5, { +{"::nsf::methods::object::info::methods", NsfObjInfoMethodsMethodStub, 6, { {"-methodtype", 0, 1, ConvertToMethodtype}, {"-callprotection", 0, 1, ConvertToCallprotection}, + {"-expand", 0, 0, ConvertToString}, {"-nomixins", 0, 0, ConvertToString}, {"-incontext", 0, 0, ConvertToString}, {"pattern", 0, 0, ConvertToString}} Index: library/nx/nx.tcl =================================================================== diff -u -r7d7f47ce5d7b7c2d252af5d4499b50996f6475ff -rb70d9bb2e0b19e3cb5f397a4b168d79d3047ceb9 --- library/nx/nx.tcl (.../nx.tcl) (revision 7d7f47ce5d7b7c2d252af5d4499b50996f6475ff) +++ library/nx/nx.tcl (.../nx.tcl) (revision b70d9bb2e0b19e3cb5f397a4b168d79d3047ceb9) @@ -1474,7 +1474,6 @@ # on classes. ####################################################### - #puts stderr Class-methods=[lsort [Class info methods]] foreach m [Class info methods] { ::nsf::methodproperty Class $m class-only true } Index: tests/info-method.tcl =================================================================== diff -u -r51725aa434e18e9e3ce656897011c4f40c98d8dd -rb70d9bb2e0b19e3cb5f397a4b168d79d3047ceb9 --- tests/info-method.tcl (.../info-method.tcl) (revision 51725aa434e18e9e3ce656897011c4f40c98d8dd) +++ tests/info-method.tcl (.../info-method.tcl) (revision b70d9bb2e0b19e3cb5f397a4b168d79d3047ceb9) @@ -215,6 +215,9 @@ ? {o mixin ""} "" } +# +# test info slots / info lookup slots +# Test case slots { nx::Class create C { @@ -235,7 +238,9 @@ ? {::nx::Object info method parameter info} "" } - +# +# test info submethod and method handles for submethods +# Test case info-submethod { nx::Object create o { @@ -335,3 +340,22 @@ ? {o info method handle "foo b"} "::o::foo b" } + +# +# test "info methods -expand" +# +Test case info-methods-expand { + ::nx::Object create o1 + ? {::nx::Object info methods "info"} "info" + ? {::nx::Object info methods -expand "info"} "" + ? {lsort [::nx::Object info methods -expand "info lookup *"]} \ + "{info lookup filter} {info lookup method} {info lookup methods} {info lookup slots}" + ? {lsort [::nx::Object info methods -expand "info *method*"]} \ + "{info filter methods} {info lookup method} {info lookup methods} {info method} {info methods}" + ? {lsort [::nx::Object info methods "slots"]} "" + ? {lsort [::nx::Object info methods "*slots*"]} "" + ? {lsort [::nx::Object info methods -expand "*slots*"]} \ + "{info lookup slots} {info slots}" + ? {lsort [::nx::Object info methods -expand "*filter*"]} \ + "filter {info filter guard} {info filter methods} {info lookup filter}" +} \ No newline at end of file