Index: generic/gentclAPI.decls =================================================================== diff -u -r62a9d39ecd1f540f08c895175a7f085cfb4ae845 -r68e773f0a21300bd799c60fefc76f696fd230ca0 --- generic/gentclAPI.decls (.../gentclAPI.decls) (revision 62a9d39ecd1f540f08c895175a7f085cfb4ae845) +++ generic/gentclAPI.decls (.../gentclAPI.decls) (revision 68e773f0a21300bd799c60fefc76f696fd230ca0) @@ -57,6 +57,19 @@ } xotclCmd finalize XOTclFinalizeObjCmd { } +xotclCmd forward XOTclForwardCmd { + {-argName "object" -required 1 -type object} + {-argName "-per-object"} + {-argName "method" -required 1 -type tclobj} + {-argName "-default" -nrargs 1 -type tclobj} + {-argName "-earlybinding"} + {-argName "-methodprefix" -nrargs 1 -type tclobj} + {-argName "-objscope"} + {-argName "-onerror" -nrargs 1 -type tclobj} + {-argName "-verbose"} + {-argName "target" -type tclobj} + {-argName "args" -type args} +} xotclCmd interp XOTclInterpObjCmd { {-argName "name"} {-argName "args" -type allargs} @@ -147,17 +160,6 @@ objectMethod filtersearch XOTclOFilterSearchMethod { {-argName "filter" -required 1} } -objectMethod forward XOTclOForwardMethod { - {-argName "method" -required 1 -type tclobj} - {-argName "-default" -nrargs 1 -type tclobj} - {-argName "-earlybinding"} - {-argName "-methodprefix" -nrargs 1 -type tclobj} - {-argName "-objscope"} - {-argName "-onerror" -nrargs 1 -type tclobj} - {-argName "-verbose"} - {-argName "target" -type tclobj} - {-argName "args" -type args} -} objectMethod instvar XOTclOInstVarMethod { {-argName "args" -type allargs} } @@ -212,17 +214,6 @@ {-argName "mixin" -required 1} {-argName "guard" -required 1 -type tclobj} } -classMethod forward XOTclCForwardMethod { - {-argName "name" -required 1 -type tclobj} - {-argName "-default" -nrargs 1 -type tclobj} - {-argName "-earlybinding"} - {-argName "-methodprefix" -nrargs 1 -type tclobj} - {-argName "-objscope"} - {-argName "-onerror" -nrargs 1 -type tclobj} - {-argName "-verbose"} - {-argName "target" -type tclobj} - {-argName "args" -type args} -} classMethod __invalidateobjectparameter XOTclCInvalidateObjectParameterMethod { } classMethod recreate XOTclCRecreateMethod { Index: generic/gentclAPI.tcl =================================================================== diff -u -rfcf06c1f38122e0058d3092a3efa9f01d1e7ce04 -r68e773f0a21300bd799c60fefc76f696fd230ca0 --- generic/gentclAPI.tcl (.../gentclAPI.tcl) (revision fcf06c1f38122e0058d3092a3efa9f01d1e7ce04) +++ generic/gentclAPI.tcl (.../gentclAPI.tcl) (revision 68e773f0a21300bd799c60fefc76f696fd230ca0) @@ -278,7 +278,7 @@ char *methodName; Tcl_ObjCmdProc *proc; int nrParameters; - XOTclParam paramDefs[11]; + XOTclParam paramDefs[12]; } methodDefinition; static int ArgumentParse(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], Index: generic/predefined.h =================================================================== diff -u -r62a9d39ecd1f540f08c895175a7f085cfb4ae845 -r68e773f0a21300bd799c60fefc76f696fd230ca0 --- generic/predefined.h (.../predefined.h) (revision 62a9d39ecd1f540f08c895175a7f085cfb4ae845) +++ generic/predefined.h (.../predefined.h) (revision 68e773f0a21300bd799c60fefc76f696fd230ca0) @@ -1,6 +1,7 @@ static char cmd[] = "namespace eval ::xotcl {\n" "set bootstrap 1}\n" +"puts stderr HELLLO-0\n" "namespace eval xotcl2 {\n" "namespace path ::xotcl\n" "::xotcl::createobjectsystem ::xotcl2::Object ::xotcl2::Class\n" @@ -65,6 +66,10 @@ ".protected method init args {}\n" ".protected method defaultmethod {} {::xotcl::self}\n" ".protected method objectparameter {} {;}}\n" +"puts stderr HELLLO-1\n" +"::xotcl::forward Object forward -verbose ::xotcl::forward %self -per-object\n" +"::xotcl::forward Class forward -verbose ::xotcl::forward %self\n" +"puts stderr HELLLO-3\n" "Class protected object method __unknown {name} {}\n" "Object public method alias {-objscope:switch methodName cmd} {\n" "::xotcl::alias [self] $methodName \\\n" Index: generic/predefined.xotcl =================================================================== diff -u -r62a9d39ecd1f540f08c895175a7f085cfb4ae845 -r68e773f0a21300bd799c60fefc76f696fd230ca0 --- generic/predefined.xotcl (.../predefined.xotcl) (revision 62a9d39ecd1f540f08c895175a7f085cfb4ae845) +++ generic/predefined.xotcl (.../predefined.xotcl) (revision 68e773f0a21300bd799c60fefc76f696fd230ca0) @@ -6,6 +6,8 @@ set bootstrap 1 } +puts stderr HELLLO-0 + # # First create the ::xotcl2 object system. # @@ -134,41 +136,41 @@ .protected method objectparameter {} {;} } + # define forward methods + ::xotcl::forward Object forward -verbose ::xotcl::forward %self -per-object + ::xotcl::forward Class forward -verbose ::xotcl::forward %self + # The method __unknown is called in cases, where we try to resolve # an unkown class. one could define a custom resolver with this name # to load the class on the fly. After the call to __unknown, XOTcl # tries to resolve the class again. This meachnism is used e.g. by # the ::ttrace mechanism for partial loading by Zoran. # - # TODO: check, of protected is OK Class protected object method __unknown {name} {} - # Add an alias method. cmdName for XOTcl method can be added via + # Add alias methods. cmdName for XOTcl method can be added via # [... info method name ] - - #::xotcl::alias Object $cmd -objscope ::$cmd - + # Object public method alias {-objscope:switch methodName cmd} { - ::xotcl::alias [self] $methodName \ - -per-object \ + ::xotcl::alias [self] $methodName -per-object \ {*}[expr {${objscope} ? "-objscope" : ""}] \ $cmd } - Class public method alias {-objscope:switch methodName cmd} { ::xotcl::alias [self] $methodName \ {*}[expr {${objscope} ? "-objscope" : ""}] \ $cmd } - + + # Add setter methods. + # Object public method setter {methodName value:optional} { if {[info exists value]} { ::xotcl::setter [self] $methodName -per-object $value } else { ::xotcl::setter [self] $methodName -per-object } } - Class public method setter {methodName value:optional} { if {[info exists value]} { ::xotcl::setter [self] $methodName $value Index: generic/tclAPI.h =================================================================== diff -u -r62a9d39ecd1f540f08c895175a7f085cfb4ae845 -r68e773f0a21300bd799c60fefc76f696fd230ca0 --- generic/tclAPI.h (.../tclAPI.h) (revision 62a9d39ecd1f540f08c895175a7f085cfb4ae845) +++ generic/tclAPI.h (.../tclAPI.h) (revision 68e773f0a21300bd799c60fefc76f696fd230ca0) @@ -85,7 +85,7 @@ char *methodName; Tcl_ObjCmdProc *proc; int nrParameters; - XOTclParam paramDefs[11]; + XOTclParam paramDefs[12]; } methodDefinition; static int ArgumentParse(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], @@ -111,7 +111,6 @@ static int XOTclCCreateMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclCDeallocMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclCFilterGuardMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); -static int XOTclCForwardMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclCInvalidateObjectParameterMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); 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 []); @@ -153,7 +152,6 @@ static int XOTclOExistsMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclOFilterGuardMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclOFilterSearchMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); -static int XOTclOForwardMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclOInstVarMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclOMixinGuardMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclONextMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); @@ -173,6 +171,7 @@ static int XOTclDotCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclExistsCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclFinalizeObjCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); +static int XOTclForwardCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclGetSelfObjCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclImportvarCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclInterpObjCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); @@ -193,7 +192,6 @@ static int XOTclCCreateMethod(Tcl_Interp *interp, XOTclClass *cl, char *name, int objc, Tcl_Obj *CONST objv[]); static int XOTclCDeallocMethod(Tcl_Interp *interp, XOTclClass *cl, Tcl_Obj *object); static int XOTclCFilterGuardMethod(Tcl_Interp *interp, XOTclClass *cl, char *filter, Tcl_Obj *guard); -static int XOTclCForwardMethod(Tcl_Interp *interp, XOTclClass *cl, Tcl_Obj *name, Tcl_Obj *withDefault, int withEarlybinding, Tcl_Obj *withMethodprefix, int withObjscope, Tcl_Obj *withOnerror, int withVerbose, Tcl_Obj *target, int nobjc, Tcl_Obj *CONST nobjv[]); static int XOTclCInvalidateObjectParameterMethod(Tcl_Interp *interp, XOTclClass *cl); static int XOTclCMixinGuardMethod(Tcl_Interp *interp, XOTclClass *cl, char *mixin, Tcl_Obj *guard); static int XOTclCNewMethod(Tcl_Interp *interp, XOTclClass *cl, XOTclObject *withChildof, int nobjc, Tcl_Obj *CONST nobjv[]); @@ -235,7 +233,6 @@ static int XOTclOExistsMethod(Tcl_Interp *interp, XOTclObject *obj, char *var); static int XOTclOFilterGuardMethod(Tcl_Interp *interp, XOTclObject *obj, char *filter, Tcl_Obj *guard); static int XOTclOFilterSearchMethod(Tcl_Interp *interp, XOTclObject *obj, char *filter); -static int XOTclOForwardMethod(Tcl_Interp *interp, XOTclObject *obj, Tcl_Obj *method, Tcl_Obj *withDefault, int withEarlybinding, Tcl_Obj *withMethodprefix, int withObjscope, Tcl_Obj *withOnerror, int withVerbose, Tcl_Obj *target, int nobjc, Tcl_Obj *CONST nobjv[]); static int XOTclOInstVarMethod(Tcl_Interp *interp, XOTclObject *obj, int objc, Tcl_Obj *CONST objv[]); static int XOTclOMixinGuardMethod(Tcl_Interp *interp, XOTclObject *obj, char *mixin, Tcl_Obj *guard); static int XOTclONextMethod(Tcl_Interp *interp, XOTclObject *obj, int objc, Tcl_Obj *CONST objv[]); @@ -255,6 +252,7 @@ static int XOTclDotCmd(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); static int XOTclExistsCmd(Tcl_Interp *interp, XOTclObject *object, char *var); static int XOTclFinalizeObjCmd(Tcl_Interp *interp); +static int XOTclForwardCmd(Tcl_Interp *interp, XOTclObject *object, int withPer_object, Tcl_Obj *method, Tcl_Obj *withDefault, int withEarlybinding, Tcl_Obj *withMethodprefix, int withObjscope, Tcl_Obj *withOnerror, int withVerbose, Tcl_Obj *target, int nobjc, Tcl_Obj *CONST nobjv[]); static int XOTclGetSelfObjCmd(Tcl_Interp *interp, int selfoption); static int XOTclImportvarCmd(Tcl_Interp *interp, XOTclObject *object, int nobjc, Tcl_Obj *CONST nobjv[]); static int XOTclInterpObjCmd(Tcl_Interp *interp, char *name, int objc, Tcl_Obj *CONST objv[]); @@ -276,7 +274,6 @@ XOTclCCreateMethodIdx, XOTclCDeallocMethodIdx, XOTclCFilterGuardMethodIdx, - XOTclCForwardMethodIdx, XOTclCInvalidateObjectParameterMethodIdx, XOTclCMixinGuardMethodIdx, XOTclCNewMethodIdx, @@ -318,7 +315,6 @@ XOTclOExistsMethodIdx, XOTclOFilterGuardMethodIdx, XOTclOFilterSearchMethodIdx, - XOTclOForwardMethodIdx, XOTclOInstVarMethodIdx, XOTclOMixinGuardMethodIdx, XOTclONextMethodIdx, @@ -338,6 +334,7 @@ XOTclDotCmdIdx, XOTclExistsCmdIdx, XOTclFinalizeObjCmdIdx, + XOTclForwardCmdIdx, XOTclGetSelfObjCmdIdx, XOTclImportvarCmdIdx, XOTclInterpObjCmdIdx, @@ -470,32 +467,6 @@ } static int -XOTclCForwardMethodStub(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[XOTclCForwardMethodIdx].paramDefs, - method_definitions[XOTclCForwardMethodIdx].nrParameters, - &pc) != TCL_OK) { - return TCL_ERROR; - } else { - Tcl_Obj *name = (Tcl_Obj *)pc.clientData[0]; - Tcl_Obj *withDefault = (Tcl_Obj *)pc.clientData[1]; - int withEarlybinding = (int )PTR2INT(pc.clientData[2]); - Tcl_Obj *withMethodprefix = (Tcl_Obj *)pc.clientData[3]; - int withObjscope = (int )PTR2INT(pc.clientData[4]); - Tcl_Obj *withOnerror = (Tcl_Obj *)pc.clientData[5]; - int withVerbose = (int )PTR2INT(pc.clientData[6]); - Tcl_Obj *target = (Tcl_Obj *)pc.clientData[7]; - - parseContextRelease(&pc); - return XOTclCForwardMethod(interp, cl, name, withDefault, withEarlybinding, withMethodprefix, withObjscope, withOnerror, withVerbose, target, objc-pc.lastobjc, objv+pc.lastobjc); - - } -} - -static int XOTclCInvalidateObjectParameterMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; XOTclClass *cl = XOTclObjectToClass(clientData); @@ -1379,32 +1350,6 @@ } static int -XOTclOForwardMethodStub(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[XOTclOForwardMethodIdx].paramDefs, - method_definitions[XOTclOForwardMethodIdx].nrParameters, - &pc) != TCL_OK) { - return TCL_ERROR; - } else { - Tcl_Obj *method = (Tcl_Obj *)pc.clientData[0]; - Tcl_Obj *withDefault = (Tcl_Obj *)pc.clientData[1]; - int withEarlybinding = (int )PTR2INT(pc.clientData[2]); - Tcl_Obj *withMethodprefix = (Tcl_Obj *)pc.clientData[3]; - int withObjscope = (int )PTR2INT(pc.clientData[4]); - Tcl_Obj *withOnerror = (Tcl_Obj *)pc.clientData[5]; - int withVerbose = (int )PTR2INT(pc.clientData[6]); - Tcl_Obj *target = (Tcl_Obj *)pc.clientData[7]; - - parseContextRelease(&pc); - return XOTclOForwardMethod(interp, obj, method, withDefault, withEarlybinding, withMethodprefix, withObjscope, withOnerror, withVerbose, target, objc-pc.lastobjc, objv+pc.lastobjc); - - } -} - -static int XOTclOInstVarMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { XOTclObject *obj = (XOTclObject *)clientData; if (!obj) return XOTclObjErrType(interp, objv[0], "Object"); @@ -1718,6 +1663,33 @@ } static int +XOTclForwardCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { + parseContext pc; + + if (ArgumentParse(interp, objc, objv, NULL, objv[0], + method_definitions[XOTclForwardCmdIdx].paramDefs, + method_definitions[XOTclForwardCmdIdx].nrParameters, + &pc) != TCL_OK) { + return TCL_ERROR; + } else { + XOTclObject *object = (XOTclObject *)pc.clientData[0]; + int withPer_object = (int )PTR2INT(pc.clientData[1]); + Tcl_Obj *method = (Tcl_Obj *)pc.clientData[2]; + Tcl_Obj *withDefault = (Tcl_Obj *)pc.clientData[3]; + int withEarlybinding = (int )PTR2INT(pc.clientData[4]); + Tcl_Obj *withMethodprefix = (Tcl_Obj *)pc.clientData[5]; + int withObjscope = (int )PTR2INT(pc.clientData[6]); + Tcl_Obj *withOnerror = (Tcl_Obj *)pc.clientData[7]; + int withVerbose = (int )PTR2INT(pc.clientData[8]); + Tcl_Obj *target = (Tcl_Obj *)pc.clientData[9]; + + parseContextRelease(&pc); + return XOTclForwardCmd(interp, object, withPer_object, method, withDefault, withEarlybinding, withMethodprefix, withObjscope, withOnerror, withVerbose, target, objc-pc.lastobjc, objv+pc.lastobjc); + + } +} + +static int XOTclGetSelfObjCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; @@ -1997,17 +1969,6 @@ {"filter", 1, 0, convertToString}, {"guard", 1, 0, convertToTclobj}} }, -{"::xotcl::cmd::Class::forward", XOTclCForwardMethodStub, 9, { - {"name", 1, 0, convertToTclobj}, - {"-default", 0, 1, convertToTclobj}, - {"-earlybinding", 0, 0, convertToString}, - {"-methodprefix", 0, 1, convertToTclobj}, - {"-objscope", 0, 0, convertToString}, - {"-onerror", 0, 1, convertToTclobj}, - {"-verbose", 0, 0, convertToString}, - {"target", 0, 0, convertToTclobj}, - {"args", 0, 0, convertToNothing}} -}, {"::xotcl::cmd::Class::__invalidateobjectparameter", XOTclCInvalidateObjectParameterMethodStub, 0, { } }, @@ -2192,17 +2153,6 @@ {"::xotcl::cmd::Object::filtersearch", XOTclOFilterSearchMethodStub, 1, { {"filter", 1, 0, convertToString}} }, -{"::xotcl::cmd::Object::forward", XOTclOForwardMethodStub, 9, { - {"method", 1, 0, convertToTclobj}, - {"-default", 0, 1, convertToTclobj}, - {"-earlybinding", 0, 0, convertToString}, - {"-methodprefix", 0, 1, convertToTclobj}, - {"-objscope", 0, 0, convertToString}, - {"-onerror", 0, 1, convertToTclobj}, - {"-verbose", 0, 0, convertToString}, - {"target", 0, 0, convertToTclobj}, - {"args", 0, 0, convertToNothing}} -}, {"::xotcl::cmd::Object::instvar", XOTclOInstVarMethodStub, 1, { {"args", 0, 0, convertToNothing}} }, @@ -2276,6 +2226,19 @@ {"::xotcl::finalize", XOTclFinalizeObjCmdStub, 0, { } }, +{"::xotcl::forward", XOTclForwardCmdStub, 11, { + {"object", 1, 0, convertToObject}, + {"-per-object", 0, 0, convertToString}, + {"method", 1, 0, convertToTclobj}, + {"-default", 0, 1, convertToTclobj}, + {"-earlybinding", 0, 0, convertToString}, + {"-methodprefix", 0, 1, convertToTclobj}, + {"-objscope", 0, 0, convertToString}, + {"-onerror", 0, 1, convertToTclobj}, + {"-verbose", 0, 0, convertToString}, + {"target", 0, 0, convertToTclobj}, + {"args", 0, 0, convertToNothing}} +}, {"::xotcl::self", XOTclGetSelfObjCmdStub, 1, { {"selfoption", 0, 0, convertToSelfoption}} }, Index: generic/xotcl.c =================================================================== diff -u -r62a9d39ecd1f540f08c895175a7f085cfb4ae845 -r68e773f0a21300bd799c60fefc76f696fd230ca0 --- generic/xotcl.c (.../xotcl.c) (revision 62a9d39ecd1f540f08c895175a7f085cfb4ae845) +++ generic/xotcl.c (.../xotcl.c) (revision 68e773f0a21300bd799c60fefc76f696fd230ca0) @@ -10407,8 +10407,6 @@ return result; } -/* TODO: MOVE ME */ -/* todo move me xxx */ /* xotclCmd assertion XOTclAssertionCmd { {-argName "object" -type object} @@ -10493,8 +10491,61 @@ } /* +xotclCmd forward XOTclForwardCmd { + {-argName "object" -required 1 -type object} + {-argName "-per-object"} + {-argName "method" -required 1 -type tclobj} + {-argName "-default" -nrargs 1 -type tclobj} + {-argName "-earlybinding"} + {-argName "-methodprefix" -nrargs 1 -type tclobj} + {-argName "-objscope"} + {-argName "-onerror" -nrargs 1 -type tclobj} + {-argName "-verbose"} + {-argName "target" -type tclobj} + {-argName "args" -type args} +} +*/ +static int XOTclForwardCmd(Tcl_Interp *interp, + XOTclObject *object, int withPer_object, + Tcl_Obj *method, + Tcl_Obj *withDefault, int withEarlybinding, Tcl_Obj *withMethodprefix, + int withObjscope, Tcl_Obj *withOnerror, int withVerbose, + Tcl_Obj *target, int nobjc, Tcl_Obj *CONST nobjv[]) { + forwardCmdClientData *tcd; + int result; + + fprintf(stderr, "ForwardCmd \n"); + + result = forwardProcessOptions(interp, method, + withDefault, withEarlybinding, withMethodprefix, + withObjscope, withOnerror, withVerbose, + target, nobjc, nobjv, &tcd); + if (result == TCL_OK) { + CONST char *methodName = NSTail(ObjStr(method)); + XOTclClass *cl = + (withPer_object || ! XOTclObjectIsClass(object)) ? + NULL : (XOTclClass *)object; + + tcd->obj = object; + if (cl == NULL) { + result = XOTclAddObjectMethod(interp, (XOTcl_Object *)object, methodName, + (Tcl_ObjCmdProc*)XOTclForwardMethod, + (ClientData)tcd, forwardCmdDeleteProc, 0); + } else { + result = XOTclAddInstanceMethod(interp, (XOTcl_Class*)cl, methodName, + (Tcl_ObjCmdProc*)XOTclForwardMethod, + (ClientData)tcd, forwardCmdDeleteProc, 0); + } + if (result == TCL_OK) { + result = ListMethodName(interp, object, cl == NULL, methodName); + } + } + return result; +} + +/* xotclCmd method XOTclMethodCmd { - {-argName "class" -required 1 -type class} + {-argName "object" -required 1 -type object} {-argName "-inner-namespace"} {-argName "-per-object"} {-argName "-public"} @@ -10506,11 +10557,13 @@ } */ static int XOTclMethodCmd(Tcl_Interp *interp, XOTclObject *object, - int withInner_namespace, int withPer_object, int withPublic, - Tcl_Obj *name, Tcl_Obj *args, Tcl_Obj *body, - Tcl_Obj *withPrecondition, Tcl_Obj *withPostcondition) { - - XOTclClass *cl = (withPer_object || ! XOTclObjectIsClass(object)) ? NULL : (XOTclClass *)object; + int withInner_namespace, int withPer_object, int withPublic, + Tcl_Obj *name, Tcl_Obj *args, Tcl_Obj *body, + Tcl_Obj *withPrecondition, Tcl_Obj *withPostcondition) { + XOTclClass *cl = + (withPer_object || ! XOTclObjectIsClass(object)) ? + NULL : (XOTclClass *)object; + if (cl == 0) { requireObjNamespace(interp, object); } @@ -12166,28 +12219,6 @@ return result; } -static int XOTclOForwardMethod(Tcl_Interp *interp, XOTclObject *object, Tcl_Obj *method, - Tcl_Obj *withDefault, int withEarlybinding, Tcl_Obj *withMethodprefix, - int withObjscope, Tcl_Obj *withOnerror, int withVerbose, Tcl_Obj *target, - int nobjc, Tcl_Obj *CONST nobjv[]) { - forwardCmdClientData *tcd; - int result = forwardProcessOptions(interp, method, - withDefault, withEarlybinding, withMethodprefix, - withObjscope, withOnerror, withVerbose, - target, nobjc, nobjv, &tcd); - if (result == TCL_OK) { - CONST char *methodName = NSTail(ObjStr(method)); - tcd->obj = object; - result = XOTclAddObjectMethod(interp, (XOTcl_Object *)object, methodName, - (Tcl_ObjCmdProc*)XOTclForwardMethod, - (ClientData)tcd, forwardCmdDeleteProc, 0); - if (result == TCL_OK) { - result = ListMethodName(interp, object, 1, methodName); - } - } - return result; -} - static int XOTclOUplevelMethod(Tcl_Interp *interp, XOTclObject *obj, int objc, Tcl_Obj *CONST objv[]) { int i, result = TCL_ERROR; char *frameInfo = NULL; @@ -12580,29 +12611,6 @@ mixin, " on ", className(cl), (char *) NULL); } -static int XOTclCForwardMethod(Tcl_Interp *interp, XOTclClass *cl, - Tcl_Obj *method, - Tcl_Obj *withDefault, int withEarlybinding, Tcl_Obj *withMethodprefix, - int withObjscope, Tcl_Obj *withOnerror, int withVerbose, - Tcl_Obj *target, int nobjc, Tcl_Obj *CONST nobjv[]) { - forwardCmdClientData *tcd; - int result = forwardProcessOptions(interp, method, - withDefault, withEarlybinding, withMethodprefix, - withObjscope, withOnerror, withVerbose, - target, nobjc, nobjv, &tcd); - if (result == TCL_OK) { - CONST char *methodName = NSTail(ObjStr(method)); - tcd->obj = &cl->object; - result = XOTclAddInstanceMethod(interp, (XOTcl_Class*)cl, methodName, - (Tcl_ObjCmdProc*)XOTclForwardMethod, - (ClientData)tcd, forwardCmdDeleteProc, 0); - if (result == TCL_OK) { - result = ListMethodName(interp, &cl->object, 0, methodName); - } - } - return result; -} - static int XOTclCInvalidateObjectParameterMethod(Tcl_Interp *interp, XOTclClass *cl) { if (cl->parsedParamPtr) { /*fprintf(stderr, " %s invalidate %p\n", className(cl), cl->parsedParamPtr);*/ Index: library/lib/xotcl1.xotcl =================================================================== diff -u -r62a9d39ecd1f540f08c895175a7f085cfb4ae845 -r68e773f0a21300bd799c60fefc76f696fd230ca0 --- library/lib/xotcl1.xotcl (.../xotcl1.xotcl) (revision 62a9d39ecd1f540f08c895175a7f085cfb4ae845) +++ library/lib/xotcl1.xotcl (.../xotcl1.xotcl) (revision 68e773f0a21300bd799c60fefc76f696fd230ca0) @@ -67,6 +67,10 @@ } } + # define forward methods + ::xotcl::forward Object forward ::xotcl::forward %self -per-object + ::xotcl::forward Class instforward ::xotcl::forward %self + Class instproc unknown {args} { #puts stderr "use '[self] create $args', not '[self] $args'" eval my create $args @@ -152,8 +156,8 @@ Object create ::xotcl::classInfo # note, we are using ::xotcl::infoError defined earlier - Object forward info -onerror ::xotcl::infoError ::xotcl::objectInfo %1 {%@2 %self} - Class forward info -onerror ::xotcl::infoError ::xotcl::classInfo %1 {%@2 %self} + Object instforward info -onerror ::xotcl::infoError ::xotcl::objectInfo %1 {%@2 %self} + Class instforward info -onerror ::xotcl::infoError ::xotcl::classInfo %1 {%@2 %self} objectInfo proc info {obj} { set methods [list] @@ -382,7 +386,7 @@ Object instproc istype {class} {::xotcl::is [self] type $class} ::xotcl::alias Object contains ::xotcl::classes::xotcl2::Object::contains - ::xotcl::Class forward slots %self contains \ + ::xotcl::Class instforward slots %self contains \ -object {%::xotcl::dispatch [::xotcl::self] -objscope ::subst [::xotcl::self]::slot} # # define parametercmd and instparametercmd in terms of ::xotcl2 method setter @@ -429,16 +433,9 @@ Object instproc check {checkoptions} { ::xotcl::assertion [self] check [::xotcl::checkoption_xotcl1_to_internal $checkoptions] } - Object forward invar ::xotcl::assertion %self object-invar - Class forward instinvar ::xotcl::assertion %self class-invar + Object instforward invar ::xotcl::assertion %self object-invar + Class instforward instinvar ::xotcl::assertion %self class-invar - # define forward and instforward in terms of forward - # we are changing the the semantics from forward -> instforward, - # this has to be done at the end to avoid confusion with the - # previous forward invocation in this script. - ::xotcl::alias Class instforward ::xotcl::cmd::Class::forward - ::xotcl::alias Class forward ::xotcl::cmd::Object::forward - Object instproc abstract {methtype methname arglist} { if {$methtype ne "proc" && $methtype ne "instproc" && $methtype ne "method"} { error "invalid method type '$methtype', \