Index: TODO =================================================================== diff -u -r797decf0bf5d838727a50e35df060f6dfd55e65d -ra47d62c39a33a69e4550eab30369560d56baf574 --- TODO (.../TODO) (revision 797decf0bf5d838727a50e35df060f6dfd55e65d) +++ TODO (.../TODO) (revision a47d62c39a33a69e4550eab30369560d56baf574) @@ -1140,7 +1140,18 @@ to handle potential double-deletes - extended regression test for subcmds +- started new interface bundles, objectInfoMethod and classInfoMethod + for using new infrastructure +- added object info methods filterguard, filtermethods, vars to objectInfoMethod +- added class info methods filterguard, filtermethods to classInfoMethod +- built a temporary solution for dispatcher "filter", since forward mangles args +- nx: we have now "obj info filter guard name" instead of "obj info filter -guard name" +- nx: we have now "obj info filter methods ...." instead of "obj info filter ...." + + TODO: +- update doc for filter+guard|methods +- same migration for mixin guards.... - deeper analysis of "contains" - check feasability of "obj info filter guard name" etc. Index: generic/gentclAPI.decls =================================================================== diff -u -r797decf0bf5d838727a50e35df060f6dfd55e65d -ra47d62c39a33a69e4550eab30369560d56baf574 --- generic/gentclAPI.decls (.../gentclAPI.decls) (revision 797decf0bf5d838727a50e35df060f6dfd55e65d) +++ generic/gentclAPI.decls (.../gentclAPI.decls) (revision a47d62c39a33a69e4550eab30369560d56baf574) @@ -20,7 +20,9 @@ array set ns { xotclCmd "::nsf" objectMethod "::nsf::cmd::Object" + objectInfoMethod "::nsf::cmd::ObjectInfo2" classMethod "::nsf::cmd::Class" + classInfoMethod "::nsf::cmd::ClassInfo2" checkMethod "::nsf::cmd::ParameterType" infoClassMethod "::nsf::cmd::ClassInfo" infoObjectMethod "::nsf::cmd::ObjectInfo" @@ -558,14 +560,31 @@ {-argName "varname" -required 1} } -# # temporary -# # TODO: remove me -# objectMethod vars XOTclOVarsMethod { -# {-argName "pattern" -required 0} -# } +# # temporary xxx +# # TODO: remove me xxx +# TODO mixinguard method +# TODO instmixinguard method +# TODO remove option -guard +objectInfoMethod filtermethods XOTclObjInfoFiltermethodsMethod { + {-argName "-guards"} + {-argName "-order"} + {-argName "pattern"} +} +objectInfoMethod filterguard XOTclObjInfoFilterguardMethod { + {-argName "filter" -required 1} +} +objectInfoMethod vars XOTclOVarsMethod { + {-argName "pattern" -required 0} +} +classInfoMethod filtermethods XOTclClassInfoFiltermethodsMethod { + {-argName "-guards"} + {-argName "pattern"} +} +classInfoMethod filterguard XOTclClassInfoFilterguardMethod { + {-argName "filter" -required 1} +} - # # class methods # @@ -769,13 +788,7 @@ infoObjectMethod class XOTclObjInfoClassMethod { {-argName "object" -required 1 -type object} } -infoObjectMethod filter XOTclObjInfoFilterMethod { - {-argName "object" -required 1 -type object} - {-argName "-guard"} - {-argName "-guards"} - {-argName "-order"} - {-argName "pattern"} -} + infoObjectMethod forward XOTclObjInfoForwardMethod { {-argName "object" -required 1 -type object} {-argName "-definition"} @@ -834,12 +847,6 @@ {-argName "-closure"} {-argName "pattern" -type objpattern} } -infoClassMethod filter XOTclClassInfoFilterMethod { - {-argName "class" -required 1 -type class} - {-argName "-guard"} - {-argName "-guards"} - {-argName "pattern"} -} infoClassMethod forward XOTclClassInfoForwardMethod { {-argName "class" -required 1 -type class} {-argName "-definition"} Index: generic/gentclAPI.tcl =================================================================== diff -u -rf3cb5afe6aa1b6761b4a9909058f64ff7d64ab92 -ra47d62c39a33a69e4550eab30369560d56baf574 --- generic/gentclAPI.tcl (.../gentclAPI.tcl) (revision f3cb5afe6aa1b6761b4a9909058f64ff7d64ab92) +++ generic/gentclAPI.tcl (.../gentclAPI.tcl) (revision a47d62c39a33a69e4550eab30369560d56baf574) @@ -239,7 +239,7 @@ lappend enums $d(idx) set nrArgs [llength $d(parameterDefinitions)] set stubDecl "static int $d(stub)$::objCmdProc\n" - set ifd "{\"$::ns($d(methodType))::$d(methodName)\", $d(stub), $nrArgs, {\n [genifd $d(parameterDefinitions)]}\n}" + set ifd "{\"$d(ns)::$d(methodName)\", $d(stub), $nrArgs, {\n [genifd $d(parameterDefinitions)]}\n}" gencall $d(stub) $d(parameterDefinitions) $d(clientData) cDefs ifDef arglist pre post intro append decls "static int [implArgList $d(implementation) {Tcl_Interp *} $ifDef];\n" @@ -255,7 +255,7 @@ #if {$nrArgs == 1} { puts stderr "$d(stub) => '$arglist'" } if {$nrArgs == 1 && $arglist eq "objc, objv"} { # TODO we would not need to generate a stub at all.... - #set ifd "{\"$::ns($d(methodType))::$d(methodName)\", $d(implementation), $nrArgs, {\n [genifd $d(parameterDefinitions)]}\n}" + #set ifd "{\"$d(ns)::$d(methodName)\", $d(implementation), $nrArgs, {\n [genifd $d(parameterDefinitions)]}\n}" #set stubDecl "static int $d(implementation)$::objCmdProc\n" append fns [genSimpleStub $d(stub) $intro $d(idx) $cDefs $pre $call $post] } elseif {$nrArgs == 1 && $arglist eq "obj, objc, objv"} { @@ -311,12 +311,14 @@ puts "static methodDefinition method_definitions\[\] = \{\n$definitionString,\{NULL\}\n\};\n" } -proc methodDefinition {methodName methodType implementation parameterDefinitions} { +proc methodDefinition {methodName methodType implementation parameterDefinitions {ns ""}} { set d(methodName) $methodName set d(implementation) $implementation set d(stub) ${implementation}Stub set d(idx) ${implementation}Idx set d(methodType) $methodType + if {$ns eq ""} {set ns $::ns($methodType)} + set d(ns) $ns switch $methodType { classMethod {set d(clientData) class} objectMethod {set d(clientData) object} @@ -347,6 +349,12 @@ proc objectMethod {methodName implementation parameterDefinitions} { methodDefinition $methodName objectMethod $implementation $parameterDefinitions } +proc objectInfoMethod {methodName implementation parameterDefinitions} { + methodDefinition $methodName objectMethod $implementation $parameterDefinitions $::ns(objectInfoMethod) +} +proc classInfoMethod {methodName implementation parameterDefinitions} { + methodDefinition $methodName classMethod $implementation $parameterDefinitions $::ns(classInfoMethod) +} proc xotclCmd {methodName implementation parameterDefinitions} { methodDefinition $methodName xotclCmd $implementation $parameterDefinitions } Index: generic/tclAPI.h =================================================================== diff -u -r797decf0bf5d838727a50e35df060f6dfd55e65d -ra47d62c39a33a69e4550eab30369560d56baf574 --- generic/tclAPI.h (.../tclAPI.h) (revision 797decf0bf5d838727a50e35df060f6dfd55e65d) +++ generic/tclAPI.h (.../tclAPI.h) (revision a47d62c39a33a69e4550eab30369560d56baf574) @@ -140,9 +140,11 @@ static CONST char *method_command_namespace_names[] = { "::nsf::cmd::ObjectInfo", + "::nsf::cmd::ObjectInfo2", "::nsf::cmd::Object", "::nsf::cmd::ClassInfo", "::nsf::cmd::ParameterType", + "::nsf::cmd::ClassInfo2", "::nsf::cmd::Class" }; static int XOTclCAllocMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); @@ -152,7 +154,8 @@ static int XOTclCMixinGuardMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); 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 XOTclClassInfoFiltermethodsMethodStub(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 []); @@ -166,7 +169,6 @@ static int XOTclObjInfoCallableMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); 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 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 []); @@ -189,8 +191,11 @@ static int XOTclOResidualargsMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclOUplevelMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclOUpvarMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); +static int XOTclOVarsMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclOVolatileMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclOVwaitMethodStub(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 XOTclObjInfoFiltermethodsMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclAliasCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclAssertionCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclColonCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); @@ -225,7 +230,8 @@ 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 withGuard, int withGuards, CONST char *pattern); +static int XOTclClassInfoFilterguardMethod(Tcl_Interp *interp, XOTclClass *cl, CONST char *filter); +static int XOTclClassInfoFiltermethodsMethod(Tcl_Interp *interp, XOTclClass *cl, 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); @@ -239,7 +245,6 @@ 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 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); @@ -262,8 +267,11 @@ static int XOTclOResidualargsMethod(Tcl_Interp *interp, XOTclObject *obj, int objc, Tcl_Obj *CONST objv[]); static int XOTclOUplevelMethod(Tcl_Interp *interp, XOTclObject *obj, int objc, Tcl_Obj *CONST objv[]); static int XOTclOUpvarMethod(Tcl_Interp *interp, XOTclObject *obj, int objc, Tcl_Obj *CONST objv[]); +static int XOTclOVarsMethod(Tcl_Interp *interp, XOTclObject *obj, CONST char *pattern); static int XOTclOVolatileMethod(Tcl_Interp *interp, XOTclObject *obj); static int XOTclOVwaitMethod(Tcl_Interp *interp, XOTclObject *obj, CONST char *varname); +static int XOTclObjInfoFilterguardMethod(Tcl_Interp *interp, XOTclObject *obj, CONST char *filter); +static int XOTclObjInfoFiltermethodsMethod(Tcl_Interp *interp, XOTclObject *obj, int withGuards, int withOrder, CONST char *pattern); static int XOTclAliasCmd(Tcl_Interp *interp, XOTclObject *object, int withPer_object, CONST char *methodName, int withNonleaf, int withObjscope, Tcl_Obj *cmdName); static int XOTclAssertionCmd(Tcl_Interp *interp, XOTclObject *object, int assertionsubcmd, Tcl_Obj *arg); static int XOTclColonCmd(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); @@ -299,7 +307,8 @@ XOTclCMixinGuardMethodIdx, XOTclCNewMethodIdx, XOTclCRecreateMethodIdx, - XOTclClassInfoFilterMethodIdx, + XOTclClassInfoFilterguardMethodIdx, + XOTclClassInfoFiltermethodsMethodIdx, XOTclClassInfoForwardMethodIdx, XOTclClassInfoHeritageMethodIdx, XOTclClassInfoInstancesMethodIdx, @@ -313,7 +322,6 @@ XOTclObjInfoCallableMethodIdx, XOTclObjInfoChildrenMethodIdx, XOTclObjInfoClassMethodIdx, - XOTclObjInfoFilterMethodIdx, XOTclObjInfoForwardMethodIdx, XOTclObjInfoHasnamespaceMethodIdx, XOTclObjInfoMethodMethodIdx, @@ -336,8 +344,11 @@ XOTclOResidualargsMethodIdx, XOTclOUplevelMethodIdx, XOTclOUpvarMethodIdx, + XOTclOVarsMethodIdx, XOTclOVolatileMethodIdx, XOTclOVwaitMethodIdx, + XOTclObjInfoFilterguardMethodIdx, + XOTclObjInfoFiltermethodsMethodIdx, XOTclAliasCmdIdx, XOTclAssertionCmdIdx, XOTclColonCmdIdx, @@ -503,22 +514,40 @@ } static int -XOTclClassInfoFilterMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { +XOTclClassInfoFilterguardMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; + XOTclClass *cl = XOTclObjectToClass(clientData); + if (!cl) return XOTclObjErrType(interp, objv[0], "Class", ""); + if (ArgumentParse(interp, objc, objv, (XOTclObject *) cl, objv[0], + method_definitions[XOTclClassInfoFilterguardMethodIdx].paramDefs, + method_definitions[XOTclClassInfoFilterguardMethodIdx].nrParameters, + &pc) != TCL_OK) { + return TCL_ERROR; + } else { + CONST char *filter = (CONST char *)pc.clientData[0]; - if (ArgumentParse(interp, objc, objv, NULL, objv[0], - method_definitions[XOTclClassInfoFilterMethodIdx].paramDefs, - method_definitions[XOTclClassInfoFilterMethodIdx].nrParameters, + parseContextRelease(&pc); + return XOTclClassInfoFilterguardMethod(interp, cl, filter); + + } +} + +static int +XOTclClassInfoFiltermethodsMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { + parseContext pc; + XOTclClass *cl = XOTclObjectToClass(clientData); + if (!cl) return XOTclObjErrType(interp, objv[0], "Class", ""); + if (ArgumentParse(interp, objc, objv, (XOTclObject *) cl, objv[0], + method_definitions[XOTclClassInfoFiltermethodsMethodIdx].paramDefs, + method_definitions[XOTclClassInfoFiltermethodsMethodIdx].nrParameters, &pc) != TCL_OK) { return TCL_ERROR; } else { - XOTclClass *class = (XOTclClass *)pc.clientData[0]; - int withGuard = (int )PTR2INT(pc.clientData[1]); - int withGuards = (int )PTR2INT(pc.clientData[2]); - CONST char *pattern = (CONST char *)pc.clientData[3]; + int withGuards = (int )PTR2INT(pc.clientData[0]); + CONST char *pattern = (CONST char *)pc.clientData[1]; parseContextRelease(&pc); - return XOTclClassInfoFilterMethod(interp, class, withGuard, withGuards, pattern); + return XOTclClassInfoFiltermethodsMethod(interp, cl, withGuards, pattern); } } @@ -845,28 +874,6 @@ } static int -XOTclObjInfoFilterMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { - parseContext pc; - - if (ArgumentParse(interp, objc, objv, NULL, objv[0], - method_definitions[XOTclObjInfoFilterMethodIdx].paramDefs, - method_definitions[XOTclObjInfoFilterMethodIdx].nrParameters, - &pc) != TCL_OK) { - return TCL_ERROR; - } else { - XOTclObject *object = (XOTclObject *)pc.clientData[0]; - int withGuard = (int )PTR2INT(pc.clientData[1]); - int withGuards = (int )PTR2INT(pc.clientData[2]); - int withOrder = (int )PTR2INT(pc.clientData[3]); - CONST char *pattern = (CONST char *)pc.clientData[4]; - - parseContextRelease(&pc); - return XOTclObjInfoFilterMethod(interp, object, withGuard, withGuards, withOrder, pattern); - - } -} - -static int XOTclObjInfoForwardMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; @@ -1266,6 +1273,25 @@ } static int +XOTclOVarsMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { + parseContext pc; + XOTclObject *obj = (XOTclObject *)clientData; + if (!obj) return XOTclObjErrType(interp, objv[0], "Object", ""); + if (ArgumentParse(interp, objc, objv, obj, objv[0], + method_definitions[XOTclOVarsMethodIdx].paramDefs, + method_definitions[XOTclOVarsMethodIdx].nrParameters, + &pc) != TCL_OK) { + return TCL_ERROR; + } else { + CONST char *pattern = (CONST char *)pc.clientData[0]; + + parseContextRelease(&pc); + return XOTclOVarsMethod(interp, obj, pattern); + + } +} + +static int XOTclOVolatileMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; XOTclObject *obj = (XOTclObject *)clientData; @@ -1304,6 +1330,46 @@ } static int +XOTclObjInfoFilterguardMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { + parseContext pc; + XOTclObject *obj = (XOTclObject *)clientData; + if (!obj) return XOTclObjErrType(interp, objv[0], "Object", ""); + if (ArgumentParse(interp, objc, objv, obj, objv[0], + method_definitions[XOTclObjInfoFilterguardMethodIdx].paramDefs, + method_definitions[XOTclObjInfoFilterguardMethodIdx].nrParameters, + &pc) != TCL_OK) { + return TCL_ERROR; + } else { + CONST char *filter = (CONST char *)pc.clientData[0]; + + parseContextRelease(&pc); + return XOTclObjInfoFilterguardMethod(interp, obj, filter); + + } +} + +static int +XOTclObjInfoFiltermethodsMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { + parseContext pc; + XOTclObject *obj = (XOTclObject *)clientData; + if (!obj) return XOTclObjErrType(interp, objv[0], "Object", ""); + if (ArgumentParse(interp, objc, objv, obj, objv[0], + method_definitions[XOTclObjInfoFiltermethodsMethodIdx].paramDefs, + method_definitions[XOTclObjInfoFiltermethodsMethodIdx].nrParameters, + &pc) != TCL_OK) { + return TCL_ERROR; + } else { + int withGuards = (int )PTR2INT(pc.clientData[0]); + int withOrder = (int )PTR2INT(pc.clientData[1]); + CONST char *pattern = (CONST char *)pc.clientData[2]; + + parseContextRelease(&pc); + return XOTclObjInfoFiltermethodsMethod(interp, obj, withGuards, withOrder, pattern); + + } +} + +static int XOTclAliasCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; @@ -1842,9 +1908,10 @@ {"name", 1, 0, convertToTclobj}, {"args", 0, 0, convertToNothing}} }, -{"::nsf::cmd::ClassInfo::filter", XOTclClassInfoFilterMethodStub, 4, { - {"class", 1, 0, convertToClass}, - {"-guard", 0, 0, convertToString}, +{"::nsf::cmd::ClassInfo2::filterguard", XOTclClassInfoFilterguardMethodStub, 1, { + {"filter", 1, 0, convertToString}} +}, +{"::nsf::cmd::ClassInfo2::filtermethods", XOTclClassInfoFiltermethodsMethodStub, 2, { {"-guards", 0, 0, convertToString}, {"pattern", 0, 0, convertToString}} }, @@ -1918,13 +1985,6 @@ {"::nsf::cmd::ObjectInfo::class", XOTclObjInfoClassMethodStub, 1, { {"object", 1, 0, convertToObject}} }, -{"::nsf::cmd::ObjectInfo::filter", XOTclObjInfoFilterMethodStub, 5, { - {"object", 1, 0, convertToObject}, - {"-guard", 0, 0, convertToString}, - {"-guards", 0, 0, convertToString}, - {"-order", 0, 0, convertToString}, - {"pattern", 0, 0, convertToString}} -}, {"::nsf::cmd::ObjectInfo::forward", XOTclObjInfoForwardMethodStub, 3, { {"object", 1, 0, convertToObject}, {"-definition", 0, 0, convertToString}, @@ -2012,12 +2072,23 @@ {"::nsf::cmd::Object::upvar", XOTclOUpvarMethodStub, 1, { {"args", 0, 0, convertToNothing}} }, +{"::nsf::cmd::ObjectInfo2::vars", XOTclOVarsMethodStub, 1, { + {"pattern", 0, 0, convertToString}} +}, {"::nsf::cmd::Object::volatile", XOTclOVolatileMethodStub, 0, { } }, {"::nsf::cmd::Object::vwait", XOTclOVwaitMethodStub, 1, { {"varname", 1, 0, convertToString}} }, +{"::nsf::cmd::ObjectInfo2::filterguard", XOTclObjInfoFilterguardMethodStub, 1, { + {"filter", 1, 0, convertToString}} +}, +{"::nsf::cmd::ObjectInfo2::filtermethods", XOTclObjInfoFiltermethodsMethodStub, 3, { + {"-guards", 0, 0, convertToString}, + {"-order", 0, 0, convertToString}, + {"pattern", 0, 0, convertToString}} +}, {"::nsf::alias", XOTclAliasCmdStub, 6, { {"object", 0, 0, convertToObject}, {"-per-object", 0, 0, convertToString}, Index: generic/xotcl.c =================================================================== diff -u -r797decf0bf5d838727a50e35df060f6dfd55e65d -ra47d62c39a33a69e4550eab30369560d56baf574 --- generic/xotcl.c (.../xotcl.c) (revision 797decf0bf5d838727a50e35df060f6dfd55e65d) +++ generic/xotcl.c (.../xotcl.c) (revision a47d62c39a33a69e4550eab30369560d56baf574) @@ -5938,13 +5938,12 @@ DECR_REF_COUNT(tov[1]); #else XOTclObject *self = (XOTclObject *)cp; - char *methodName; - /*fprintf(stderr, "save self %p %s object %p %s\n", - self, objectName(self), - object, objectName(object));*/ + char *methodName = ObjStr(objv[1]); + fprintf(stderr, "save self %p %s (ns %p) object %p %s\n", + self, objectName(self), self->nsPtr, + object, objectName(object)); if (self->nsPtr) { - methodName = ObjStr(objv[1]); cmd = FindMethod(self->nsPtr, methodName); if (cmd) { result = MethodDispatch(object, interp, objc-1, objv+1, @@ -13985,22 +13984,17 @@ } /* -infoObjectMethod filter XOTclObjInfoFilterMethod { - {-argName "object" -required 1 -type object} - {-argName "-guard"} +objectInfoMethod filtermethods XOTclObjInfoFiltermethodsMethod { {-argName "-guards"} {-argName "-order"} {-argName "pattern"} } */ -static int XOTclObjInfoFilterMethod(Tcl_Interp *interp, XOTclObject *object, - int withGuard, int withGuards, int withOrder, +static int XOTclObjInfoFiltermethodsMethod(Tcl_Interp *interp, XOTclObject *object, + 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); @@ -14010,6 +14004,25 @@ } /* +objectInfoMethod filterguard XOTclObjInfoFilterguardMethod { + {-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; +} + +/* TODO MOVE ME */ +/* +classInfoMethod filterguard XOTclClassInfoFilterguardMethod { + {-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; +} + +/* infoObjectMethod forward XOTclObjInfoForwardMethod { {-argName "object" -required 1 -type object} {-argName "-definition"} @@ -14248,20 +14261,13 @@ } /* -infoClassMethod filter XOTclClassInfoFilterMethod { - {-argName "class" -required 1 -type class} - {-argName "-guard"} +classInfoMethod filtermethods XOTclClassInfoFiltermethodsMethod { {-argName "-guards"} {-argName "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; - } +static int XOTclClassInfoFiltermethodsMethod(Tcl_Interp *interp, XOTclClass *class, + int withGuards, CONST char *pattern) { return class->opt ? FilterInfo(interp, class->opt->classfilters, pattern, withGuards, 0) : TCL_OK; } Index: library/nx/nx.tcl =================================================================== diff -u -r797decf0bf5d838727a50e35df060f6dfd55e65d -ra47d62c39a33a69e4550eab30369560d56baf574 --- library/nx/nx.tcl (.../nx.tcl) (revision 797decf0bf5d838727a50e35df060f6dfd55e65d) +++ library/nx/nx.tcl (.../nx.tcl) (revision a47d62c39a33a69e4550eab30369560d56baf574) @@ -436,13 +436,19 @@ # info info :public method info {obj} { set methods [list] - foreach name [::nsf::cmd::ObjectInfo::methods [::nsf::current object]] { + foreach name [::nsf::cmd::ObjectInfo::methods -methodtype all [::nsf::current object]] { if {$name eq "unknown"} continue lappend methods $name } return "valid options are: [join [lsort $methods] {, }]" } + :method filter {o submethod args} { + switch $submethod { + guard {::nsf::dispatch $o ::nsf::cmd::ObjectInfo2::filterguard {*}$args} + methods {::nsf::dispatch $o ::nsf::cmd::ObjectInfo2::filtermethods {*}$args} + } + } :method unknown {method obj args} { error "[::nsf::current object] unknown info option \"$method\"; [$obj info info]" } @@ -452,13 +458,18 @@ :alias is ::nsf::objectproperty :alias classparent ::nsf::cmd::ObjectInfo::parent :alias classchildren ::nsf::cmd::ObjectInfo::children - :alias info [::nsf::cmd::ObjectInfo::method objectInfo handle info] - :alias unknown [::nsf::cmd::ObjectInfo::method objectInfo handle info] + :method filter {o submethod args} { + switch $submethod { + guard {::nsf::dispatch $o ::nsf::cmd::ClassInfo2::filterguard {*}$args} + methods {::nsf::dispatch $o ::nsf::cmd::ClassInfo2::filtermethods {*}$args} + } + } } foreach cmd [info command ::nsf::cmd::ObjectInfo::*] { - ::nsf::alias ::nx::objectInfo [namespace tail $cmd] $cmd - ::nsf::alias ::nx::classInfo [namespace tail $cmd] $cmd + set cmdName [namespace tail $cmd] + ::nsf::alias ::nx::objectInfo $cmdName $cmd + ::nsf::alias ::nx::classInfo $cmdName $cmd } foreach cmd [info command ::nsf::cmd::ClassInfo::*] { set cmdName [namespace tail $cmd] @@ -1067,28 +1078,28 @@ if {[info exists guard]} { ::nsf::dispatch $obj ::nsf::cmd::Object::filterguard $filter $guard } else { - $obj info filter -guard $filter + $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 + $obj info filter guard $filter } } ${os}::Object::slot::mixin method guard {obj prop filter guard:optional} { if {[info exists guard]} { ::nsf::dispatch $obj ::nsf::cmd::Object::mixinguard $filter $guard } else { - $obj info mixin -guard $filter + $obj info mixin guard $filter } } ${os}::Class::slot::mixin method guard {obj prop filter guard:optional} { if {[info exists guard]} { ::nsf::dispatch $obj ::nsf::cmd::Class::mixinguard $filter $guard } else { - $obj info mixin -guard $filter + $obj info mixin guard $filter } } #::nsf::alias ::nx::Class::slot::object-filter guard ${os}::Object::slot::filter::guard Index: library/xotcl/library/xotcl2.tcl =================================================================== diff -u -r513f795175db0329e73b1c7d14fb73255d62235a -ra47d62c39a33a69e4550eab30369560d56baf574 --- library/xotcl/library/xotcl2.tcl (.../xotcl2.tcl) (revision 513f795175db0329e73b1c7d14fb73255d62235a) +++ library/xotcl/library/xotcl2.tcl (.../xotcl2.tcl) (revision a47d62c39a33a69e4550eab30369560d56baf574) @@ -335,8 +335,9 @@ ::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} + :proc instfilter {o args} {::nsf::dispatch $o ::nsf::cmd::ClassInfo2::filtermethods {*}$args} + :proc filterguard {o filter} {::nsf::dispatch $o ::nsf::cmd::ObjectInfo2::filterguard $filter} + :proc instfilterguard {o filter} {::nsf::dispatch $o ::nsf::cmd::ClassInfo2::filterguard $filter} :proc mixinguard {o mixin} {::nsf::cmd::ObjectInfo::mixin $o -guard $mixin} :proc instmixinguard {o mixin} {::nsf::cmd::ClassInfo::mixin $o -guard $mixin} @@ -379,15 +380,15 @@ set guardsFlag [expr {$guards ? "-guards" : ""}] set patternArg [expr {[info exists pattern] ? [list $pattern] : ""}] if {$order && !$guards} { - set def [::nsf::cmd::ObjectInfo::filter $o -order {*}$guardsFlag {*}$patternArg] + set def [::nsf::dispatch $o ::nsf::cmd::ObjectInfo2::filtermethods -order {*}$guardsFlag {*}$patternArg] set def [method_handles_to_xotcl $def] } else { - set def [::nsf::cmd::ObjectInfo::filter $o {*}$guardsFlag {*}$patternArg] + set def [::nsf::dispatch $o ::nsf::cmd::ObjectInfo2::filtermethods {*}$guardsFlag {*}$patternArg] } #puts stderr " => $def" return $def } - :proc filterguard {o filter} {::nsf::cmd::ObjectInfo::filter $o -guard $filter} + :proc filterguard {o filter} {::nsf::dispatch $o ::nsf::cmd::ObjectInfo2::filterguard $filter} :proc mixinguard {o mixin} {::nsf::cmd::ObjectInfo::mixin $o -guard $mixin} # assertion handling @@ -421,7 +422,6 @@ ::nsf::alias ::xotcl::classInfo instmixin ::nsf::cmd::ClassInfo::mixin ::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 instforward ::nsf::cmd::ClassInfo::forward ::nsf::forward ::xotcl::classInfo mixinof ::nsf::cmd::ClassInfo::mixinof %1 -scope object ::nsf::alias ::xotcl::classInfo parameter ::nx::classInfo::parameter Index: tests/info-method.tcl =================================================================== diff -u -r513f795175db0329e73b1c7d14fb73255d62235a -ra47d62c39a33a69e4550eab30369560d56baf574 --- tests/info-method.tcl (.../info-method.tcl) (revision 513f795175db0329e73b1c7d14fb73255d62235a) +++ tests/info-method.tcl (.../info-method.tcl) (revision a47d62c39a33a69e4550eab30369560d56baf574) @@ -100,31 +100,31 @@ ? {o info callable method filter} "::nsf::classes::nx::Object::filter" ? {o filter f} "" ? {o filter guard f { 1 == 1 }} "" - ? {o info 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 info filter methods} "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 info filter guard f} "2 == 2" + ? {Foo info filter methods -guards f} "{f -guard {2 == 2}}" + ? {Foo info filter methods -guards f2} "f2" + ? {Foo info filter methods -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 info filter methods} "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 info filter guard f} "2 == 2" + ? {Foo object info filter methods -guards f} "{f -guard {2 == 2}}" + ? {Foo object info filter methods -guards f2} "f2" + ? {Foo object info filter methods -guards} "{f -guard {2 == 2}} f2" ? {Foo object filter {}} "" Foo destroy