diff options
Diffstat (limited to 'generic/tclOOMethod.c')
| -rw-r--r-- | generic/tclOOMethod.c | 140 |
1 files changed, 133 insertions, 7 deletions
diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c index ae1f3bd..73368e4 100644 --- a/generic/tclOOMethod.c +++ b/generic/tclOOMethod.c @@ -126,7 +126,7 @@ static const Tcl_MethodType fwdMethodType = { */ Tcl_Method -Tcl_NewInstanceMethod( +TclNewInstanceMethod( TCL_UNUSED(Tcl_Interp *), Tcl_Object object, /* The object that has the method attached to * it. */ @@ -187,6 +187,50 @@ Tcl_NewInstanceMethod( oPtr->epoch++; return (Tcl_Method) mPtr; } +Tcl_Method +Tcl_NewInstanceMethod( + TCL_UNUSED(Tcl_Interp *), + Tcl_Object object, /* The object that has the method attached to + * it. */ + Tcl_Obj *nameObj, /* The name of the method. May be NULL; if so, + * up to caller to manage storage (e.g., when + * it is a constructor or destructor). */ + int flags, /* Whether this is a public method. */ + const Tcl_MethodType *typePtr, + /* The type of method this is, which defines + * how to invoke, delete and clone the + * method. */ + void *clientData) /* Some data associated with the particular + * method to be created. */ +{ + if (typePtr->version > TCL_OO_METHOD_VERSION_1) { + Tcl_Panic("%s: Wrong version in typePtr->version, should be TCL_OO_METHOD_VERSION_1", "Tcl_NewInstanceMethod"); + } + return TclNewInstanceMethod(NULL, object, nameObj, flags, + (const Tcl_MethodType *)typePtr, clientData); +} +Tcl_Method +Tcl_NewInstanceMethod2( + TCL_UNUSED(Tcl_Interp *), + Tcl_Object object, /* The object that has the method attached to + * it. */ + Tcl_Obj *nameObj, /* The name of the method. May be NULL; if so, + * up to caller to manage storage (e.g., when + * it is a constructor or destructor). */ + int flags, /* Whether this is a public method. */ + const Tcl_MethodType2 *typePtr, + /* The type of method this is, which defines + * how to invoke, delete and clone the + * method. */ + void *clientData) /* Some data associated with the particular + * method to be created. */ +{ + if (typePtr->version < TCL_OO_METHOD_VERSION_2) { + Tcl_Panic("%s: Wrong version in typePtr->version, should be TCL_OO_METHOD_VERSION_2", "Tcl_NewInstanceMethod2"); + } + return TclNewInstanceMethod(NULL, object, nameObj, flags, + (const Tcl_MethodType *)typePtr, clientData); +} /* * ---------------------------------------------------------------------- @@ -199,7 +243,7 @@ Tcl_NewInstanceMethod( */ Tcl_Method -Tcl_NewMethod( +TclNewMethod( TCL_UNUSED(Tcl_Interp *), Tcl_Class cls, /* The class to attach the method to. */ Tcl_Obj *nameObj, /* The name of the object. May be NULL (e.g., @@ -255,6 +299,48 @@ Tcl_NewMethod( return (Tcl_Method) mPtr; } + +Tcl_Method +Tcl_NewMethod( + TCL_UNUSED(Tcl_Interp *), + Tcl_Class cls, /* The class to attach the method to. */ + Tcl_Obj *nameObj, /* The name of the object. May be NULL (e.g., + * for constructors or destructors); if so, up + * to caller to manage storage. */ + int flags, /* Whether this is a public method. */ + const Tcl_MethodType *typePtr, + /* The type of method this is, which defines + * how to invoke, delete and clone the + * method. */ + void *clientData) /* Some data associated with the particular + * method to be created. */ +{ + if (typePtr->version > TCL_OO_METHOD_VERSION_1) { + Tcl_Panic("%s: Wrong version in typePtr->version, should be TCL_OO_METHOD_VERSION_1", "Tcl_NewMethod"); + } + return TclNewMethod(NULL, cls, nameObj, flags, typePtr, clientData); +} + +Tcl_Method +Tcl_NewMethod2( + TCL_UNUSED(Tcl_Interp *), + Tcl_Class cls, /* The class to attach the method to. */ + Tcl_Obj *nameObj, /* The name of the object. May be NULL (e.g., + * for constructors or destructors); if so, up + * to caller to manage storage. */ + int flags, /* Whether this is a public method. */ + const Tcl_MethodType2 *typePtr, + /* The type of method this is, which defines + * how to invoke, delete and clone the + * method. */ + void *clientData) /* Some data associated with the particular + * method to be created. */ +{ + if (typePtr->version < TCL_OO_METHOD_VERSION_2) { + Tcl_Panic("%s: Wrong version in typePtr->version, should be TCL_OO_METHOD_VERSION_2", "Tcl_NewMethod2"); + } + return TclNewMethod(NULL, cls, nameObj, flags, (const Tcl_MethodType *)typePtr, clientData); +} /* * ---------------------------------------------------------------------- @@ -304,7 +390,7 @@ TclOONewBasicMethod( Tcl_Obj *namePtr = Tcl_NewStringObj(dcm->name, -1); Tcl_IncrRefCount(namePtr); - Tcl_NewMethod(interp, (Tcl_Class) clsPtr, namePtr, + TclNewMethod(interp, (Tcl_Class) clsPtr, namePtr, (dcm->isPublic ? PUBLIC_METHOD : 0), &dcm->definition, NULL); Tcl_DecrRefCount(namePtr); } @@ -529,7 +615,7 @@ TclOOMakeProcInstanceMethod( } } - return Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr, nameObj, flags, + return TclNewInstanceMethod(interp, (Tcl_Object) oPtr, nameObj, flags, typePtr, clientData); } @@ -642,7 +728,7 @@ TclOOMakeProcMethod( } } - return Tcl_NewMethod(interp, (Tcl_Class) clsPtr, nameObj, flags, typePtr, + return TclNewMethod(interp, (Tcl_Class) clsPtr, nameObj, flags, typePtr, clientData); } @@ -1402,7 +1488,7 @@ TclOONewForwardInstanceMethod( fmPtr = (ForwardMethod *)ckalloc(sizeof(ForwardMethod)); fmPtr->prefixObj = prefixObj; Tcl_IncrRefCount(prefixObj); - return (Method *) Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr, + return (Method *) TclNewInstanceMethod(interp, (Tcl_Object) oPtr, nameObj, flags, &fwdMethodType, fmPtr); } @@ -1441,7 +1527,7 @@ TclOONewForwardMethod( fmPtr = (ForwardMethod *)ckalloc(sizeof(ForwardMethod)); fmPtr->prefixObj = prefixObj; Tcl_IncrRefCount(prefixObj); - return (Method *) Tcl_NewMethod(interp, (Tcl_Class) clsPtr, nameObj, + return (Method *) TclNewMethod(interp, (Tcl_Class) clsPtr, nameObj, flags, &fwdMethodType, fmPtr); } @@ -1672,6 +1758,23 @@ Tcl_MethodName( } int +TclMethodIsType( + Tcl_Method method, + const Tcl_MethodType *typePtr, + void **clientDataPtr) +{ + Method *mPtr = (Method *) method; + + if (mPtr->typePtr == typePtr) { + if (clientDataPtr != NULL) { + *clientDataPtr = mPtr->clientData; + } + return 1; + } + return 0; +} + +int Tcl_MethodIsType( Tcl_Method method, const Tcl_MethodType *typePtr, @@ -1679,6 +1782,9 @@ Tcl_MethodIsType( { Method *mPtr = (Method *) method; + if (typePtr->version > TCL_OO_METHOD_VERSION_1) { + Tcl_Panic("%s: Wrong version in typePtr->version, should be TCL_OO_METHOD_VERSION_1", "Tcl_MethodIsType"); + } if (mPtr->typePtr == typePtr) { if (clientDataPtr != NULL) { *clientDataPtr = mPtr->clientData; @@ -1689,6 +1795,26 @@ Tcl_MethodIsType( } int +Tcl_MethodIsType2( + Tcl_Method method, + const Tcl_MethodType2 *typePtr, + void **clientDataPtr) +{ + Method *mPtr = (Method *) method; + + if (typePtr->version < TCL_OO_METHOD_VERSION_2) { + Tcl_Panic("%s: Wrong version in typePtr->version, should be TCL_OO_METHOD_VERSION_2", "Tcl_MethodIsType2"); + } + if (mPtr->typePtr == (const Tcl_MethodType *)typePtr) { + if (clientDataPtr != NULL) { + *clientDataPtr = mPtr->clientData; + } + return 1; + } + return 0; +} + +int Tcl_MethodIsPublic( Tcl_Method method) { |