Index: doc/index.html =================================================================== diff -u -rae1f8003c9b771906e285970f31ff9f12ce40558 -r1a2ed9fd48d2c4326e27378a9a8accae1c008bad --- doc/index.html (.../index.html) (revision ae1f8003c9b771906e285970f31ff9f12ce40558) +++ doc/index.html (.../index.html) (revision 1a2ed9fd48d2c4326e27378a9a8accae1c008bad) @@ -23,7 +23,7 @@

Index: generic/gentclAPI.decls =================================================================== diff -u -rc09536ecf46b5a272a87a42a7deb59b852df5ec8 -r1a2ed9fd48d2c4326e27378a9a8accae1c008bad --- generic/gentclAPI.decls (.../gentclAPI.decls) (revision c09536ecf46b5a272a87a42a7deb59b852df5ec8) +++ generic/gentclAPI.decls (.../gentclAPI.decls) (revision 1a2ed9fd48d2c4326e27378a9a8accae1c008bad) @@ -301,13 +301,13 @@ infoObjectMethod method XOTclObjInfoMethodMethod { {-argName "object" -type object} - {-argName "infomethodsubcmd" -type "args|definition|name|parameter|type"} + {-argName "infomethodsubcmd" -type "args|definition|name|parameter|type|pre|post"} {-argName "name"} } ### TODO move finally to infoclassmethod infoClassMethod method XOTclClassInfoMethodMethod { {-argName "class" -type class} - {-argName "infomethodsubcmd" -type "args|definition|name|parameter|type"} + {-argName "infomethodsubcmd" -type "args|definition|name|parameter|type|pre|post"} {-argName "name"} } @@ -342,14 +342,6 @@ infoObjectMethod parent XOTclObjInfoParentMethod { {-argName "object" -required 1 -type object} } -infoObjectMethod post XOTclObjInfoPostMethod { - {-argName "object" -required 1 -type object} - {-argName "methodName" -required 1} -} -infoObjectMethod pre XOTclObjInfoPreMethod { - {-argName "object" -required 1 -type object} - {-argName "methodName" -required 1} -} infoObjectMethod precedence XOTclObjInfoPrecedenceMethod { {-argName "object" -required 1 -type object} {-argName "-intrinsic"} @@ -396,7 +388,7 @@ {-argName "-definition"} {-argName "name"} } -infoClassMethod instinvar XOTclClassInfoInstinvarMethod { +infoClassMethod invar XOTclClassInfoInvarMethod { {-argName "class" -required 1 -type class} } infoClassMethod mixin XOTclClassInfoMixinMethod { @@ -414,14 +406,6 @@ {-argName "-closure"} {-argName "pattern" -type objpattern} } -infoClassMethod instpost XOTclClassInfoInstpostMethod { - {-argName "class" -required 1 -type class} - {-argName "methodName" -required 1} -} -infoClassMethod instpre XOTclClassInfoInstpreMethod { - {-argName "class" -required 1 -type class} - {-argName "methodName" -required 1} -} infoClassMethod mixinof XOTclClassInfoMixinofMethod { {-argName "class" -required 1 -type class} {-argName "-closure"} Index: generic/tclAPI.h =================================================================== diff -u -rc09536ecf46b5a272a87a42a7deb59b852df5ec8 -r1a2ed9fd48d2c4326e27378a9a8accae1c008bad --- generic/tclAPI.h (.../tclAPI.h) (revision c09536ecf46b5a272a87a42a7deb59b852df5ec8) +++ generic/tclAPI.h (.../tclAPI.h) (revision 1a2ed9fd48d2c4326e27378a9a8accae1c008bad) @@ -1,12 +1,12 @@ static int convertToInfomethodsubcmd(Tcl_Interp *interp, Tcl_Obj *objPtr, XOTclParam CONST *pPtr, ClientData *clientData) { int index, result; - static CONST char *opts[] = {"args", "definition", "name", "parameter", "type", NULL}; + static CONST char *opts[] = {"args", "definition", "name", "parameter", "type", "pre", "post", NULL}; result = Tcl_GetIndexFromObj(interp, objPtr, opts, "infomethodsubcmd", 0, &index); *clientData = (ClientData) index + 1; return result; } -enum InfomethodsubcmdIdx {InfomethodsubcmdNULL, InfomethodsubcmdArgsIdx, InfomethodsubcmdDefinitionIdx, InfomethodsubcmdNameIdx, InfomethodsubcmdParameterIdx, InfomethodsubcmdTypeIdx}; +enum InfomethodsubcmdIdx {InfomethodsubcmdNULL, InfomethodsubcmdArgsIdx, InfomethodsubcmdDefinitionIdx, InfomethodsubcmdNameIdx, InfomethodsubcmdParameterIdx, InfomethodsubcmdTypeIdx, InfomethodsubcmdPreIdx, InfomethodsubcmdPostIdx}; static int convertToMethodtype(Tcl_Interp *interp, Tcl_Obj *objPtr, XOTclParam CONST *pPtr, ClientData *clientData) { int index, result; @@ -107,10 +107,8 @@ 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 []); -static int XOTclClassInfoInstinvarMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclClassInfoInstmixinofMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); -static int XOTclClassInfoInstpostMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); -static int XOTclClassInfoInstpreMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); +static int XOTclClassInfoInvarMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclClassInfoMethodMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclClassInfoMethodsMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclClassInfoMixinMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); @@ -134,8 +132,6 @@ static int XOTclObjInfoMixinMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclObjInfoMixinguardMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclObjInfoParentMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); -static int XOTclObjInfoPostMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); -static int XOTclObjInfoPreMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclObjInfoPrecedenceMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclObjInfoSlotObjectsMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclObjInfoVarsMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); @@ -201,10 +197,8 @@ static int XOTclClassInfoForwardMethod(Tcl_Interp *interp, XOTclClass *class, int withDefinition, char *name); static int XOTclClassInfoHeritageMethod(Tcl_Interp *interp, XOTclClass *class, char *pattern); static int XOTclClassInfoInstancesMethod(Tcl_Interp *interp, XOTclClass *class, int withClosure, char *patternString, XOTclObject *patternObj); -static int XOTclClassInfoInstinvarMethod(Tcl_Interp *interp, XOTclClass *class); static int XOTclClassInfoInstmixinofMethod(Tcl_Interp *interp, XOTclClass *class, int withClosure, char *patternString, XOTclObject *patternObj); -static int XOTclClassInfoInstpostMethod(Tcl_Interp *interp, XOTclClass *class, char *methodName); -static int XOTclClassInfoInstpreMethod(Tcl_Interp *interp, XOTclClass *class, char *methodName); +static int XOTclClassInfoInvarMethod(Tcl_Interp *interp, XOTclClass *class); static int XOTclClassInfoMethodMethod(Tcl_Interp *interp, XOTclClass *class, int infomethodsubcmd, char *name); static int XOTclClassInfoMethodsMethod(Tcl_Interp *interp, XOTclClass *object, int withDefined, int withMethodtype, int withNomixins, int withIncontext, char *pattern); static int XOTclClassInfoMixinMethod(Tcl_Interp *interp, XOTclClass *class, int withClosure, int withGuards, char *patternString, XOTclObject *patternObj); @@ -228,8 +222,6 @@ static int XOTclObjInfoMixinMethod(Tcl_Interp *interp, XOTclObject *object, int withGuards, int withOrder, char *patternString, XOTclObject *patternObj); static int XOTclObjInfoMixinguardMethod(Tcl_Interp *interp, XOTclObject *object, char *mixin); static int XOTclObjInfoParentMethod(Tcl_Interp *interp, XOTclObject *object); -static int XOTclObjInfoPostMethod(Tcl_Interp *interp, XOTclObject *object, char *methodName); -static int XOTclObjInfoPreMethod(Tcl_Interp *interp, XOTclObject *object, char *methodName); static int XOTclObjInfoPrecedenceMethod(Tcl_Interp *interp, XOTclObject *object, int withIntrinsic, char *pattern); static int XOTclObjInfoSlotObjectsMethod(Tcl_Interp *interp, XOTclObject *object, char *pattern); static int XOTclObjInfoVarsMethod(Tcl_Interp *interp, XOTclObject *object, char *pattern); @@ -296,10 +288,8 @@ XOTclClassInfoForwardMethodIdx, XOTclClassInfoHeritageMethodIdx, XOTclClassInfoInstancesMethodIdx, - XOTclClassInfoInstinvarMethodIdx, XOTclClassInfoInstmixinofMethodIdx, - XOTclClassInfoInstpostMethodIdx, - XOTclClassInfoInstpreMethodIdx, + XOTclClassInfoInvarMethodIdx, XOTclClassInfoMethodMethodIdx, XOTclClassInfoMethodsMethodIdx, XOTclClassInfoMixinMethodIdx, @@ -323,8 +313,6 @@ XOTclObjInfoMixinMethodIdx, XOTclObjInfoMixinguardMethodIdx, XOTclObjInfoParentMethodIdx, - XOTclObjInfoPostMethodIdx, - XOTclObjInfoPreMethodIdx, XOTclObjInfoPrecedenceMethodIdx, XOTclObjInfoSlotObjectsMethodIdx, XOTclObjInfoVarsMethodIdx, @@ -791,24 +779,6 @@ } static int -XOTclClassInfoInstinvarMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { - parseContext pc; - - if (ArgumentParse(interp, objc, objv, NULL, objv[0], - method_definitions[XOTclClassInfoInstinvarMethodIdx].paramDefs, - method_definitions[XOTclClassInfoInstinvarMethodIdx].nrParameters, - &pc) != TCL_OK) { - return TCL_ERROR; - } else { - XOTclClass *class = (XOTclClass *)pc.clientData[0]; - - parseContextRelease(&pc); - return XOTclClassInfoInstinvarMethod(interp, class); - - } -} - -static int XOTclClassInfoInstmixinofMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; @@ -843,44 +813,24 @@ } static int -XOTclClassInfoInstpostMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { +XOTclClassInfoInvarMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; if (ArgumentParse(interp, objc, objv, NULL, objv[0], - method_definitions[XOTclClassInfoInstpostMethodIdx].paramDefs, - method_definitions[XOTclClassInfoInstpostMethodIdx].nrParameters, + method_definitions[XOTclClassInfoInvarMethodIdx].paramDefs, + method_definitions[XOTclClassInfoInvarMethodIdx].nrParameters, &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclClass *class = (XOTclClass *)pc.clientData[0]; - char *methodName = (char *)pc.clientData[1]; parseContextRelease(&pc); - return XOTclClassInfoInstpostMethod(interp, class, methodName); + return XOTclClassInfoInvarMethod(interp, class); } } static int -XOTclClassInfoInstpreMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { - parseContext pc; - - if (ArgumentParse(interp, objc, objv, NULL, objv[0], - method_definitions[XOTclClassInfoInstpreMethodIdx].paramDefs, - method_definitions[XOTclClassInfoInstpreMethodIdx].nrParameters, - &pc) != TCL_OK) { - return TCL_ERROR; - } else { - XOTclClass *class = (XOTclClass *)pc.clientData[0]; - char *methodName = (char *)pc.clientData[1]; - - parseContextRelease(&pc); - return XOTclClassInfoInstpreMethod(interp, class, methodName); - - } -} - -static int XOTclClassInfoMethodMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; @@ -1388,44 +1338,6 @@ } static int -XOTclObjInfoPostMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { - parseContext pc; - - if (ArgumentParse(interp, objc, objv, NULL, objv[0], - method_definitions[XOTclObjInfoPostMethodIdx].paramDefs, - method_definitions[XOTclObjInfoPostMethodIdx].nrParameters, - &pc) != TCL_OK) { - return TCL_ERROR; - } else { - XOTclObject *object = (XOTclObject *)pc.clientData[0]; - char *methodName = (char *)pc.clientData[1]; - - parseContextRelease(&pc); - return XOTclObjInfoPostMethod(interp, object, methodName); - - } -} - -static int -XOTclObjInfoPreMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { - parseContext pc; - - if (ArgumentParse(interp, objc, objv, NULL, objv[0], - method_definitions[XOTclObjInfoPreMethodIdx].paramDefs, - method_definitions[XOTclObjInfoPreMethodIdx].nrParameters, - &pc) != TCL_OK) { - return TCL_ERROR; - } else { - XOTclObject *object = (XOTclObject *)pc.clientData[0]; - char *methodName = (char *)pc.clientData[1]; - - parseContextRelease(&pc); - return XOTclObjInfoPreMethod(interp, object, methodName); - - } -} - -static int XOTclObjInfoPrecedenceMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; @@ -2320,22 +2232,14 @@ {"-closure", 0, 0, convertToString}, {"pattern", 0, 0, convertToObjpattern}} }, -{"::xotcl::cmd::ClassInfo::instinvar", XOTclClassInfoInstinvarMethodStub, 1, { - {"class", 1, 0, convertToClass}} -}, {"::xotcl::cmd::ClassInfo::instmixinof", XOTclClassInfoInstmixinofMethodStub, 3, { {"class", 1, 0, convertToClass}, {"-closure", 0, 0, convertToString}, {"pattern", 0, 0, convertToObjpattern}} }, -{"::xotcl::cmd::ClassInfo::instpost", XOTclClassInfoInstpostMethodStub, 2, { - {"class", 1, 0, convertToClass}, - {"methodName", 1, 0, convertToString}} +{"::xotcl::cmd::ClassInfo::invar", XOTclClassInfoInvarMethodStub, 1, { + {"class", 1, 0, convertToClass}} }, -{"::xotcl::cmd::ClassInfo::instpre", XOTclClassInfoInstpreMethodStub, 2, { - {"class", 1, 0, convertToClass}, - {"methodName", 1, 0, convertToString}} -}, {"::xotcl::cmd::ClassInfo::method", XOTclClassInfoMethodMethodStub, 3, { {"class", 0, 0, convertToClass}, {"infomethodsubcmd", 0, 0, convertToInfomethodsubcmd}, @@ -2442,14 +2346,6 @@ {"::xotcl::cmd::ObjectInfo::parent", XOTclObjInfoParentMethodStub, 1, { {"object", 1, 0, convertToObject}} }, -{"::xotcl::cmd::ObjectInfo::post", XOTclObjInfoPostMethodStub, 2, { - {"object", 1, 0, convertToObject}, - {"methodName", 1, 0, convertToString}} -}, -{"::xotcl::cmd::ObjectInfo::pre", XOTclObjInfoPreMethodStub, 2, { - {"object", 1, 0, convertToObject}, - {"methodName", 1, 0, convertToString}} -}, {"::xotcl::cmd::ObjectInfo::precedence", XOTclObjInfoPrecedenceMethodStub, 3, { {"object", 1, 0, convertToObject}, {"-intrinsic", 0, 0, convertToString}, Index: generic/xotcl.c =================================================================== diff -u -rc09536ecf46b5a272a87a42a7deb59b852df5ec8 -r1a2ed9fd48d2c4326e27378a9a8accae1c008bad --- generic/xotcl.c (.../xotcl.c) (revision c09536ecf46b5a272a87a42a7deb59b852df5ec8) +++ generic/xotcl.c (.../xotcl.c) (revision 1a2ed9fd48d2c4326e27378a9a8accae1c008bad) @@ -9667,7 +9667,33 @@ Tcl_Command importedCmd = GetOriginalCommand(cmd); return ListCmdParams(interp, importedCmd, methodName, 0); } + case InfomethodsubcmdPreIdx: + { + XOTclProcAssertion *procs; + if (withPer_object) { + procs = object->opt ? AssertionFindProcs(object->opt->assertions, methodName) : NULL; + } else { + XOTclClass *class = (XOTclClass *)object; + procs = class->opt ? AssertionFindProcs(class->opt->assertions, methodName) : NULL; + } + if (procs) Tcl_SetObjResult(interp, AssertionList(interp, procs->pre)); + return TCL_OK; + } + case InfomethodsubcmdPostIdx: + { + XOTclProcAssertion *procs; + if (withPer_object) { + procs = object->opt ? AssertionFindProcs(object->opt->assertions, methodName) : NULL; + } else { + XOTclClass *class = (XOTclClass *)object; + procs = class->opt ? AssertionFindProcs(class->opt->assertions, methodName) : NULL; + } + if (procs) Tcl_SetObjResult(interp, AssertionList(interp, procs->post)); + return TCL_OK; + } + } + /* * Subcommands different per type of method. The Converter in * InfoMethods defines the types: @@ -12679,22 +12705,6 @@ return TCL_OK; } -static int XOTclObjInfoPostMethod(Tcl_Interp *interp, XOTclObject *object, char *methodName) { - if (object->opt) { - XOTclProcAssertion *procs = AssertionFindProcs(object->opt->assertions, methodName); - if (procs) Tcl_SetObjResult(interp, AssertionList(interp, procs->post)); - } - return TCL_OK; -} - -static int XOTclObjInfoPreMethod(Tcl_Interp *interp, XOTclObject *object, char *methodName) { - if (object->opt) { - XOTclProcAssertion *procs = AssertionFindProcs(object->opt->assertions, methodName); - if (procs) Tcl_SetObjResult(interp, AssertionList(interp, procs->pre)); - } - return TCL_OK; -} - static int XOTclObjInfoPrecedenceMethod(Tcl_Interp *interp, XOTclObject *object, int withIntrinsicOnly, char *pattern) { XOTclClasses *precedenceList = NULL, *pl; @@ -12833,7 +12843,7 @@ return ListForward(interp, Tcl_Namespace_cmdTable(class->nsPtr), pattern, withDefinition); } -static int XOTclClassInfoInstinvarMethod(Tcl_Interp *interp, XOTclClass * class) { +static int XOTclClassInfoInvarMethod(Tcl_Interp *interp, XOTclClass * class) { XOTclClassOpt *opt = class->opt; if (opt && opt->assertions) { @@ -12896,22 +12906,6 @@ return TCL_OK; } -static int XOTclClassInfoInstpostMethod(Tcl_Interp *interp, XOTclClass * class, char * methodName) { - if (class->opt) { - XOTclProcAssertion *procs = AssertionFindProcs(class->opt->assertions, methodName); - if (procs) Tcl_SetObjResult(interp, AssertionList(interp, procs->post)); - } - return TCL_OK; -} - -static int XOTclClassInfoInstpreMethod(Tcl_Interp *interp, XOTclClass *class, char *methodName) { - if (class->opt) { - XOTclProcAssertion *procs = AssertionFindProcs(class->opt->assertions, methodName); - if (procs) Tcl_SetObjResult(interp, AssertionList(interp, procs->pre)); - } - return TCL_OK; -} - static int XOTclClassInfoMixinofMethod(Tcl_Interp *interp, XOTclClass * class, int withClosure, char *patternString, XOTclObject *patternObj) { XOTclClassOpt *opt = class->opt; Index: library/lib/xotcl1.xotcl =================================================================== diff -u -rc09536ecf46b5a272a87a42a7deb59b852df5ec8 -r1a2ed9fd48d2c4326e27378a9a8accae1c008bad --- library/lib/xotcl1.xotcl (.../xotcl1.xotcl) (revision c09536ecf46b5a272a87a42a7deb59b852df5ec8) +++ library/lib/xotcl1.xotcl (.../xotcl1.xotcl) (revision 1a2ed9fd48d2c4326e27378a9a8accae1c008bad) @@ -248,6 +248,8 @@ .method instbody {o methodName} { lindex [::xotcl::cmd::ClassInfo::method $o definition $methodName] end } + .method instpre {o methodName} {::xotcl::cmd::ClassInfo::method $o pre $methodName} + .method instpost {o methodName} {::xotcl::cmd::ClassInfo::method $o post $methodName} # info options emulated by "info methods" .method instcommands {o {pattern:optional ""}} { @@ -273,6 +275,8 @@ .method body {o methodName} { lindex [::xotcl::cmd::ObjectInfo::method $o definition $methodName] end } + .method pre {o methodName} {::xotcl::cmd::ObjectInfo::method $o pre $methodName} + .method post {o methodName} {::xotcl::cmd::ObjectInfo::method $o post $methodName} # info options emulated by "info methods" .method commands {o {pattern:optional ""}} { @@ -317,12 +321,15 @@ ::xotcl::alias ::xotcl::classInfo instfilter ::xotcl::cmd::ClassInfo::filter ::xotcl::alias ::xotcl::classInfo instfilterguard ::xotcl::cmd::ClassInfo::filterguard ::xotcl::alias ::xotcl::classInfo instforward ::xotcl::cmd::ClassInfo::forward + ::xotcl::alias ::xotcl::classInfo instinvar ::xotcl::cmd::ClassInfo::invar # define info methods from objectInfo on classInfo as well ::xotcl::alias classInfo body objectInfo::body ::xotcl::alias classInfo commands objectInfo::commands ::xotcl::alias classInfo methods objectInfo::methods ::xotcl::alias classInfo procs objectInfo::procs + ::xotcl::alias classInfo pre objectInfo::pre + ::xotcl::alias classInfo post objectInfo::post # emulation of isobject, isclass ...