Index: TODO =================================================================== diff -u -ra588ad9e5d66f12c4b2a5baf9153b652932a5912 -r4d02778de9877814d5d078fa5a4e34e40f57bcff --- TODO (.../TODO) (revision a588ad9e5d66f12c4b2a5baf9153b652932a5912) +++ TODO (.../TODO) (revision 4d02778de9877814d5d078fa5a4e34e40f57bcff) @@ -1099,12 +1099,19 @@ but would apply as well for methods defined on both Object and Class. - use now class-only for all methods methods of meta-classes. - Methods of meta-classes are inteded to be applied on classes, + Methods of meta-classes are intended to be applied on classes, one should not change this via per-object mixins. - respect class-only in "info callable methods|method" - extended regression test - provided relation name "object-filter" to slot filter. +- replaced "obj|cls filterguard name cond" by "obj|cls filter guard name cond" +- replaced "obj|cls info filterguard name" by "obj|cls info filter -guard name" +- replaced "cls object info filterguard name" by "cls object info filter -guard name" +- removed XOTclObjInfoFilterguardMethod() +- removed XOTclClassInfoFilterguardMethod() +- extended regression test +- updated migration guide TODO: Index: doc/next-migration.html =================================================================== diff -u -rd8d920f2976691dcf8e2a68b336eb253385030f6 -r4d02778de9877814d5d078fa5a4e34e40f57bcff --- doc/next-migration.html (.../next-migration.html) (revision d8d920f2976691dcf8e2a68b336eb253385030f6) +++ doc/next-migration.html (.../next-migration.html) (revision 4d02778de9877814d5d078fa5a4e34e40f57bcff) @@ -782,7 +782,7 @@ cls instmixinguard ... - # Register per-class mixin and guard for cls

+ # Register per-class mixin and guard for a class

cls mixin ...
cls mixinguard ... @@ -793,7 +793,7 @@ cls mixinguard ... - # Register per-object mixin and guard for cls

+ # Register per-object mixin and guard for a class

cls object mixin ...
cls object mixinguard ...
@@ -804,7 +804,7 @@ obj mixinguard ... - # Register per-object mixin and guard for obj

+ # Register per-object mixin and guard for an object

obj mixin ...
obj mixinguard ... @@ -820,9 +820,9 @@ cls instfilterguard ... - # Register per-class filter and guard for cls

+ # Register per-class filter and guard for a class

cls filter ...
- cls filterguard ... + cls filter guard ... @@ -831,9 +831,9 @@ cls filterguard ... - # Register per-object filter and guard for cls

+ # Register per-object filter and guard for a class

cls object filter ...
- cls object filterguard ...
+ cls object filter guard ...
@@ -842,9 +842,10 @@ obj filterguard ... - # Register per-object filter and guard for obj

+ # Register per-object filter and guard for an + object

obj filter ...
- obj filterguard ... + obj filter guard ... @@ -1077,30 +1078,51 @@ - + + obj info filter ?-guard? ?-guards? ?-order? ?pattern? - - + + + + + + + - - + + + + + + + - - + + + + + + + + + - - + + - - + +
XOTclNext Scripting Language
obj info filter ?-order? ?-guards? ?pattern?obj info filter ?-guards? ?-order? ?pattern? # ... info filter -order ... returns method-handles
# instead of triples (applies to all three variants)

- obj info filter ?-order? ?-guards? ?pattern?
cls info filter ?-order? ?-guards? ?pattern?cls object info filter ?-order? ?-guards? ?pattern?obj info filterguard nameobj info filter -guard name
+
obj filter guard name
+
cls info filter ?-guards? ?-order? ?pattern?cls object info filter ?-guard? ?-guards? ?-order? ?pattern?
cls info instfilter ?-order? ?-guards? ?pattern?cls info filter ?-order? ?-guards? ?pattern?cls info filterguard namecls object info filter -guard name
+
cls object filter guard name
cls info instfilter ?-guards? ?-order? ?pattern?cls info filter ?-guard? ?-guards? ?-order? ?pattern?
obj info mixin ?-order? ?-guards? ?pattern?obj info mixin ?-order? ?-guards? ?pattern?cls info instfilterguard namecls info filter -guard name
+
cls filter guard name
obj info mixin ?-guards? ?-order? ?pattern?obj info mixin ?-guards? ?-order? ?pattern?
cls info mixin ?-order? ?-guards? ?pattern?cls object info mixin ?-order? ?-guards? ?pattern?cls info mixin ?-guards? ?-order? ?pattern?cls object info mixin ?-guards? ?-order? ?pattern?
cls info instmixin ?-order? ?-guards? ?pattern?cls info mixin ?-order? ?-guards? ?pattern?cls info instmixin ?-guards? ?-order? ?pattern?cls info mixin ?-guards? ?-order? ?pattern?
@@ -1113,7 +1135,7 @@ n.a. - cls ?object? info method definition methodName + cls info method definition methodName @@ -1122,11 +1144,11 @@ XOTclNext Scripting Language n.a. - obj info method name methodName + obj info method handle methodName n.a. - cls ?object? info method name methodName + cls ?object? info method handle methodName @@ -1395,6 +1417,6 @@
- Last modified: Thu Aug 19 14:50:52 CEST 2010 + Last modified: Sun Aug 22 14:13:15 CEST 2010 Index: generic/gentclAPI.decls =================================================================== diff -u -r84af56591a1cc4ac7a3779ec44f6978203ef016a -r4d02778de9877814d5d078fa5a4e34e40f57bcff --- generic/gentclAPI.decls (.../gentclAPI.decls) (revision 84af56591a1cc4ac7a3779ec44f6978203ef016a) +++ generic/gentclAPI.decls (.../gentclAPI.decls) (revision 4d02778de9877814d5d078fa5a4e34e40f57bcff) @@ -419,7 +419,7 @@ # # Adds conditions to guard invocations of a filter. The # filter will only execute, if the guards evaluate to true. Otherwise, -# the filters are ignored the filter. If no guards are given, we +# the guarded filter is ignored. If no guards are given, # always execute the filter. # # @param filter Handle to identify and address a filter once registered @@ -763,14 +763,11 @@ } infoObjectMethod filter XOTclObjInfoFilterMethod { {-argName "object" -required 1 -type object} - {-argName "-order"} + {-argName "-guard"} {-argName "-guards"} + {-argName "-order"} {-argName "pattern"} } -infoObjectMethod filterguard XOTclObjInfoFilterguardMethod { - {-argName "object" -required 1 -type object} - {-argName "filter" -required 1} -} infoObjectMethod forward XOTclObjInfoForwardMethod { {-argName "object" -required 1 -type object} {-argName "-definition"} @@ -834,13 +831,10 @@ } infoClassMethod filter XOTclClassInfoFilterMethod { {-argName "class" -required 1 -type class} + {-argName "-guard"} {-argName "-guards"} {-argName "pattern"} } -infoClassMethod filterguard XOTclClassInfoFilterguardMethod { - {-argName "class" -required 1 -type class} - {-argName "filter" -required 1} -} infoClassMethod forward XOTclClassInfoForwardMethod { {-argName "class" -required 1 -type class} {-argName "-definition"} Index: generic/tclAPI.h =================================================================== diff -u -r84af56591a1cc4ac7a3779ec44f6978203ef016a -r4d02778de9877814d5d078fa5a4e34e40f57bcff --- generic/tclAPI.h (.../tclAPI.h) (revision 84af56591a1cc4ac7a3779ec44f6978203ef016a) +++ generic/tclAPI.h (.../tclAPI.h) (revision 4d02778de9877814d5d078fa5a4e34e40f57bcff) @@ -153,7 +153,6 @@ 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 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 []); static int XOTclClassInfoHeritageMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclClassInfoInstancesMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); @@ -169,7 +168,6 @@ static int XOTclObjInfoChildrenMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclObjInfoClassMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclObjInfoFilterMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); -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 XOTclObjInfoMethodMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); @@ -229,8 +227,7 @@ static int XOTclCMixinGuardMethod(Tcl_Interp *interp, XOTclClass *cl, CONST 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 XOTclClassInfoFilterMethod(Tcl_Interp *interp, XOTclClass *class, int withGuards, CONST char *pattern); -static int XOTclClassInfoFilterguardMethod(Tcl_Interp *interp, XOTclClass *class, CONST char *filter); +static int XOTclClassInfoFilterMethod(Tcl_Interp *interp, XOTclClass *class, int withGuard, int withGuards, CONST char *pattern); static int XOTclClassInfoForwardMethod(Tcl_Interp *interp, XOTclClass *class, int withDefinition, CONST char *name); static int XOTclClassInfoHeritageMethod(Tcl_Interp *interp, XOTclClass *class, CONST char *pattern); static int XOTclClassInfoInstancesMethod(Tcl_Interp *interp, XOTclClass *class, int withClosure, CONST char *patternString, XOTclObject *patternObj); @@ -245,8 +242,7 @@ static int XOTclObjInfoCallableMethod(Tcl_Interp *interp, XOTclObject *object, int infocallablesubcmd, int withMethodtype, int withCallprotection, int withApplication, int withNomixins, int withIncontext, CONST char *pattern); static int XOTclObjInfoChildrenMethod(Tcl_Interp *interp, XOTclObject *object, CONST char *pattern); static int XOTclObjInfoClassMethod(Tcl_Interp *interp, XOTclObject *object); -static int XOTclObjInfoFilterMethod(Tcl_Interp *interp, XOTclObject *object, int withOrder, int withGuards, CONST char *pattern); -static int XOTclObjInfoFilterguardMethod(Tcl_Interp *interp, XOTclObject *object, CONST char *filter); +static int XOTclObjInfoFilterMethod(Tcl_Interp *interp, XOTclObject *object, int withGuard, int withGuards, int withOrder, CONST char *pattern); static int XOTclObjInfoForwardMethod(Tcl_Interp *interp, XOTclObject *object, int withDefinition, CONST char *name); static int XOTclObjInfoHasnamespaceMethod(Tcl_Interp *interp, XOTclObject *object); static int XOTclObjInfoMethodMethod(Tcl_Interp *interp, XOTclObject *object, int infomethodsubcmd, CONST char *name); @@ -308,7 +304,6 @@ XOTclCNewMethodIdx, XOTclCRecreateMethodIdx, XOTclClassInfoFilterMethodIdx, - XOTclClassInfoFilterguardMethodIdx, XOTclClassInfoForwardMethodIdx, XOTclClassInfoHeritageMethodIdx, XOTclClassInfoInstancesMethodIdx, @@ -324,7 +319,6 @@ XOTclObjInfoChildrenMethodIdx, XOTclObjInfoClassMethodIdx, XOTclObjInfoFilterMethodIdx, - XOTclObjInfoFilterguardMethodIdx, XOTclObjInfoForwardMethodIdx, XOTclObjInfoHasnamespaceMethodIdx, XOTclObjInfoMethodMethodIdx, @@ -525,35 +519,17 @@ return TCL_ERROR; } else { XOTclClass *class = (XOTclClass *)pc.clientData[0]; - int withGuards = (int )PTR2INT(pc.clientData[1]); - CONST char *pattern = (CONST char *)pc.clientData[2]; + int withGuard = (int )PTR2INT(pc.clientData[1]); + int withGuards = (int )PTR2INT(pc.clientData[2]); + CONST char *pattern = (CONST char *)pc.clientData[3]; parseContextRelease(&pc); - return XOTclClassInfoFilterMethod(interp, class, withGuards, pattern); + return XOTclClassInfoFilterMethod(interp, class, withGuard, withGuards, pattern); } } static int -XOTclClassInfoFilterguardMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { - parseContext pc; - - if (ArgumentParse(interp, objc, objv, NULL, objv[0], - method_definitions[XOTclClassInfoFilterguardMethodIdx].paramDefs, - method_definitions[XOTclClassInfoFilterguardMethodIdx].nrParameters, - &pc) != TCL_OK) { - return TCL_ERROR; - } else { - XOTclClass *class = (XOTclClass *)pc.clientData[0]; - CONST char *filter = (CONST char *)pc.clientData[1]; - - parseContextRelease(&pc); - return XOTclClassInfoFilterguardMethod(interp, class, filter); - - } -} - -static int XOTclClassInfoForwardMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; @@ -903,36 +879,18 @@ return TCL_ERROR; } else { XOTclObject *object = (XOTclObject *)pc.clientData[0]; - int withOrder = (int )PTR2INT(pc.clientData[1]); + int withGuard = (int )PTR2INT(pc.clientData[1]); int withGuards = (int )PTR2INT(pc.clientData[2]); - CONST char *pattern = (CONST char *)pc.clientData[3]; + int withOrder = (int )PTR2INT(pc.clientData[3]); + CONST char *pattern = (CONST char *)pc.clientData[4]; parseContextRelease(&pc); - return XOTclObjInfoFilterMethod(interp, object, withOrder, withGuards, pattern); + return XOTclObjInfoFilterMethod(interp, object, withGuard, withGuards, withOrder, pattern); } } static int -XOTclObjInfoFilterguardMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { - parseContext pc; - - if (ArgumentParse(interp, objc, objv, NULL, objv[0], - method_definitions[XOTclObjInfoFilterguardMethodIdx].paramDefs, - method_definitions[XOTclObjInfoFilterguardMethodIdx].nrParameters, - &pc) != TCL_OK) { - return TCL_ERROR; - } else { - XOTclObject *object = (XOTclObject *)pc.clientData[0]; - CONST char *filter = (CONST char *)pc.clientData[1]; - - parseContextRelease(&pc); - return XOTclObjInfoFilterguardMethod(interp, object, filter); - - } -} - -static int XOTclObjInfoForwardMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; @@ -1926,15 +1884,12 @@ {"name", 1, 0, convertToTclobj}, {"args", 0, 0, convertToNothing}} }, -{"::nsf::cmd::ClassInfo::filter", XOTclClassInfoFilterMethodStub, 3, { +{"::nsf::cmd::ClassInfo::filter", XOTclClassInfoFilterMethodStub, 4, { {"class", 1, 0, convertToClass}, + {"-guard", 0, 0, convertToString}, {"-guards", 0, 0, convertToString}, {"pattern", 0, 0, convertToString}} }, -{"::nsf::cmd::ClassInfo::filterguard", XOTclClassInfoFilterguardMethodStub, 2, { - {"class", 1, 0, convertToClass}, - {"filter", 1, 0, convertToString}} -}, {"::nsf::cmd::ClassInfo::forward", XOTclClassInfoForwardMethodStub, 3, { {"class", 1, 0, convertToClass}, {"-definition", 0, 0, convertToString}, @@ -2008,16 +1963,13 @@ {"::nsf::cmd::ObjectInfo::class", XOTclObjInfoClassMethodStub, 1, { {"object", 1, 0, convertToObject}} }, -{"::nsf::cmd::ObjectInfo::filter", XOTclObjInfoFilterMethodStub, 4, { +{"::nsf::cmd::ObjectInfo::filter", XOTclObjInfoFilterMethodStub, 5, { {"object", 1, 0, convertToObject}, - {"-order", 0, 0, convertToString}, + {"-guard", 0, 0, convertToString}, {"-guards", 0, 0, convertToString}, + {"-order", 0, 0, convertToString}, {"pattern", 0, 0, convertToString}} }, -{"::nsf::cmd::ObjectInfo::filterguard", XOTclObjInfoFilterguardMethodStub, 2, { - {"object", 1, 0, convertToObject}, - {"filter", 1, 0, convertToString}} -}, {"::nsf::cmd::ObjectInfo::forward", XOTclObjInfoForwardMethodStub, 3, { {"object", 1, 0, convertToObject}, {"-definition", 0, 0, convertToString}, Index: generic/xotcl.c =================================================================== diff -u -ra588ad9e5d66f12c4b2a5baf9153b652932a5912 -r4d02778de9877814d5d078fa5a4e34e40f57bcff --- generic/xotcl.c (.../xotcl.c) (revision a588ad9e5d66f12c4b2a5baf9153b652932a5912) +++ generic/xotcl.c (.../xotcl.c) (revision 4d02778de9877814d5d078fa5a4e34e40f57bcff) @@ -4010,13 +4010,9 @@ cmdList = seekCurrent(object->mixinStack->currentCmdPtr, object->mixinOrder); RUNTIME_STATE(interp)->cmdPtr = cmdList ? cmdList->cmdPtr : NULL; - /* - fprintf(stderr, "MixinSearch searching for '%s' %p\n", methodName, cmdList); - */ + /* fprintf(stderr, "MixinSearch searching for '%s' %p\n", methodName, cmdList); */ /*CmdListPrint(interp, "MixinSearch CL = \n", cmdList);*/ - /*xxxx*/ - for (; cmdList; cmdList = cmdList->nextPtr) { if (Tcl_Command_cmdEpoch(cmdList->cmdPtr)) { @@ -13887,31 +13883,29 @@ /* infoObjectMethod filter XOTclObjInfoFilterMethod { {-argName "object" -required 1 -type object} - {-argName "-order"} + {-argName "-guard"} {-argName "-guards"} + {-argName "-order"} {-argName "pattern"} } */ static int XOTclObjInfoFilterMethod(Tcl_Interp *interp, XOTclObject *object, - int withOrder, int withGuards, CONST char *pattern) { + int withGuard, int withGuards, int withOrder, + CONST char *pattern) { XOTclObjectOpt *opt = object->opt; + + if (withGuard) { + return opt ? GuardList(interp, object->opt->filters, pattern) : TCL_OK; + } if (withOrder) { if (!(object->flags & XOTCL_FILTER_ORDER_VALID)) FilterComputeDefined(interp, object); return FilterInfo(interp, object->filterOrder, pattern, withGuards, 1); } return opt ? FilterInfo(interp, opt->filters, pattern, withGuards, 0) : TCL_OK; } + /* -infoObjectMethod filterguard XOTclObjInfoFilterguardMethod { - {-argName "object" -required 1 -type object} - {-argName "filter" -required 1} -} -*/ -static int XOTclObjInfoFilterguardMethod(Tcl_Interp *interp, XOTclObject *object, CONST char *filter) { - return object->opt ? GuardList(interp, object->opt->filters, filter) : TCL_OK; -} -/* infoObjectMethod forward XOTclObjInfoForwardMethod { {-argName "object" -required 1 -type object} {-argName "-definition"} @@ -14158,25 +14152,22 @@ /* infoClassMethod filter XOTclClassInfoFilterMethod { {-argName "class" -required 1 -type class} + {-argName "-guard"} {-argName "-guards"} {-argName "pattern"} } */ -static int XOTclClassInfoFilterMethod(Tcl_Interp *interp, XOTclClass *class, int withGuards, CONST char *pattern) { + +static int XOTclClassInfoFilterMethod(Tcl_Interp *interp, XOTclClass *class, + int withGuard, int withGuards, + CONST char *pattern) { + if (withGuard) { + return class->opt ? GuardList(interp, class->opt->classfilters, pattern) : TCL_OK; + } return class->opt ? FilterInfo(interp, class->opt->classfilters, pattern, withGuards, 0) : TCL_OK; } /* -infoClassMethod filterguard XOTclClassInfoFilterguardMethod { - {-argName "class" -required 1 -type class} - {-argName "filter" -required 1} -} -*/ -static int XOTclClassInfoFilterguardMethod(Tcl_Interp *interp, XOTclClass *class, CONST char *filter) { - return class->opt ? GuardList(interp, class->opt->classfilters, filter) : TCL_OK; -} - -/* infoClassMethod forward XOTclClassInfoForwardMethod { {-argName "class" -required 1 -type class} {-argName "-definition"} Index: library/nx/nx.tcl =================================================================== diff -u -ra588ad9e5d66f12c4b2a5baf9153b652932a5912 -r4d02778de9877814d5d078fa5a4e34e40f57bcff --- library/nx/nx.tcl (.../nx.tcl) (revision a588ad9e5d66f12c4b2a5baf9153b652932a5912) +++ library/nx/nx.tcl (.../nx.tcl) (revision 4d02778de9877814d5d078fa5a4e34e40f57bcff) @@ -37,7 +37,7 @@ # foreach cmd [info command ::nsf::cmd::Object::*] { set cmdName [namespace tail $cmd] - if {$cmdName in [list "autoname" "exists" "instvar" "requireNamespace"]} continue + if {$cmdName in [list "autoname" "exists" "filterguard" "instvar" "requireNamespace"]} continue ::nsf::alias Object $cmdName $cmd } @@ -47,6 +47,7 @@ # provide the standard command set for Class foreach cmd [info command ::nsf::cmd::Class::*] { set cmdName [namespace tail $cmd] + if {$cmdName in [list "filterguard"]} continue ::nsf::alias Class $cmdName $cmd } @@ -155,7 +156,7 @@ switch [llength $args] { 0 {return [::nsf::relation [::nsf::current object] object-$what]} 1 {return [::nsf::relation [::nsf::current object] object-$what {*}$args]} - default {return [::nx::Class::slot::object-$what [lindex $args 0] \ + default {return [::nx::Object::slot::$what [lindex $args 0] \ [::nsf::current object] object-$what \ {*}[lrange $args 1 end]] } @@ -969,6 +970,7 @@ ::nx::RelationSlot create ${os}::Object::slot::filter -elementtype "" \ -methodname object-filter + # @param ::nx::Class#mixin # # As a setter, {{{mixin}}} specifies a list of mixins to set for @@ -996,6 +998,25 @@ # object-slots for classes via object-mixin ::nx::RelationSlot create ${os}::Class::slot::object-mixin -noforwarder 1 ::nx::RelationSlot create ${os}::Class::slot::object-filter -elementtype "" -noforwarder 1 + + # + # Define method "guard" for Object and Class + # + ${os}::Object::slot::filter method guard {obj prop filter guard:optional} { + if {[info exists guard]} { + ::nsf::dispatch $obj ::nsf::cmd::Object::filterguard $filter $guard + } else { + $obj info filter -guard $filter + } + } + ${os}::Class::slot::filter method guard {obj prop filter guard:optional} { + if {[info exists guard]} { + ::nsf::dispatch $obj ::nsf::cmd::Class::filterguard $filter $guard + } else { + $obj info filter -guard $filter + } + } + #::nsf::alias ::nx::Class::slot::object-filter guard ${os}::Object::slot::filter::guard } ::nsf::register_system_slots ::nx Index: library/xotcl/library/xotcl2.tcl =================================================================== diff -u -r39a142bba1228a228ab72054aa7a7bd64333db3c -r4d02778de9877814d5d078fa5a4e34e40f57bcff --- library/xotcl/library/xotcl2.tcl (.../xotcl2.tcl) (revision 39a142bba1228a228ab72054aa7a7bd64333db3c) +++ library/xotcl/library/xotcl2.tcl (.../xotcl2.tcl) (revision 4d02778de9877814d5d078fa5a4e34e40f57bcff) @@ -202,8 +202,7 @@ objectInfo proc info {obj} { set methods [list] - foreach m [::info commands ::xotcl::objectInfo::*] { - set name [namespace tail $m] + foreach name [::nsf::cmd::ObjectInfo::methods ::xotcl::objectInfo] { if {$name eq "unknown"} continue lappend methods $name } @@ -215,8 +214,7 @@ classInfo proc info {cl} { set methods [list] - foreach m [::info commands ::xotcl::classInfo::*] { - set name [namespace tail $m] + foreach name [::nsf::cmd::ObjectInfo::methods ::xotcl::classInfo] { if {$name eq "unknown"} continue lappend methods $name } @@ -336,6 +334,10 @@ :proc instparametercmd {o {pattern:optional ""}} { ::nsf::cmd::ClassInfo::methods $o -methodtype setter {*}$pattern } + # filter handling + :proc filterguard {o filter} {::nsf::cmd::ObjectInfo::filter $o -guard $filter} + :proc instfilterguard {o filter} {::nsf::cmd::ClassInfo::filter $o -guard $filter} + # assertion handling :proc instinvar {o} {::nsf::assertion $o class-invar} } @@ -368,7 +370,8 @@ if {[info exists pattern]} {lappend cmd $pattern} eval $cmd } - # object filter mapping + + # filter handling :proc filter {o -order:switch -guards:switch pattern:optional} { set guardsFlag [expr {$guards ? "-guards" : ""}] set patternArg [expr {[info exists pattern] ? [list $pattern] : ""}] @@ -381,6 +384,8 @@ #puts stderr " => $def" return $def } + :proc filterguard {o filter} {::nsf::cmd::ObjectInfo::filter $o -guard $filter} + # assertion handling :proc check {o} { ::xotcl::checkoption_internal_to_xotcl1 [::nsf::assertion $o check] @@ -405,6 +410,7 @@ } ::nsf::alias ::xotcl::objectInfo is ::nsf::objectproperty + ::nsf::alias ::xotcl::classInfo is ::nsf::objectproperty ::nsf::alias ::xotcl::classInfo classparent ::nsf::cmd::ObjectInfo::parent ::nsf::alias ::xotcl::classInfo classchildren ::nsf::cmd::ObjectInfo::children @@ -413,7 +419,6 @@ #::nsf::alias ::xotcl::classInfo instmixinof ::nsf::cmd::ClassInfo::class-mixin-of ::nsf::forward ::xotcl::classInfo instmixinof ::nsf::cmd::ClassInfo::mixinof %1 -scope class ::nsf::alias ::xotcl::classInfo instfilter ::nsf::cmd::ClassInfo::filter - ::nsf::alias ::xotcl::classInfo instfilterguard ::nsf::cmd::ClassInfo::filterguard ::nsf::alias ::xotcl::classInfo instforward ::nsf::cmd::ClassInfo::forward #::nsf::alias ::xotcl::classInfo mixinof ::nsf::cmd::ClassInfo::object-mixin-of ::nsf::forward ::xotcl::classInfo mixinof ::nsf::cmd::ClassInfo::mixinof %1 -scope object Index: tests/info-method.tcl =================================================================== diff -u -ra588ad9e5d66f12c4b2a5baf9153b652932a5912 -r4d02778de9877814d5d078fa5a4e34e40f57bcff --- tests/info-method.tcl (.../info-method.tcl) (revision a588ad9e5d66f12c4b2a5baf9153b652932a5912) +++ tests/info-method.tcl (.../info-method.tcl) (revision 4d02778de9877814d5d078fa5a4e34e40f57bcff) @@ -93,9 +93,34 @@ ? {o info callable methods filter} "filter" ? {o info callable method filter} "::nsf::classes::nx::Object::filter" ? {o filter f} "" - ? {o filterguard f { 1 }} "" + ? {o filter guard f { 1 == 1 }} "" + ? {o info filter -guard f} " 1 == 1 " + ? {o filter guard f} " 1 == 1 " o filter "" + nx::Class create Foo + ? {Foo method f args ::nx::next} "::nsf::classes::Foo::f" + ? {Foo method f2 args ::nx::next} "::nsf::classes::Foo::f2" + ? {Foo filter {f f2}} "" + ? {Foo info filter} "f f2" + ? {Foo filter guard f {2 == 2}} "" + ? {Foo info filter -guard f} "2 == 2" + ? {Foo info filter -guards f} "{f -guard {2 == 2}}" + ? {Foo info filter -guards f2} "f2" + ? {Foo info filter -guards} "{f -guard {2 == 2}} f2" + ? {Foo filter {}} "" + + ? {Foo object method f args ::nx::next} "::Foo::f" + ? {Foo object method f2 args ::nx::next} "::Foo::f2" + ? {Foo object filter {f f2}} "" + ? {Foo object info filter} "f f2" + ? {Foo object filter guard f {2 == 2}} "" + ? {Foo object info filter -guard f} "2 == 2" + ? {Foo object info filter -guards f} "{f -guard {2 == 2}}" + ? {Foo object info filter -guards f2} "f2" + ? {Foo object info filter -guards} "{f -guard {2 == 2}} f2" + ? {Foo object filter {}} "" + nx::Class create Fly o mixin add Fly ? {o info mixin} "::Fly ::nx::Class"