Index: generic/gentclAPI.decls =================================================================== diff -u -r7d9452f6a7cc8b99fd09058dfbb8992e0cba5b9e -r62a9d39ecd1f540f08c895175a7f085cfb4ae845 --- generic/gentclAPI.decls (.../gentclAPI.decls) (revision 7d9452f6a7cc8b99fd09058dfbb8992e0cba5b9e) +++ generic/gentclAPI.decls (.../gentclAPI.decls) (revision 62a9d39ecd1f540f08c895175a7f085cfb4ae845) @@ -70,6 +70,17 @@ {-argName "objectkind" -type "type|object|class|metaclass|mixin"} {-argName "value" -required 0 -type tclobj} } +xotclCmd method XOTclMethodCmd { + {-argName "object" -required 1 -type object} + {-argName "-inner-namespace"} + {-argName "-per-object"} + {-argName "-public"} + {-argName "name" -required 1 -type tclobj} + {-argName "args" -required 1 -type tclobj} + {-argName "body" -required 1 -type tclobj} + {-argName "-precondition" -nrargs 1 -type tclobj} + {-argName "-postcondition" -nrargs 1 -type tclobj} +} xotclCmd methodproperty XOTclMethodPropertyCmd { {-argName "object" -required 1 -type object} {-argName "methodName" -required 1 -type tclobj} @@ -150,15 +161,6 @@ objectMethod instvar XOTclOInstVarMethod { {-argName "args" -type allargs} } -objectMethod object-method XOTclOMethodMethod { - {-argName "-inner-namespace"} - {-argName "-public"} - {-argName "name" -required 1 -type tclobj} - {-argName "args" -required 1 -type tclobj} - {-argName "body" -required 1 -type tclobj} - {-argName "-precondition" -nrargs 1 -type tclobj} - {-argName "-postcondition" -nrargs 1 -type tclobj} -} objectMethod mixinguard XOTclOMixinGuardMethod { {-argName "mixin" -required 1} {-argName "guard" -required 1 -type tclobj} @@ -210,15 +212,6 @@ {-argName "mixin" -required 1} {-argName "guard" -required 1 -type tclobj} } -classMethod class-method XOTclCMethodMethod { - {-argName "-inner-namespace" -type switch} - {-argName "-public"} - {-argName "name" -required 1 -type tclobj} - {-argName "args" -required 1 -type tclobj} - {-argName "body" -required 1 -type tclobj} - {-argName "-precondition" -nrargs 1 -type tclobj} - {-argName "-postcondition" -nrargs 1 -type tclobj} -} classMethod forward XOTclCForwardMethod { {-argName "name" -required 1 -type tclobj} {-argName "-default" -nrargs 1 -type tclobj} Index: generic/predefined.h =================================================================== diff -u -r7d9452f6a7cc8b99fd09058dfbb8992e0cba5b9e -r62a9d39ecd1f540f08c895175a7f085cfb4ae845 --- generic/predefined.h (.../predefined.h) (revision 7d9452f6a7cc8b99fd09058dfbb8992e0cba5b9e) +++ generic/predefined.h (.../predefined.h) (revision 62a9d39ecd1f540f08c895175a7f085cfb4ae845) @@ -6,12 +6,11 @@ "::xotcl::createobjectsystem ::xotcl2::Object ::xotcl2::Class\n" "foreach cmd [info command ::xotcl::cmd::Object::*] {\n" "set cmdName [namespace tail $cmd]\n" -"if {$cmdName in [list \"instvar\" \"object-method\"]} continue\n" +"if {$cmdName in [list \"instvar\"]} continue\n" "::xotcl::alias Object $cmdName $cmd}\n" "::xotcl::alias Object eval -objscope ::eval\n" "foreach cmd [info command ::xotcl::cmd::Class::*] {\n" "set cmdName [namespace tail $cmd]\n" -"if {$cmdName in [list \"class-method\"]} continue\n" "::xotcl::alias Class $cmdName $cmd}\n" "foreach cmd [list __next cleanup noinit residualargs uplevel upvar] {\n" "::xotcl::methodproperty Object $cmd protected 1}\n" @@ -21,20 +20,18 @@ "::xotcl::methodproperty Class alloc redefine-protected true\n" "::xotcl::methodproperty Class dealloc redefine-protected true\n" "::xotcl::methodproperty Class create redefine-protected true\n" -"::xotcl::dispatch Class ::xotcl::cmd::Class::class-method method {\n" +"::xotcl::method Class method {\n" "name arguments body -precondition -postcondition} {\n" "set conditions [list]\n" "if {[info exists precondition]} {lappend conditions -precondition $precondition}\n" "if {[info exists postcondition]} {lappend conditions -postcondition $postcondition}\n" -"::xotcl::dispatch [self] ::xotcl::cmd::Class::class-method \\\n" -"$name $arguments $body {*}$conditions}\n" -"::xotcl::dispatch Object ::xotcl::cmd::Class::class-method method {\n" +"::xotcl::method [self] $name $arguments $body {*}$conditions}\n" +"::xotcl::method Object method {\n" "name arguments body -precondition -postcondition} {\n" "set conditions [list]\n" "if {[info exists precondition]} {lappend conditions -precondition $precondition}\n" "if {[info exists postcondition]} {lappend conditions -postcondition $postcondition}\n" -"::xotcl::dispatch [self] ::xotcl::cmd::Object::object-method \\\n" -"$name $arguments $body {*}$conditions}\n" +"::xotcl::method [self] -per-object $name $arguments $body {*}$conditions}\n" "::xotcl::dispatch Class -objscope ::eval {\n" ".method object {what args} {\n" "if {$what in [list \"alias\" \"forward\" \"method\" \"setter\"]} {\n" Index: generic/predefined.xotcl =================================================================== diff -u -r7d9452f6a7cc8b99fd09058dfbb8992e0cba5b9e -r62a9d39ecd1f540f08c895175a7f085cfb4ae845 --- generic/predefined.xotcl (.../predefined.xotcl) (revision 7d9452f6a7cc8b99fd09058dfbb8992e0cba5b9e) +++ generic/predefined.xotcl (.../predefined.xotcl) (revision 62a9d39ecd1f540f08c895175a7f085cfb4ae845) @@ -17,7 +17,7 @@ # provide the standard command set for ::xotcl2::Object foreach cmd [info command ::xotcl::cmd::Object::*] { set cmdName [namespace tail $cmd] - if {$cmdName in [list "instvar" "object-method"]} continue + if {$cmdName in [list "instvar"]} continue ::xotcl::alias Object $cmdName $cmd } @@ -30,7 +30,6 @@ # provide the standard command set for Class foreach cmd [info command ::xotcl::cmd::Class::*] { set cmdName [namespace tail $cmd] - if {$cmdName in [list "class-method"]} continue ::xotcl::alias Class $cmdName $cmd } @@ -50,24 +49,22 @@ ::xotcl::methodproperty Class create redefine-protected true # define method "method" for Class and Object - ::xotcl::dispatch Class ::xotcl::cmd::Class::class-method method { + ::xotcl::method Class method { name arguments body -precondition -postcondition } { set conditions [list] if {[info exists precondition]} {lappend conditions -precondition $precondition} if {[info exists postcondition]} {lappend conditions -postcondition $postcondition} - ::xotcl::dispatch [self] ::xotcl::cmd::Class::class-method \ - $name $arguments $body {*}$conditions + ::xotcl::method [self] $name $arguments $body {*}$conditions } - ::xotcl::dispatch Object ::xotcl::cmd::Class::class-method method { + ::xotcl::method Object method { name arguments body -precondition -postcondition } { set conditions [list] if {[info exists precondition]} {lappend conditions -precondition $precondition} if {[info exists postcondition]} {lappend conditions -postcondition $postcondition} - ::xotcl::dispatch [self] ::xotcl::cmd::Object::object-method \ - $name $arguments $body {*}$conditions + ::xotcl::method [self] -per-object $name $arguments $body {*}$conditions } # define method modifiers "object", "public" and "protected" Index: generic/tclAPI.h =================================================================== diff -u -r7d9452f6a7cc8b99fd09058dfbb8992e0cba5b9e -r62a9d39ecd1f540f08c895175a7f085cfb4ae845 --- generic/tclAPI.h (.../tclAPI.h) (revision 7d9452f6a7cc8b99fd09058dfbb8992e0cba5b9e) +++ generic/tclAPI.h (.../tclAPI.h) (revision 62a9d39ecd1f540f08c895175a7f085cfb4ae845) @@ -113,7 +113,6 @@ 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 XOTclCMethodMethodStub(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 []); static int XOTclCRecreateMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); @@ -156,7 +155,6 @@ 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 XOTclOMethodMethodStub(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 []); static int XOTclONoinitMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); @@ -179,6 +177,7 @@ 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 []); static int XOTclIsCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); +static int XOTclMethodCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclMethodPropertyCmdStub(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 XOTclNSCopyCmdsStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); @@ -196,7 +195,6 @@ 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 XOTclCMethodMethod(Tcl_Interp *interp, XOTclClass *cl, int withInner_namespace, int withPublic, Tcl_Obj *name, Tcl_Obj *args, Tcl_Obj *body, Tcl_Obj *withPrecondition, Tcl_Obj *withPostcondition); 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[]); static int XOTclCRecreateMethod(Tcl_Interp *interp, XOTclClass *cl, Tcl_Obj *name, int objc, Tcl_Obj *CONST objv[]); @@ -239,7 +237,6 @@ 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 XOTclOMethodMethod(Tcl_Interp *interp, XOTclObject *obj, int withInner_namespace, int withPublic, Tcl_Obj *name, Tcl_Obj *args, Tcl_Obj *body, Tcl_Obj *withPrecondition, Tcl_Obj *withPostcondition); 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[]); static int XOTclONoinitMethod(Tcl_Interp *interp, XOTclObject *obj); @@ -262,6 +259,7 @@ 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[]); static int XOTclIsCmd(Tcl_Interp *interp, Tcl_Obj *object, int objectkind, Tcl_Obj *value); +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); static int XOTclMethodPropertyCmd(Tcl_Interp *interp, XOTclObject *object, Tcl_Obj *methodName, int withPer_object, int methodproperty, Tcl_Obj *value); static int XOTclMyCmd(Tcl_Interp *interp, int withLocal, Tcl_Obj *method, int nobjc, Tcl_Obj *CONST nobjv[]); static int XOTclNSCopyCmds(Tcl_Interp *interp, Tcl_Obj *fromNs, Tcl_Obj *toNs); @@ -280,7 +278,6 @@ XOTclCFilterGuardMethodIdx, XOTclCForwardMethodIdx, XOTclCInvalidateObjectParameterMethodIdx, - XOTclCMethodMethodIdx, XOTclCMixinGuardMethodIdx, XOTclCNewMethodIdx, XOTclCRecreateMethodIdx, @@ -323,7 +320,6 @@ XOTclOFilterSearchMethodIdx, XOTclOForwardMethodIdx, XOTclOInstVarMethodIdx, - XOTclOMethodMethodIdx, XOTclOMixinGuardMethodIdx, XOTclONextMethodIdx, XOTclONoinitMethodIdx, @@ -346,6 +342,7 @@ XOTclImportvarCmdIdx, XOTclInterpObjCmdIdx, XOTclIsCmdIdx, + XOTclMethodCmdIdx, XOTclMethodPropertyCmdIdx, XOTclMyCmdIdx, XOTclNSCopyCmdsIdx, @@ -518,31 +515,6 @@ } static int -XOTclCMethodMethodStub(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[XOTclCMethodMethodIdx].paramDefs, - method_definitions[XOTclCMethodMethodIdx].nrParameters, - &pc) != TCL_OK) { - return TCL_ERROR; - } else { - int withInner_namespace = (int )PTR2INT(pc.clientData[0]); - int withPublic = (int )PTR2INT(pc.clientData[1]); - Tcl_Obj *name = (Tcl_Obj *)pc.clientData[2]; - Tcl_Obj *args = (Tcl_Obj *)pc.clientData[3]; - Tcl_Obj *body = (Tcl_Obj *)pc.clientData[4]; - Tcl_Obj *withPrecondition = (Tcl_Obj *)pc.clientData[5]; - Tcl_Obj *withPostcondition = (Tcl_Obj *)pc.clientData[6]; - - parseContextRelease(&pc); - return XOTclCMethodMethod(interp, cl, withInner_namespace, withPublic, name, args, body, withPrecondition, withPostcondition); - - } -} - -static int XOTclCMixinGuardMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; XOTclClass *cl = XOTclObjectToClass(clientData); @@ -1443,31 +1415,6 @@ } static int -XOTclOMethodMethodStub(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[XOTclOMethodMethodIdx].paramDefs, - method_definitions[XOTclOMethodMethodIdx].nrParameters, - &pc) != TCL_OK) { - return TCL_ERROR; - } else { - int withInner_namespace = (int )PTR2INT(pc.clientData[0]); - int withPublic = (int )PTR2INT(pc.clientData[1]); - Tcl_Obj *name = (Tcl_Obj *)pc.clientData[2]; - Tcl_Obj *args = (Tcl_Obj *)pc.clientData[3]; - Tcl_Obj *body = (Tcl_Obj *)pc.clientData[4]; - Tcl_Obj *withPrecondition = (Tcl_Obj *)pc.clientData[5]; - Tcl_Obj *withPostcondition = (Tcl_Obj *)pc.clientData[6]; - - parseContextRelease(&pc); - return XOTclOMethodMethod(interp, obj, withInner_namespace, withPublic, name, args, body, withPrecondition, withPostcondition); - - } -} - -static int XOTclOMixinGuardMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; XOTclObject *obj = (XOTclObject *)clientData; @@ -1845,6 +1792,32 @@ } static int +XOTclMethodCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { + parseContext pc; + + if (ArgumentParse(interp, objc, objv, NULL, objv[0], + method_definitions[XOTclMethodCmdIdx].paramDefs, + method_definitions[XOTclMethodCmdIdx].nrParameters, + &pc) != TCL_OK) { + return TCL_ERROR; + } else { + XOTclObject *object = (XOTclObject *)pc.clientData[0]; + int withInner_namespace = (int )PTR2INT(pc.clientData[1]); + int withPer_object = (int )PTR2INT(pc.clientData[2]); + int withPublic = (int )PTR2INT(pc.clientData[3]); + Tcl_Obj *name = (Tcl_Obj *)pc.clientData[4]; + Tcl_Obj *args = (Tcl_Obj *)pc.clientData[5]; + Tcl_Obj *body = (Tcl_Obj *)pc.clientData[6]; + Tcl_Obj *withPrecondition = (Tcl_Obj *)pc.clientData[7]; + Tcl_Obj *withPostcondition = (Tcl_Obj *)pc.clientData[8]; + + parseContextRelease(&pc); + return XOTclMethodCmd(interp, object, withInner_namespace, withPer_object, withPublic, name, args, body, withPrecondition, withPostcondition); + + } +} + +static int XOTclMethodPropertyCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; @@ -2038,15 +2011,6 @@ {"::xotcl::cmd::Class::__invalidateobjectparameter", XOTclCInvalidateObjectParameterMethodStub, 0, { } }, -{"::xotcl::cmd::Class::class-method", XOTclCMethodMethodStub, 7, { - {"-inner-namespace", 0, 0, convertToBoolean}, - {"-public", 0, 0, convertToString}, - {"name", 1, 0, convertToTclobj}, - {"args", 1, 0, convertToTclobj}, - {"body", 1, 0, convertToTclobj}, - {"-precondition", 0, 1, convertToTclobj}, - {"-postcondition", 0, 1, convertToTclobj}} -}, {"::xotcl::cmd::Class::mixinguard", XOTclCMixinGuardMethodStub, 2, { {"mixin", 1, 0, convertToString}, {"guard", 1, 0, convertToTclobj}} @@ -2242,15 +2206,6 @@ {"::xotcl::cmd::Object::instvar", XOTclOInstVarMethodStub, 1, { {"args", 0, 0, convertToNothing}} }, -{"::xotcl::cmd::Object::object-method", XOTclOMethodMethodStub, 7, { - {"-inner-namespace", 0, 0, convertToString}, - {"-public", 0, 0, convertToString}, - {"name", 1, 0, convertToTclobj}, - {"args", 1, 0, convertToTclobj}, - {"body", 1, 0, convertToTclobj}, - {"-precondition", 0, 1, convertToTclobj}, - {"-postcondition", 0, 1, convertToTclobj}} -}, {"::xotcl::cmd::Object::mixinguard", XOTclOMixinGuardMethodStub, 2, { {"mixin", 1, 0, convertToString}, {"guard", 1, 0, convertToTclobj}} @@ -2337,6 +2292,17 @@ {"objectkind", 0, 0, convertToObjectkind}, {"value", 0, 0, convertToTclobj}} }, +{"::xotcl::method", XOTclMethodCmdStub, 9, { + {"object", 1, 0, convertToObject}, + {"-inner-namespace", 0, 0, convertToString}, + {"-per-object", 0, 0, convertToString}, + {"-public", 0, 0, convertToString}, + {"name", 1, 0, convertToTclobj}, + {"args", 1, 0, convertToTclobj}, + {"body", 1, 0, convertToTclobj}, + {"-precondition", 0, 1, convertToTclobj}, + {"-postcondition", 0, 1, convertToTclobj}} +}, {"::xotcl::methodproperty", XOTclMethodPropertyCmdStub, 5, { {"object", 1, 0, convertToObject}, {"methodName", 1, 0, convertToTclobj}, Index: generic/xotcl.c =================================================================== diff -u -r7d9452f6a7cc8b99fd09058dfbb8992e0cba5b9e -r62a9d39ecd1f540f08c895175a7f085cfb4ae845 --- generic/xotcl.c (.../xotcl.c) (revision 7d9452f6a7cc8b99fd09058dfbb8992e0cba5b9e) +++ generic/xotcl.c (.../xotcl.c) (revision 62a9d39ecd1f540f08c895175a7f085cfb4ae845) @@ -10459,7 +10459,6 @@ return TCL_OK; } - static int XOTclConfigureCmd(Tcl_Interp *interp, int configureoption, Tcl_Obj *value) { int bool; @@ -10493,6 +10492,32 @@ return TCL_OK; } +/* +xotclCmd method XOTclMethodCmd { + {-argName "class" -required 1 -type class} + {-argName "-inner-namespace"} + {-argName "-per-object"} + {-argName "-public"} + {-argName "name" -required 1 -type tclobj} + {-argName "args" -required 1 -type tclobj} + {-argName "body" -required 1 -type tclobj} + {-argName "-precondition" -nrargs 1 -type tclobj} + {-argName "-postcondition" -nrargs 1 -type tclobj} +} +*/ +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; + if (cl == 0) { + requireObjNamespace(interp, object); + } + return MakeMethod(interp, object, cl, name, args, body, + withPrecondition, withPostcondition, + withPublic, withInner_namespace); +} int XOTclCreateObjectSystemCmd(Tcl_Interp *interp, Tcl_Obj *Object, Tcl_Obj *Class) { @@ -12555,28 +12580,6 @@ mixin, " on ", className(cl), (char *) NULL); } -/* TODO move me at the right place */ -static int XOTclOMethodMethod(Tcl_Interp *interp, XOTclObject *obj, - int withInner_namespace, int withPublic, - Tcl_Obj *name, Tcl_Obj *args, Tcl_Obj *body, - Tcl_Obj *withPrecondition, Tcl_Obj *withPostcondition) { - requireObjNamespace(interp, obj); - return MakeMethod(interp, obj, NULL, name, args, body, - withPrecondition, withPostcondition, - withPublic, withInner_namespace); -} - -/* TODO move me at the right place */ -static int XOTclCMethodMethod(Tcl_Interp *interp, XOTclClass *cl, - int withInner_namespace, int withPublic, - Tcl_Obj *name, Tcl_Obj *args, Tcl_Obj *body, - Tcl_Obj *withPrecondition, Tcl_Obj *withPostcondition) { - - return MakeMethod(interp, &cl->object, cl, name, args, body, - withPrecondition, withPostcondition, - withPublic, withInner_namespace); -} - static int XOTclCForwardMethod(Tcl_Interp *interp, XOTclClass *cl, Tcl_Obj *method, Tcl_Obj *withDefault, int withEarlybinding, Tcl_Obj *withMethodprefix, Index: library/lib/xotcl1.xotcl =================================================================== diff -u -r7050a52ac53992d9a3aec12e48b0fa58a26449e6 -r62a9d39ecd1f540f08c895175a7f085cfb4ae845 --- library/lib/xotcl1.xotcl (.../xotcl1.xotcl) (revision 7050a52ac53992d9a3aec12e48b0fa58a26449e6) +++ library/lib/xotcl1.xotcl (.../xotcl1.xotcl) (revision 62a9d39ecd1f540f08c895175a7f085cfb4ae845) @@ -14,7 +14,7 @@ # provide the standard command set for ::xotcl::Object foreach cmd [info command ::xotcl::cmd::Object::*] { set cmdName [namespace tail $cmd] - if {$cmdName in [list "setter" "object-method"]} continue + if {$cmdName in [list "setter"]} continue ::xotcl::alias Object $cmdName $cmd } @@ -26,7 +26,7 @@ # provide the standard command set for ::xotcl::Class foreach cmd [info command ::xotcl::cmd::Class::*] { set cmdName [namespace tail $cmd] - if {$cmdName in [list "setter" "class-method"]} continue + if {$cmdName in [list "setter"]} continue ::xotcl::alias Class $cmdName $cmd } @@ -37,24 +37,22 @@ ::xotcl::methodproperty Class create redefine-protected true # define instproc and proc - ::xotcl::dispatch Class ::xotcl::cmd::Class::class-method instproc { + ::xotcl::method Class instproc { name arguments body precondition:optional postcondition:optional } { set conditions [list] if {[info exists precondition]} {lappend conditions -precondition $precondition} if {[info exists postcondition]} {lappend conditions -postcondition $postcondition} - ::xotcl::dispatch [self] ::xotcl::cmd::Class::class-method $name $arguments $body {*}$conditions - #puts stderr "[self] [self proc] $name defined" + ::xotcl::method [self] $name $arguments $body {*}$conditions } - ::xotcl::dispatch Object ::xotcl::cmd::Class::class-method proc { + ::xotcl::method Object proc { name arguments body precondition:optional postcondition:optional } { set conditions [list] if {[info exists precondition]} {lappend conditions -precondition $precondition} if {[info exists postcondition]} {lappend conditions -postcondition $postcondition} - ::xotcl::dispatch [self] ::xotcl::cmd::Object::object-method $name $arguments $body {*}$conditions - #puts stderr "[self] [self proc] $name defined" + ::xotcl::method [self] -per-object $name $arguments $body {*}$conditions } # define - like in XOTcl 1 - a minimal implementation of "method"