Index: TODO =================================================================== diff -u -r1e14e709ba184c6daf7a2f94605a2cff65d7706c -r99ee1ab0e5d0d04de1dc14cf190b27a0ce9edfcf --- TODO (.../TODO) (revision 1e14e709ba184c6daf7a2f94605a2cff65d7706c) +++ TODO (.../TODO) (revision 99ee1ab0e5d0d04de1dc14cf190b27a0ce9edfcf) @@ -1298,6 +1298,13 @@ - renamed some static definitions on the way to follow Tcl conventions (start with a capital character) +- added flag "-type" to NsfObjInfoChildrenMethod +- added flag "-type" to NsfObjInfoSlotObjectsMethod +- removed dummy argument "pattern" from NsfObjInfoSlotObjectsMethod +- removed NsfClassInfoSlotsMethod (implemented via "children ... -type ...") +- moved "info slots" from nx::Class to nx::Object + (to report e.g. per-object attributes) +- extended regression test TODO: Index: doc/next-migration.html =================================================================== diff -u -r3754364287df2dfdf79b81dfa69224eae19cf691 -r99ee1ab0e5d0d04de1dc14cf190b27a0ce9edfcf --- doc/next-migration.html (.../next-migration.html) (revision 3754364287df2dfdf79b81dfa69224eae19cf691) +++ doc/next-migration.html (.../next-migration.html) (revision 99ee1ab0e5d0d04de1dc14cf190b27a0ce9edfcf) @@ -90,7 +90,8 @@ protection.

  • The Next Scripting Language provides scripted init blocks for - objects and classes (XOTcl used the dash "-" mechanisms to set + objects and classes (replacement for the somewhat dangerous dash "-" + mechanism in XOTcl that allows to set variables and invoke methods upon object creation).

  • The Next Scripting Language provides much more orthogonal means @@ -1435,6 +1436,6 @@
    - Last modified: Wed Sep 1 11:08:17 CEST 2010 + Last modified: Thu Sep 9 08:48:22 CEST 2010 Index: generic/gentclAPI.decls =================================================================== diff -u -r1e14e709ba184c6daf7a2f94605a2cff65d7706c -r99ee1ab0e5d0d04de1dc14cf190b27a0ce9edfcf --- generic/gentclAPI.decls (.../gentclAPI.decls) (revision 1e14e709ba184c6daf7a2f94605a2cff65d7706c) +++ generic/gentclAPI.decls (.../gentclAPI.decls) (revision 99ee1ab0e5d0d04de1dc14cf190b27a0ce9edfcf) @@ -224,6 +224,7 @@ {-argName "pattern" -required 0} } objectInfoMethod children NsfObjInfoChildrenMethod { + {-argName "-type" -required 0 -nrargs 1 -type class} {-argName "pattern" -required 0} } objectInfoMethod class NsfObjInfoClassMethod { @@ -278,7 +279,7 @@ {-argName "pattern" -required 0} } objectInfoMethod slotobjects NsfObjInfoSlotObjectsMethod { - {-argName "pattern" -required 0} + {-argName "-type" -required 0 -nrargs 1 -type class} } objectInfoMethod vars NsfObjInfoVarsMethod { {-argName "pattern" -required 0} @@ -330,8 +331,6 @@ {-argName "-scope" -required 0 -nrargs 1 -type "all|class|object"} {-argName "pattern" -type objpattern} } -classInfoMethod slots NsfClassInfoSlotsMethod { -} classInfoMethod subclass NsfClassInfoSubclassMethod { {-argName "-closure"} {-argName "pattern" -type objpattern} Index: generic/nsf.c =================================================================== diff -u -r1e14e709ba184c6daf7a2f94605a2cff65d7706c -r99ee1ab0e5d0d04de1dc14cf190b27a0ce9edfcf --- generic/nsf.c (.../nsf.c) (revision 1e14e709ba184c6daf7a2f94605a2cff65d7706c) +++ generic/nsf.c (.../nsf.c) (revision 99ee1ab0e5d0d04de1dc14cf190b27a0ce9edfcf) @@ -7402,7 +7402,7 @@ static NsfObjects * -ComputeSlotObjects(Tcl_Interp *interp, NsfObject *object, CONST char *pattern, int withRootClass) { +ComputeSlotObjects(Tcl_Interp *interp, NsfObject *object, NsfClass *type, int withRootClass) { NsfObjects *slotObjects = NULL, **npl = &slotObjects; NsfClasses *pl, *fullPrecendenceList; NsfObject *childObject, *tmpObject; @@ -7439,6 +7439,7 @@ cmd = (Tcl_Command) Tcl_GetHashValue(hPtr); childObject = NsfGetObjectFromCmdPtr(cmd); /*fprintf(stderr, "we have true child obj %s\n", objectName(childObject));*/ + if (type && !IsSubType(childObject->cl, type)) continue; npl = NsfObjectListAdd(npl, childObject); } } @@ -10763,7 +10764,7 @@ } static int -ListChildren(Tcl_Interp *interp, NsfObject *object, CONST char *pattern, int classesOnly) { +ListChildren(Tcl_Interp *interp, NsfObject *object, CONST char *pattern, int classesOnly, NsfClass *type) { NsfObject *childObject; Tcl_HashTable *cmdTable; @@ -10774,6 +10775,7 @@ if ((childObject = GetObjectFromString(interp, pattern)) && (!classesOnly || NsfObjectIsClass(childObject)) && + (!type || IsSubType(childObject->cl, type)) && (Tcl_Command_nsPtr(childObject->id) == object->nsPtr) /* true children */ ) { Tcl_SetObjResult(interp, childObject->cmdName); @@ -10798,6 +10800,7 @@ if ((childObject = NsfGetObjectFromCmdPtr(cmd)) && (!classesOnly || NsfObjectIsClass(childObject)) && + (!type || IsSubType(childObject->cl, type)) && (Tcl_Command_nsPtr(childObject->id) == object->nsPtr) /* true children */ ) { Tcl_ListObjAppendElement(interp, list, childObject->cmdName); @@ -14165,12 +14168,13 @@ /* objectInfoMethod children NsfObjInfoChildrenMethod { + {-argName "-type" -required 0 -nrargs 1 -type class} {-argName "pattern" -required 0} } */ static int -NsfObjInfoChildrenMethod(Tcl_Interp *interp, NsfObject *object, CONST char *pattern) { - return ListChildren(interp, object, pattern, 0); +NsfObjInfoChildrenMethod(Tcl_Interp *interp, NsfObject *object, NsfClass *type, CONST char *pattern) { + return ListChildren(interp, object, pattern, 0, type); } /* @@ -14390,16 +14394,16 @@ /* objectInfoMethod slotobjects NsfObjInfoSlotObjectsMethod { - {-argName "pattern" -required 0} + {-argName "-type" -required 0 -nrargs 1 -type class} } */ static int -NsfObjInfoSlotObjectsMethod(Tcl_Interp *interp, NsfObject *object, CONST char *pattern) { +NsfObjInfoSlotObjectsMethod(Tcl_Interp *interp, NsfObject *object, NsfClass *type) { NsfObjects *pl, *slotObjects; Tcl_Obj *list = Tcl_NewListObj(0, NULL); /*NsfClass *slotClass = GetClassFromString(interp, "::nx::Slot");*/ - slotObjects = ComputeSlotObjects(interp, object, pattern /* not used */, 1); + slotObjects = ComputeSlotObjects(interp, object, type, 1); for (pl=slotObjects; pl; pl = pl->nextPtr) { /*if (slotClass && !IsSubType(pl->obj->cl, slotClass)) continue;*/ @@ -14683,29 +14687,6 @@ } /* -classInfoMethod slots NsfClassInfoSlotsMethod { -} -*/ -static int -NsfClassInfoSlotsMethod(Tcl_Interp *interp, NsfClass *class) { - Tcl_DString ds, *dsPtr = &ds; - NsfObject *object; - int result; - - DSTRING_INIT(dsPtr); - Tcl_DStringAppend(dsPtr, className(class), -1); - Tcl_DStringAppend(dsPtr, "::slot", 6); - object = GetObjectFromString(interp, Tcl_DStringValue(dsPtr)); - if (object) { - result = ListChildren(interp, object, NULL, 0); - } else { - result = TCL_OK; - } - DSTRING_FREE(dsPtr); - return result; -} - -/* classInfoMethod subclass NsfClassInfoSubclassMethod { {-argName "-closure"} {-argName "pattern" -type objpattern} Index: generic/tclAPI.h =================================================================== diff -u -r1e14e709ba184c6daf7a2f94605a2cff65d7706c -r99ee1ab0e5d0d04de1dc14cf190b27a0ce9edfcf --- generic/tclAPI.h (.../tclAPI.h) (revision 1e14e709ba184c6daf7a2f94605a2cff65d7706c) +++ generic/tclAPI.h (.../tclAPI.h) (revision 99ee1ab0e5d0d04de1dc14cf190b27a0ce9edfcf) @@ -163,7 +163,6 @@ 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 []); @@ -242,7 +241,6 @@ 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); -static int NsfClassInfoSlotsMethod(Tcl_Interp *interp, NsfClass *cl); 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 withNonleaf, int withObjscope, Tcl_Obj *cmdName); @@ -286,7 +284,7 @@ static int NsfOVolatileMethod(Tcl_Interp *interp, NsfObject *obj); static int NsfOVwaitMethod(Tcl_Interp *interp, NsfObject *obj, CONST char *varname); static int NsfObjInfoCallableMethod(Tcl_Interp *interp, NsfObject *obj, int infocallablesubcmd, int withMethodtype, int withCallprotection, int withApplication, int withNomixins, int withIncontext, CONST char *pattern); -static int NsfObjInfoChildrenMethod(Tcl_Interp *interp, NsfObject *obj, CONST char *pattern); +static int NsfObjInfoChildrenMethod(Tcl_Interp *interp, NsfObject *obj, NsfClass *withType, CONST char *pattern); static int NsfObjInfoClassMethod(Tcl_Interp *interp, NsfObject *obj); static int NsfObjInfoFilterguardMethod(Tcl_Interp *interp, NsfObject *obj, CONST char *filter); static int NsfObjInfoFiltermethodsMethod(Tcl_Interp *interp, NsfObject *obj, int withGuards, int withOrder, CONST char *pattern); @@ -301,7 +299,7 @@ static int NsfObjInfoMixinguardMethod(Tcl_Interp *interp, NsfObject *obj, CONST char *mixin); static int NsfObjInfoParentMethod(Tcl_Interp *interp, NsfObject *obj); static int NsfObjInfoPrecedenceMethod(Tcl_Interp *interp, NsfObject *obj, int withIntrinsic, CONST char *pattern); -static int NsfObjInfoSlotObjectsMethod(Tcl_Interp *interp, NsfObject *obj, CONST char *pattern); +static int NsfObjInfoSlotObjectsMethod(Tcl_Interp *interp, NsfObject *obj, NsfClass *withType); static int NsfObjInfoVarsMethod(Tcl_Interp *interp, NsfObject *obj, CONST char *pattern); enum { @@ -322,7 +320,6 @@ NsfClassInfoMixinOfMethodIdx, NsfClassInfoMixinclassesMethodIdx, NsfClassInfoMixinguardMethodIdx, - NsfClassInfoSlotsMethodIdx, NsfClassInfoSubclassMethodIdx, NsfClassInfoSuperclassMethodIdx, NsfAliasCmdIdx, @@ -766,25 +763,6 @@ } static int -NsfClassInfoSlotsMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { - ParseContext pc; - NsfClass *cl = NsfObjectToClass(clientData); - if (!cl) return NsfObjErrType(interp, objv[0], "Class", ""); - 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 { - - - ParseContextRelease(&pc); - return NsfClassInfoSlotsMethod(interp, cl); - - } -} - -static int NsfClassInfoSubclassMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { ParseContext pc; NsfClass *cl = NsfObjectToClass(clientData); @@ -1606,10 +1584,11 @@ &pc) != TCL_OK) { return TCL_ERROR; } else { - CONST char *pattern = (CONST char *)pc.clientData[0]; + NsfClass *withType = (NsfClass *)pc.clientData[0]; + CONST char *pattern = (CONST char *)pc.clientData[1]; ParseContextRelease(&pc); - return NsfObjInfoChildrenMethod(interp, obj, pattern); + return NsfObjInfoChildrenMethod(interp, obj, withType, pattern); } } @@ -1916,10 +1895,10 @@ &pc) != TCL_OK) { return TCL_ERROR; } else { - CONST char *pattern = (CONST char *)pc.clientData[0]; + NsfClass *withType = (NsfClass *)pc.clientData[0]; ParseContextRelease(&pc); - return NsfObjInfoSlotObjectsMethod(interp, obj, pattern); + return NsfObjInfoSlotObjectsMethod(interp, obj, withType); } } @@ -2012,9 +1991,6 @@ {"::nsf::cmd::ClassInfo::mixinguard", NsfClassInfoMixinguardMethodStub, 1, { {"mixin", 1, 0, ConvertToString}} }, -{"::nsf::cmd::ClassInfo::slots", NsfClassInfoSlotsMethodStub, 0, { - } -}, {"::nsf::cmd::ClassInfo::subclass", NsfClassInfoSubclassMethodStub, 2, { {"-closure", 0, 0, ConvertToString}, {"pattern", 0, 0, ConvertToObjpattern}} @@ -2208,7 +2184,8 @@ {"-incontext", 0, 0, ConvertToString}, {"pattern", 0, 0, ConvertToString}} }, -{"::nsf::cmd::ObjectInfo::children", NsfObjInfoChildrenMethodStub, 1, { +{"::nsf::cmd::ObjectInfo::children", NsfObjInfoChildrenMethodStub, 2, { + {"-type", 0, 1, ConvertToClass}, {"pattern", 0, 0, ConvertToString}} }, {"::nsf::cmd::ObjectInfo::class", NsfObjInfoClassMethodStub, 0, { @@ -2265,7 +2242,7 @@ {"pattern", 0, 0, ConvertToString}} }, {"::nsf::cmd::ObjectInfo::slotobjects", NsfObjInfoSlotObjectsMethodStub, 1, { - {"pattern", 0, 0, ConvertToString}} + {"-type", 0, 1, ConvertToClass}} }, {"::nsf::cmd::ObjectInfo::vars", NsfObjInfoVarsMethodStub, 1, { {"pattern", 0, 0, ConvertToString}} Index: library/nx/nx.tcl =================================================================== diff -u -r25f4f3c883ff0021b8564377f6658afb69c346c8 -r99ee1ab0e5d0d04de1dc14cf190b27a0ce9edfcf --- library/nx/nx.tcl (.../nx.tcl) (revision 25f4f3c883ff0021b8564377f6658afb69c346c8) +++ library/nx/nx.tcl (.../nx.tcl) (revision 99ee1ab0e5d0d04de1dc14cf190b27a0ce9edfcf) @@ -464,12 +464,14 @@ :alias "info parent" ::nsf::cmd::ObjectInfo::parent :alias "info precedence" ::nsf::cmd::ObjectInfo::precedence :method "info slotobjects" {} { - set result [list] - foreach slot [::nsf::dispatch [::nsf::current object] ::nsf::cmd::ObjectInfo::slotobjects] { - if {![::nsf::dispatch $slot ::nsf::cmd::ObjectInfo::hastype ::nx::Slot]} continue - lappend result $slot + ::nsf::dispatch [::nsf::current object] \ + ::nsf::cmd::ObjectInfo::slotobjects -type ::nx::Slot + } + :method "info slots" {} { + set slotContainer [::nsf::current object]::slot + if {[::nsf::isobject $slotContainer]} { + ::nsf::dispatch $slotContainer ::nsf::cmd::ObjectInfo::children -type ::nx::Slot } - return $result } :alias "info vars" ::nsf::cmd::ObjectInfo::vars } @@ -507,7 +509,6 @@ :alias "info mixin guard" ::nsf::cmd::ClassInfo::mixinguard :alias "info mixin classes" ::nsf::cmd::ClassInfo::mixinclasses :alias "info mixinof" ::nsf::cmd::ClassInfo::mixinof - :alias "info slots" ::nsf::cmd::ClassInfo::slots :alias "info subclass" ::nsf::cmd::ClassInfo::subclass :alias "info superclass" ::nsf::cmd::ClassInfo::superclass } @@ -878,9 +879,7 @@ proc ::nsf::parametersFromSlots {obj} { set parameterdefinitions [list] - foreach slot [::nsf::dispatch $obj ::nsf::cmd::ObjectInfo::slotobjects] { - # TODO: the following line is just for the somehwat dummy "...::slot::__info" - if {![::nsf::dispatch $slot ::nsf::cmd::ObjectInfo::hastype ::nx::Slot]} continue + foreach slot [::nsf::dispatch $obj ::nsf::cmd::ObjectInfo::slotobjects -type ::nx::Slot] { # Skip some slots for xotcl; # TODO: maybe different parameterFromSlots for xotcl? if {[::nsf::is class ::xotcl::Object] @@ -990,7 +989,7 @@ ############################################ # system slots ############################################ - proc ::nsf::register_system_slots {os} { + proc register_system_slots {os} { ::nx::RelationSlot create ${os}::Class::slot::superclass ::nsf::alias ${os}::Class::slot::superclass assign ::nsf::relation @@ -1049,8 +1048,8 @@ #::nsf::alias ::nx::Class::slot::object-filter guard ${os}::Object::slot::filter::guard } - ::nsf::register_system_slots ::nx - proc ::nsf::register_system_slots {} {} + register_system_slots ::nx + proc ::nx::register_system_slots {} {} ############################################ Index: library/xotcl/library/xotcl2.tcl =================================================================== diff -u -rabcb5e0cd5c1c27262daf76ab309e9c1f18f5ed5 -r99ee1ab0e5d0d04de1dc14cf190b27a0ce9edfcf --- library/xotcl/library/xotcl2.tcl (.../xotcl2.tcl) (revision abcb5e0cd5c1c27262daf76ab309e9c1f18f5ed5) +++ library/xotcl/library/xotcl2.tcl (.../xotcl2.tcl) (revision 99ee1ab0e5d0d04de1dc14cf190b27a0ce9edfcf) @@ -564,7 +564,7 @@ {*}$pattern } :alias parameter ::nx::Class::slot::__info::parameter - :alias slots ::nsf::cmd::ClassInfo::slots + :alias slots ::nx::Object::slot::__info::slots :alias subclass ::nsf::cmd::ClassInfo::subclass :alias superclass ::nsf::cmd::ClassInfo::superclass } Index: tests/info-method.tcl =================================================================== diff -u -rd9b42d77f43db84a9983cc3bbc4124cf0b52df29 -r99ee1ab0e5d0d04de1dc14cf190b27a0ce9edfcf --- tests/info-method.tcl (.../info-method.tcl) (revision d9b42d77f43db84a9983cc3bbc4124cf0b52df29) +++ tests/info-method.tcl (.../info-method.tcl) (revision 99ee1ab0e5d0d04de1dc14cf190b27a0ce9edfcf) @@ -175,3 +175,22 @@ ? {o mixin ""} "" } + +Test case slots { + + nx::Class create C { + :attribute a + :attribute {b 1} + } + + nx::Class create D -superclass C { + :attribute {b 2} + :attribute c + :object attribute a2 + :method "sub foo" args {;} + } + + D create d1 + ? {D info slotobjects} "::nx::Class::slot::object-mixin ::nx::Class::slot::mixin ::nx::Class::slot::superclass ::nx::Class::slot::object-filter ::nx::Class::slot::filter ::nx::Object::slot::class" + ? {D info slots} "::D::slot::b ::D::slot::a2 ::D::slot::c" +} \ No newline at end of file