Index: TODO =================================================================== diff -u -r9a1e1f585cad423f82dd15dbe974f8b1e5998f71 -re9d5dd4af67bdeeaa3052f5c010d135d899a6dd6 --- TODO (.../TODO) (revision 9a1e1f585cad423f82dd15dbe974f8b1e5998f71) +++ TODO (.../TODO) (revision e9d5dd4af67bdeeaa3052f5c010d135d899a6dd6) @@ -2706,9 +2706,19 @@ (was only there for "/obj/ info mixin classes") * extended regression test +- nsf.c + * first version of c-bases "info slots" for classes + * switch "-closure" just for class info method TODO: +- missing in c-based "info slots": + * handling of pattern (needed?) + * regression tests (eg. "$cls class info slots" vs. "$cls info slots", "-closure") + * base objectparameter on "info slots" +- The following is unsafe, but used in nx.tcl (and maybe as well by xotcl2.tcl) + obj method foo {{x ""}} { bar ... {*}$x } + - MixinComputeOrderFullList() could receive a flag to store source classes in checkList - if the check on eg. info-heritage-circular in test/info.method.tcl Index: generic/gentclAPI.decls =================================================================== diff -u -r9a1e1f585cad423f82dd15dbe974f8b1e5998f71 -re9d5dd4af67bdeeaa3052f5c010d135d899a6dd6 --- generic/gentclAPI.decls (.../gentclAPI.decls) (revision 9a1e1f585cad423f82dd15dbe974f8b1e5998f71) +++ generic/gentclAPI.decls (.../gentclAPI.decls) (revision e9d5dd4af67bdeeaa3052f5c010d135d899a6dd6) @@ -399,6 +399,10 @@ {-argName "-scope" -required 0 -nrargs 1 -type "all|class|object"} {-argName "pattern" -type objpattern} } +classInfoMethod slots NsfClassInfoSlotsMethod { + {-argName "-closure"} + {-argName "-type" -required 0 -nrargs 1 -type class} +} classInfoMethod subclass NsfClassInfoSubclassMethod { {-argName "-closure"} {-argName "pattern" -type objpattern} Index: generic/nsf.c =================================================================== diff -u -r9a1e1f585cad423f82dd15dbe974f8b1e5998f71 -re9d5dd4af67bdeeaa3052f5c010d135d899a6dd6 --- generic/nsf.c (.../nsf.c) (revision 9a1e1f585cad423f82dd15dbe974f8b1e5998f71) +++ generic/nsf.c (.../nsf.c) (revision e9d5dd4af67bdeeaa3052f5c010d135d899a6dd6) @@ -10355,25 +10355,35 @@ return body; } - +/* + *---------------------------------------------------------------------- + * ComputeSlotObjects -- + * + * Compute the list of slots for a given precedence list (class list). + * + * Results: + * A list of NsfObjects or NULL + * + * Side effects: + * Returned List has to be freed by the caller + * + *---------------------------------------------------------------------- + */ static NsfObjects * -ComputeSlotObjects(Tcl_Interp *interp, NsfObject *object, NsfClass *type, int withRootClass) { +ComputeSlotObjects(Tcl_Interp *interp, NsfClasses *precedenceList, NsfClass *type) { NsfObjects *slotObjects = NULL, **npl = &slotObjects; - NsfClasses *pl, *fullPrecendenceList; NsfObject *childObject, *tmpObject; Tcl_HashTable slotTable; + NsfClasses *clPtr; - assert(object); - Tcl_InitHashTable(&slotTable, TCL_STRING_KEYS); MEM_COUNT_ALLOC("Tcl_InitHashTable", slotTable); - fullPrecendenceList = ComputePrecedenceList(interp, object, NULL /* pattern*/, 1, withRootClass); - for (pl = fullPrecendenceList; pl; pl = pl->nextPtr) { + for (clPtr = precedenceList; clPtr; clPtr = clPtr->nextPtr) { Tcl_DString ds, *dsPtr = &ds; DSTRING_INIT(dsPtr); - Tcl_DStringAppend(dsPtr, ClassName(pl->cl), -1); + Tcl_DStringAppend(dsPtr, ClassName(clPtr->cl), -1); Tcl_DStringAppend(dsPtr, "::slot", 6); tmpObject = GetObjectFromString(interp, Tcl_DStringValue(dsPtr)); if (tmpObject) { @@ -10404,11 +10414,12 @@ Tcl_DeleteHashTable(&slotTable); MEM_COUNT_FREE("Tcl_InitHashTable", slotTable); - NsfClassListFree(fullPrecendenceList); - return slotObjects; } + + + static NsfClass * FindCalledClass(Tcl_Interp *interp, NsfObject *object) { NsfCallStackContent *cscPtr = CallStackGetTopFrame(interp, NULL); @@ -18731,13 +18742,18 @@ NsfObjInfoLookupSlotsMethod(Tcl_Interp *interp, NsfObject *object, NsfClass *type) { NsfObjects *pl, *slotObjects; Tcl_Obj *list = Tcl_NewListObj(0, NULL); + NsfClasses *fullPrecendenceList; - slotObjects = ComputeSlotObjects(interp, object, type, 1); + fullPrecendenceList = ComputePrecedenceList(interp, object, NULL /* pattern*/, 1, 1); + slotObjects = ComputeSlotObjects(interp, fullPrecendenceList, type); + for (pl=slotObjects; pl; pl = pl->nextPtr) { Tcl_ListObjAppendElement(interp, list, pl->obj->cmdName); } + NsfClassListFree(fullPrecendenceList); NsfObjectListFree(slotObjects); + Tcl_SetObjResult(interp, list); return TCL_OK; } @@ -18942,19 +18958,15 @@ static int NsfClassInfoHeritageMethod(Tcl_Interp *interp, NsfClass *cl, CONST char *pattern) { NsfClasses *pl, *intrinsic, *checkList = NULL, *mixinClasses = NULL; - int withMixins = 1; Tcl_ResetResult(interp); - intrinsic = ComputeOrder(cl, cl->order, Super); - if (withMixins) { - NsfClassListAddPerClassMixins(interp, cl, &mixinClasses, &checkList); - for (pl = mixinClasses; pl; pl = pl->nextPtr) { - if (NsfClassListFind(pl->nextPtr, pl->cl) == NULL && - NsfClassListFind(intrinsic, pl->cl) == NULL) { - AppendMatchingElement(interp, pl->cl->object.cmdName, pattern); - } + NsfClassListAddPerClassMixins(interp, cl, &mixinClasses, &checkList); + for (pl = mixinClasses; pl; pl = pl->nextPtr) { + if (NsfClassListFind(pl->nextPtr, pl->cl) == NULL && + NsfClassListFind(intrinsic, pl->cl) == NULL) { + AppendMatchingElement(interp, pl->cl->object.cmdName, pattern); } } @@ -19184,6 +19196,53 @@ } /* +classInfoMethod slots NsfClassInfoSlotsMethod { + {-argName "-closure"} + {-argName "-type" -required 0 -nrargs 1 -type class} +} +*/ +static int +NsfClassInfoSlotsMethod(Tcl_Interp *interp, NsfClass *class, int withClosure, NsfClass *type) { + NsfClasses *clPtr, *intrinsic, *checkList = NULL, *mixinClasses = NULL, + *precedenceList = NULL; + Tcl_Obj *list = Tcl_NewListObj(0, NULL); + NsfObjects *pl, *slotObjects; + + Tcl_ResetResult(interp); + intrinsic = ComputeOrder(class, class->order, Super); + + if (withClosure) { + NsfClassListAddPerClassMixins(interp, class, &mixinClasses, &checkList); + for (clPtr = mixinClasses; clPtr; clPtr = clPtr->nextPtr) { + if (NsfClassListFind(clPtr->nextPtr, clPtr->cl) == NULL && + NsfClassListFind(intrinsic, clPtr->cl) == NULL) { + NsfClassListAdd(&precedenceList, clPtr->cl, NULL); + } + } + for (clPtr = intrinsic->nextPtr; clPtr; clPtr = clPtr->nextPtr) { + NsfClassListAdd(&precedenceList, clPtr->cl, NULL); + } + } else { + NsfClassListAdd(&precedenceList, class, NULL); + } + + slotObjects = ComputeSlotObjects(interp, precedenceList, type); + + for (pl = slotObjects; pl; pl = pl->nextPtr) { + Tcl_ListObjAppendElement(interp, list, pl->obj->cmdName); + } + + NsfClassListFree(precedenceList); + NsfClassListFree(mixinClasses); + NsfClassListFree(checkList); + NsfObjectListFree(slotObjects); + + Tcl_SetObjResult(interp, list); + return TCL_OK; +} + + +/* classInfoMethod subclass NsfClassInfoSubclassMethod { {-argName "-closure"} {-argName "pattern" -type objpattern} Index: generic/tclAPI.h =================================================================== diff -u -r9a1e1f585cad423f82dd15dbe974f8b1e5998f71 -re9d5dd4af67bdeeaa3052f5c010d135d899a6dd6 --- generic/tclAPI.h (.../tclAPI.h) (revision 9a1e1f585cad423f82dd15dbe974f8b1e5998f71) +++ generic/tclAPI.h (.../tclAPI.h) (revision e9d5dd4af67bdeeaa3052f5c010d135d899a6dd6) @@ -200,6 +200,7 @@ static int NsfClassInfoMixinOfMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int NsfClassInfoMixinclassesMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int NsfClassInfoMixinguardMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); +static int NsfClassInfoSlotsMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int NsfClassInfoSubclassMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int NsfClassInfoSuperclassMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int NsfAliasCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); @@ -289,6 +290,7 @@ 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, int withHeritage, CONST char *patternString, NsfObject *patternObj); static int NsfClassInfoMixinguardMethod(Tcl_Interp *interp, NsfClass *cl, CONST char *mixin); +static int NsfClassInfoSlotsMethod(Tcl_Interp *interp, NsfClass *cl, int withClosure, NsfClass *withType); static int NsfClassInfoSubclassMethod(Tcl_Interp *interp, NsfClass *cl, int withClosure, CONST char *patternString, NsfObject *patternObj); static int NsfClassInfoSuperclassMethod(Tcl_Interp *interp, NsfClass *cl, int withClosure, Tcl_Obj *pattern); static int NsfAliasCmd(Tcl_Interp *interp, NsfObject *object, int withPer_object, CONST char *methodName, int withFrame, Tcl_Obj *cmdName); @@ -379,6 +381,7 @@ NsfClassInfoMixinOfMethodIdx, NsfClassInfoMixinclassesMethodIdx, NsfClassInfoMixinguardMethodIdx, + NsfClassInfoSlotsMethodIdx, NsfClassInfoSubclassMethodIdx, NsfClassInfoSuperclassMethodIdx, NsfAliasCmdIdx, @@ -844,6 +847,26 @@ } static int +NsfClassInfoSlotsMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { + ParseContext pc; + NsfClass *cl = NsfObjectToClass(clientData); + if (!cl) return NsfDispatchClientDataError(interp, clientData, "class", "slots"); + if (ArgumentParse(interp, objc, objv, (NsfObject *) cl, objv[0], + method_definitions[NsfClassInfoSlotsMethodIdx].paramDefs, + method_definitions[NsfClassInfoSlotsMethodIdx].nrParameters, 1, + &pc) != TCL_OK) { + return TCL_ERROR; + } else { + int withClosure = (int )PTR2INT(pc.clientData[0]); + NsfClass *withType = (NsfClass *)pc.clientData[1]; + + assert(pc.status == 0); + return NsfClassInfoSlotsMethod(interp, cl, withClosure, withType); + + } +} + +static int NsfClassInfoSubclassMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { ParseContext pc; NsfClass *cl = NsfObjectToClass(clientData); @@ -2238,6 +2261,10 @@ {"::nsf::methods::class::info::mixinguard", NsfClassInfoMixinguardMethodStub, 1, { {"mixin", NSF_ARG_REQUIRED, 0, Nsf_ConvertToString, NULL,NULL,NULL,NULL,NULL,NULL,NULL}} }, +{"::nsf::methods::class::info::slots", NsfClassInfoSlotsMethodStub, 2, { + {"-closure", 0, 0, Nsf_ConvertToString, NULL,NULL,NULL,NULL,NULL,NULL,NULL}, + {"-type", 0, 1, Nsf_ConvertToClass, NULL,NULL,NULL,NULL,NULL,NULL,NULL}} +}, {"::nsf::methods::class::info::subclass", NsfClassInfoSubclassMethodStub, 2, { {"-closure", 0, 0, Nsf_ConvertToString, NULL,NULL,NULL,NULL,NULL,NULL,NULL}, {"pattern", 0, 0, ConvertToObjpattern, NULL,NULL,NULL,NULL,NULL,NULL,NULL}} Index: library/nx/nx.tcl =================================================================== diff -u -rab02510271f298ae1c4b3aa585a018badc84b013 -re9d5dd4af67bdeeaa3052f5c010d135d899a6dd6 --- library/nx/nx.tcl (.../nx.tcl) (revision ab02510271f298ae1c4b3aa585a018badc84b013) +++ library/nx/nx.tcl (.../nx.tcl) (revision e9d5dd4af67bdeeaa3052f5c010d135d899a6dd6) @@ -531,14 +531,18 @@ :alias "info lookup" ::nx::Object::slot::__info::lookup :alias "info filter guard" ::nsf::methods::class::info::filterguard :alias "info filter methods" ::nsf::methods::class::info::filtermethods - #:alias "info forward" ::nsf::methods::class::info::forward :alias "info has" ::nx::Object::slot::__info::has :alias "info heritage" ::nsf::methods::class::info::heritage :alias "info instances" ::nsf::methods::class::info::instances :alias "info methods" ::nsf::methods::class::info::methods :alias "info mixin guard" ::nsf::methods::class::info::mixinguard :alias "info mixin classes" ::nsf::methods::class::info::mixinclasses :alias "info mixinof" ::nsf::methods::class::info::mixinof + :method "info slots" {{-type ::nx::Slot} pattern:optional} { + set cmd [list ::nsf::methods::class::info::slots -type $type] + if {[info exists pattern]} {lappend cmd $pattern} + ::nsf::my {*}$cmd + } :alias "info subclass" ::nsf::methods::class::info::subclass :alias "info superclass" ::nsf::methods::class::info::superclass } Index: tests/info-method.test =================================================================== diff -u -r9a1e1f585cad423f82dd15dbe974f8b1e5998f71 -re9d5dd4af67bdeeaa3052f5c010d135d899a6dd6 --- tests/info-method.test (.../info-method.test) (revision 9a1e1f585cad423f82dd15dbe974f8b1e5998f71) +++ tests/info-method.test (.../info-method.test) (revision e9d5dd4af67bdeeaa3052f5c010d135d899a6dd6) @@ -633,7 +633,7 @@ C mixin PCM ? {C info heritage} "::PCM ::A ::nx::Object" ? {C info mixin classes} "::PCM" - ? {C info mixin classes -order} "" ;# ???? + ? {C info mixin classes -order} "" ;# ???? why no warning ? {C info mixin classes -heritage} "::PCM ::A" ? {C info mixin classes -closure} "::PCM" @@ -672,7 +672,9 @@ ? {B info mixin classes} "::PCMB" ? {C info mixin classes} "" - # the classes mixed transitive into this class + # the classes mixed transitive into this class; This answer the + # question, what classes were mixed in explicitly into the mixin + # hierarchy by the application program ? {B info mixin classes -closure} "::PCMB" # since C is a specialization of B, it includes transitively B's closure ? {C info mixin classes -closure} "::PCMB"