Index: ChangeLog =================================================================== diff -u -r652147d4e1a22b381b2ca9e6354f52e1d8050c61 -r108d81ec266a27d011953bdc6b7d8b32eb0afcc7 --- ChangeLog (.../ChangeLog) (revision 652147d4e1a22b381b2ca9e6354f52e1d8050c61) +++ ChangeLog (.../ChangeLog) (revision 108d81ec266a27d011953bdc6b7d8b32eb0afcc7) @@ -67,8 +67,8 @@ - removed compatibility for versions before Tcl 8.4 (was not tested anyhow) This version requires at least Tcl 8.4. - support for generating interface for ::xotcl commands - - generated interface for ::xotcl::alias, ::xotcl::relation, ::xotcl::setinstvar - - from 15356 generic/xotcl.c => 13311 + - generated interface for ::xotcl::alias, ::xotcl::my, ::xotcl::relation, ::xotcl::setinstvar + - from 15356 generic/xotcl.c => 13288 2009-07-01 - moved all definitions of method commands to generated code Index: generic/gentclAPI.decls =================================================================== diff -u -r652147d4e1a22b381b2ca9e6354f52e1d8050c61 -r108d81ec266a27d011953bdc6b7d8b32eb0afcc7 --- generic/gentclAPI.decls (.../gentclAPI.decls) (revision 652147d4e1a22b381b2ca9e6354f52e1d8050c61) +++ generic/gentclAPI.decls (.../gentclAPI.decls) (revision 108d81ec266a27d011953bdc6b7d8b32eb0afcc7) @@ -24,6 +24,11 @@ {-argName "-protected"} {-argName "cmdName" -required 1 -type tclobj} } +xotclCmd my XOTclMyCmd { + {-argName "-local"} + {-argName "method" -required 1 -type tclobj} + {-argName "args" -type args} +} xotclCmd relation XOTclRelationCmd { {-argName "object" -required 1 -type object} {-argName "reltype" -required 1 -type tclobj} Index: generic/tclAPI.h =================================================================== diff -u -r652147d4e1a22b381b2ca9e6354f52e1d8050c61 -r108d81ec266a27d011953bdc6b7d8b32eb0afcc7 --- generic/tclAPI.h (.../tclAPI.h) (revision 652147d4e1a22b381b2ca9e6354f52e1d8050c61) +++ generic/tclAPI.h (.../tclAPI.h) (revision 108d81ec266a27d011953bdc6b7d8b32eb0afcc7) @@ -110,6 +110,7 @@ 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 XOTclAliasCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); +static int XOTclMyCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclRelationCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclSetInstvarCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); @@ -205,6 +206,7 @@ static int XOTclOVolatileMethod(Tcl_Interp *interp, XOTclObject *obj); static int XOTclOVwaitMethod(Tcl_Interp *interp, XOTclObject *obj, char *varname); static int XOTclAliasCmd(Tcl_Interp *interp, XOTclObject *object, char *methodName, int withObjscope, int withPer_object, int withProtected, Tcl_Obj *cmdName); +static int XOTclMyCmd(Tcl_Interp *interp, int withLocal, Tcl_Obj *method, int nobjc, Tcl_Obj *CONST nobjv[]); static int XOTclRelationCmd(Tcl_Interp *interp, XOTclObject *object, Tcl_Obj *reltype, Tcl_Obj *value); static int XOTclSetInstvarCmd(Tcl_Interp *interp, XOTclObject *object, Tcl_Obj *variable, Tcl_Obj *value); @@ -301,6 +303,7 @@ XOTclOVolatileMethodIdx, XOTclOVwaitMethodIdx, XOTclAliasCmdIdx, + XOTclMyCmdIdx, XOTclRelationCmdIdx, XOTclSetInstvarCmdIdx } XOTclMethods; @@ -1823,6 +1826,21 @@ } static int +XOTclMyCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { + parseContext pc; + + if (parseObjv(interp, objc, objv, XOTclMyCmdIdx, &pc) != TCL_OK) { + return TCL_ERROR; + } else { + int withLocal = (int )pc.clientData[0]; + Tcl_Obj *method = (Tcl_Obj *)pc.clientData[1]; + + return XOTclMyCmd(interp, withLocal, method, objc-pc.lastobjc, objv+pc.lastobjc); + + } +} + +static int XOTclRelationCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; @@ -2239,6 +2257,11 @@ {"-protected", 0, 0, NULL}, {"cmdName", 1, 0, "tclobj"}} }, +{"::xotcl::my", XOTclMyCmdStub, { + {"-local", 0, 0, NULL}, + {"method", 1, 0, "tclobj"}, + {"args", 0, 0, "args"}} +}, {"::xotcl::relation", XOTclRelationCmdStub, { {"object", 1, 0, "object"}, {"reltype", 1, 0, "tclobj"}, Index: generic/xotcl.c =================================================================== diff -u -r652147d4e1a22b381b2ca9e6354f52e1d8050c61 -r108d81ec266a27d011953bdc6b7d8b32eb0afcc7 --- generic/xotcl.c (.../xotcl.c) (revision 652147d4e1a22b381b2ca9e6354f52e1d8050c61) +++ generic/xotcl.c (.../xotcl.c) (revision 108d81ec266a27d011953bdc6b7d8b32eb0afcc7) @@ -10119,6 +10119,32 @@ return TCL_OK; } +static int XOTclMyCmd(Tcl_Interp *interp, int withLocal, Tcl_Obj *method, int nobjc, Tcl_Obj *CONST nobjv[]) { + XOTclObject *self = GetSelfObj(interp); + int result; + + if (!self) + return XOTclVarErrMsg(interp, "Cannot resolve 'self', probably called outside the context of an XOTcl Object", + (char *) NULL); + + if (withLocal) { + XOTclClass *cl = self->cl; + char *methodName = ObjStr(method); + Tcl_Command cmd = FindMethod(methodName, cl->nsPtr); + if (cmd == 0) + return XOTclVarErrMsg(interp, objectName(self), + ": unable to dispatch local method '", + methodName, "' in class ", className(cl), + (char *) NULL); + result = DoCallProcCheck((ClientData)self, interp, nobjc+2, nobjv, cmd, self, cl, + methodName, 0); + } else { + result = callMethod((ClientData)self, interp, method, nobjc+2, nobjv, 0); + } + return result; +} + + static int XOTclRelationCmd(Tcl_Interp *interp, XOTclObject *object, Tcl_Obj *reltype, Tcl_Obj *value) { int oc; Tcl_Obj **ov; XOTclObject *nobj = NULL; @@ -10861,12 +10887,10 @@ int withObjscope, Tcl_Obj *withOnerror, int withVerbose, Tcl_Obj *target, int nobjc, Tcl_Obj *CONST nobjv[]) { forwardCmdClientData *tcd; - int rc; - - rc = forwardProcessOptions(interp, method, - withDefault, withEarlybinding, withMethodprefix, - withObjscope, withOnerror, withVerbose, - target, nobjc, nobjv, &tcd); + int rc = forwardProcessOptions(interp, method, + withDefault, withEarlybinding, withMethodprefix, + withObjscope, withOnerror, withVerbose, + target, nobjc, nobjv, &tcd); if (rc == TCL_OK) { tcd->obj = obj; XOTclAddPMethod(interp, (XOTcl_Object *)obj, NSTail(ObjStr(method)), @@ -12225,50 +12249,7 @@ return rc; } -int -XOTclSelfDispatchCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { - XOTclObject *self; - int result, i = 1; - char *arg1; - if (objc < 2) return XOTclObjErrArgCnt(interp, objv[0], NULL, "?-local? method ?args?"); - - if (!(self = GetSelfObj(interp))) { - result = XOTclVarErrMsg(interp, "Cannot resolve 'self', probably called outside the context of an XOTcl Object", - (char *) NULL); - } - - arg1 = ObjStr(objv[1]); - - if (*arg1 == '-' && !strcmp("-local", arg1)) { - XOTclClass *cl = GetSelfClass(interp); - Tcl_Command cmd; - char *method; - if (objc < 3) return XOTclObjErrArgCnt(interp, objv[0], NULL, "?-local? method ?args?"); - - method = ObjStr(objv[2]); - i++; - cmd = FindMethod(method, cl->nsPtr); - if (cmd == 0) - return XOTclVarErrMsg(interp, objectName(self), - ": unable to dispatch local method '", - method, "' in class ", className(cl), - (char *) NULL); - /*fprintf(stderr, "method %s, cmd = %p objc=%d\n", method, cmd, objc); - for (i=0; i