Attachment "tcloo.patch" to
ticket [2961556fff]
added by
nijtmans
2010-03-02 05:26:43.
Index: generic/tclOOInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclOOInt.h,v
retrieving revision 1.15
diff -c -r1.15 tclOOInt.h
*** generic/tclOOInt.h 29 Jan 2010 16:17:20 -0000 1.15
--- generic/tclOOInt.h 1 Mar 2010 22:10:15 -0000
***************
*** 67,78 ****
* tuned in their behaviour.
*/
! typedef int (*TclOO_PreCallProc)(ClientData clientData, Tcl_Interp *interp,
Tcl_ObjectContext context, Tcl_CallFrame *framePtr, int *isFinished);
! typedef int (*TclOO_PostCallProc)(ClientData clientData, Tcl_Interp *interp,
Tcl_ObjectContext context, Tcl_Namespace *namespacePtr, int result);
! typedef void (*TclOO_PmCDDeleteProc)(ClientData clientData);
! typedef ClientData (*TclOO_PmCDCloneProc)(ClientData clientData);
/*
* Procedure-like methods have the following extra information.
--- 67,78 ----
* tuned in their behaviour.
*/
! typedef int (TclOO_PreCallProc)(ClientData clientData, Tcl_Interp *interp,
Tcl_ObjectContext context, Tcl_CallFrame *framePtr, int *isFinished);
! typedef int (TclOO_PostCallProc)(ClientData clientData, Tcl_Interp *interp,
Tcl_ObjectContext context, Tcl_Namespace *namespacePtr, int result);
! typedef void (TclOO_PmCDDeleteProc)(ClientData clientData);
! typedef ClientData (TclOO_PmCDCloneProc)(ClientData clientData);
/*
* Procedure-like methods have the following extra information.
***************
*** 87,99 ****
int flags; /* Flags to control features. */
int refCount;
ClientData clientData;
! TclOO_PmCDDeleteProc deleteClientdataProc;
! TclOO_PmCDCloneProc cloneClientdataProc;
ProcErrorProc *errProc; /* Replacement error handler. */
! TclOO_PreCallProc preCallProc;
/* Callback to allow for additional setup
* before the method executes. */
! TclOO_PostCallProc postCallProc;
/* Callback to allow for additional cleanup
* after the method executes. */
GetFrameInfoValueProc *gfivProc;
--- 87,99 ----
int flags; /* Flags to control features. */
int refCount;
ClientData clientData;
! TclOO_PmCDDeleteProc *deleteClientdataProc;
! TclOO_PmCDCloneProc *cloneClientdataProc;
ProcErrorProc *errProc; /* Replacement error handler. */
! TclOO_PreCallProc *preCallProc;
/* Callback to allow for additional setup
* before the method executes. */
! TclOO_PostCallProc *postCallProc;
/* Callback to allow for additional cleanup
* after the method executes. */
GetFrameInfoValueProc *gfivProc;
***************
*** 191,197 ****
Tcl_Obj *cachedNameObj; /* Cache of the name of the object. */
Tcl_HashTable *chainCache; /* Place to keep unused contexts. This table
* is indexed by method name as Tcl_Obj. */
! Tcl_ObjectMapMethodNameProc mapMethodNameProc;
/* Function to allow remapping of method
* names. For itcl-ng. */
LIST_STATIC(Tcl_Obj *) variables;
--- 191,197 ----
Tcl_Obj *cachedNameObj; /* Cache of the name of the object. */
Tcl_HashTable *chainCache; /* Place to keep unused contexts. This table
* is indexed by method name as Tcl_Obj. */
! Tcl_ObjectMapMethodNameProc *mapMethodNameProc;
/* Function to allow remapping of method
* names. For itcl-ng. */
LIST_STATIC(Tcl_Obj *) variables;
Index: generic/tclOO.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclOO.h,v
retrieving revision 1.9
diff -c -r1.9 tclOO.h
*** generic/tclOO.h 27 Nov 2009 07:27:52 -0000 1.9
--- generic/tclOO.h 1 Mar 2010 22:10:15 -0000
***************
*** 51,63 ****
* and to allow the attachment of arbitrary data to objects and classes.
*/
! typedef int (*Tcl_MethodCallProc)(ClientData clientData, Tcl_Interp *interp,
Tcl_ObjectContext objectContext, int objc, Tcl_Obj *const *objv);
! typedef void (*Tcl_MethodDeleteProc)(ClientData clientData);
! typedef int (*Tcl_CloneProc)(Tcl_Interp *interp, ClientData oldClientData,
ClientData *newClientData);
! typedef void (*Tcl_ObjectMetadataDeleteProc)(ClientData clientData);
! typedef int (*Tcl_ObjectMapMethodNameProc)(Tcl_Interp *interp,
Tcl_Object object, Tcl_Class *startClsPtr, Tcl_Obj *methodNameObj);
/*
--- 51,63 ----
* and to allow the attachment of arbitrary data to objects and classes.
*/
! typedef int (Tcl_MethodCallProc)(ClientData clientData, Tcl_Interp *interp,
Tcl_ObjectContext objectContext, int objc, Tcl_Obj *const *objv);
! typedef void (Tcl_MethodDeleteProc)(ClientData clientData);
! typedef int (Tcl_CloneProc)(Tcl_Interp *interp, ClientData oldClientData,
ClientData *newClientData);
! typedef void (Tcl_ObjectMetadataDeleteProc)(ClientData clientData);
! typedef int (Tcl_ObjectMapMethodNameProc)(Tcl_Interp *interp,
Tcl_Object object, Tcl_Class *startClsPtr, Tcl_Obj *methodNameObj);
/*
***************
*** 72,83 ****
* declarations. */
const char *name; /* Name of this type of method, mostly for
* debugging purposes. */
! Tcl_MethodCallProc callProc;/* How to invoke this method. */
! Tcl_MethodDeleteProc deleteProc;
/* How to delete this method's type-specific
* data, or NULL if the type-specific data
* does not need deleting. */
! Tcl_CloneProc cloneProc; /* How to copy this method's type-specific
* data, or NULL if the type-specific data can
* be copied directly. */
} Tcl_MethodType;
--- 72,83 ----
* declarations. */
const char *name; /* Name of this type of method, mostly for
* debugging purposes. */
! Tcl_MethodCallProc *callProc;/* How to invoke this method. */
! Tcl_MethodDeleteProc *deleteProc;
/* How to delete this method's type-specific
* data, or NULL if the type-specific data
* does not need deleting. */
! Tcl_CloneProc *cloneProc; /* How to copy this method's type-specific
* data, or NULL if the type-specific data can
* be copied directly. */
} Tcl_MethodType;
***************
*** 101,110 ****
* to TCL_OO_METADATA_VERSION_CURRENT in
* declarations. */
const char *name;
! Tcl_ObjectMetadataDeleteProc deleteProc;
/* How to delete the metadata. This must not
* be NULL. */
! Tcl_CloneProc cloneProc; /* How to copy the metadata, or NULL if the
* type-specific data can be copied
* directly. */
} Tcl_ObjectMetadataType;
--- 101,110 ----
* to TCL_OO_METADATA_VERSION_CURRENT in
* declarations. */
const char *name;
! Tcl_ObjectMetadataDeleteProc *deleteProc;
/* How to delete the metadata. This must not
* be NULL. */
! Tcl_CloneProc *cloneProc; /* How to copy the metadata, or NULL if the
* type-specific data can be copied
* directly. */
} Tcl_ObjectMetadataType;
Index: generic/tclOO.decls
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclOO.decls,v
retrieving revision 1.6
diff -c -r1.6 tclOO.decls
*** generic/tclOO.decls 5 Feb 2010 10:03:23 -0000 1.6
--- generic/tclOO.decls 1 Mar 2010 22:10:15 -0000
***************
*** 97,108 ****
int skip)
}
declare 24 generic {
! Tcl_ObjectMapMethodNameProc Tcl_ObjectGetMethodNameMapper(
Tcl_Object object)
}
declare 25 generic {
void Tcl_ObjectSetMethodNameMapper(Tcl_Object object,
! Tcl_ObjectMapMethodNameProc mapMethodNameProc)
}
declare 26 generic {
void Tcl_ClassSetConstructor(Tcl_Interp *interp, Tcl_Class clazz,
--- 97,108 ----
int skip)
}
declare 24 generic {
! Tcl_ObjectMapMethodNameProc *Tcl_ObjectGetMethodNameMapper(
Tcl_Object object)
}
declare 25 generic {
void Tcl_ObjectSetMethodNameMapper(Tcl_Object object,
! Tcl_ObjectMapMethodNameProc *mapMethodNameProc)
}
declare 26 generic {
void Tcl_ClassSetConstructor(Tcl_Interp *interp, Tcl_Class clazz,
***************
*** 164,177 ****
}
declare 9 generic {
Tcl_Method TclOONewProcInstanceMethodEx(Tcl_Interp *interp,
! Tcl_Object oPtr, TclOO_PreCallProc preCallPtr,
! TclOO_PostCallProc postCallPtr, ProcErrorProc *errProc,
ClientData clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj,
Tcl_Obj *bodyObj, int flags, void **internalTokenPtr)
}
declare 10 generic {
Tcl_Method TclOONewProcMethodEx(Tcl_Interp *interp, Tcl_Class clsPtr,
! TclOO_PreCallProc preCallPtr, TclOO_PostCallProc postCallPtr,
ProcErrorProc *errProc, ClientData clientData, Tcl_Obj *nameObj,
Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags,
void **internalTokenPtr)
--- 164,177 ----
}
declare 9 generic {
Tcl_Method TclOONewProcInstanceMethodEx(Tcl_Interp *interp,
! Tcl_Object oPtr, TclOO_PreCallProc *preCallPtr,
! TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc,
ClientData clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj,
Tcl_Obj *bodyObj, int flags, void **internalTokenPtr)
}
declare 10 generic {
Tcl_Method TclOONewProcMethodEx(Tcl_Interp *interp, Tcl_Class clsPtr,
! TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr,
ProcErrorProc *errProc, ClientData clientData, Tcl_Obj *nameObj,
Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags,
void **internalTokenPtr)
Index: generic/tclOODecls.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclOODecls.h,v
retrieving revision 1.14
diff -c -r1.14 tclOODecls.h
*** generic/tclOODecls.h 5 Feb 2010 10:03:23 -0000 1.14
--- generic/tclOODecls.h 1 Mar 2010 22:10:15 -0000
***************
*** 186,199 ****
#ifndef Tcl_ObjectGetMethodNameMapper_TCL_DECLARED
#define Tcl_ObjectGetMethodNameMapper_TCL_DECLARED
/* 24 */
! EXTERN Tcl_ObjectMapMethodNameProc Tcl_ObjectGetMethodNameMapper(
Tcl_Object object);
#endif
#ifndef Tcl_ObjectSetMethodNameMapper_TCL_DECLARED
#define Tcl_ObjectSetMethodNameMapper_TCL_DECLARED
/* 25 */
EXTERN void Tcl_ObjectSetMethodNameMapper(Tcl_Object object,
! Tcl_ObjectMapMethodNameProc mapMethodNameProc);
#endif
#ifndef Tcl_ClassSetConstructor_TCL_DECLARED
#define Tcl_ClassSetConstructor_TCL_DECLARED
--- 186,199 ----
#ifndef Tcl_ObjectGetMethodNameMapper_TCL_DECLARED
#define Tcl_ObjectGetMethodNameMapper_TCL_DECLARED
/* 24 */
! EXTERN Tcl_ObjectMapMethodNameProc * Tcl_ObjectGetMethodNameMapper(
Tcl_Object object);
#endif
#ifndef Tcl_ObjectSetMethodNameMapper_TCL_DECLARED
#define Tcl_ObjectSetMethodNameMapper_TCL_DECLARED
/* 25 */
EXTERN void Tcl_ObjectSetMethodNameMapper(Tcl_Object object,
! Tcl_ObjectMapMethodNameProc *mapMethodNameProc);
#endif
#ifndef Tcl_ClassSetConstructor_TCL_DECLARED
#define Tcl_ClassSetConstructor_TCL_DECLARED
***************
*** 246,253 ****
ClientData (*tcl_ObjectGetMetadata) (Tcl_Object object, const Tcl_ObjectMetadataType *typePtr); /* 21 */
void (*tcl_ObjectSetMetadata) (Tcl_Object object, const Tcl_ObjectMetadataType *typePtr, ClientData metadata); /* 22 */
int (*tcl_ObjectContextInvokeNext) (Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv, int skip); /* 23 */
! Tcl_ObjectMapMethodNameProc (*tcl_ObjectGetMethodNameMapper) (Tcl_Object object); /* 24 */
! void (*tcl_ObjectSetMethodNameMapper) (Tcl_Object object, Tcl_ObjectMapMethodNameProc mapMethodNameProc); /* 25 */
void (*tcl_ClassSetConstructor) (Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 26 */
void (*tcl_ClassSetDestructor) (Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 27 */
Tcl_Obj * (*tcl_GetObjectName) (Tcl_Interp *interp, Tcl_Object object); /* 28 */
--- 246,253 ----
ClientData (*tcl_ObjectGetMetadata) (Tcl_Object object, const Tcl_ObjectMetadataType *typePtr); /* 21 */
void (*tcl_ObjectSetMetadata) (Tcl_Object object, const Tcl_ObjectMetadataType *typePtr, ClientData metadata); /* 22 */
int (*tcl_ObjectContextInvokeNext) (Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv, int skip); /* 23 */
! Tcl_ObjectMapMethodNameProc * (*tcl_ObjectGetMethodNameMapper) (Tcl_Object object); /* 24 */
! void (*tcl_ObjectSetMethodNameMapper) (Tcl_Object object, Tcl_ObjectMapMethodNameProc *mapMethodNameProc); /* 25 */
void (*tcl_ClassSetConstructor) (Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 26 */
void (*tcl_ClassSetDestructor) (Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 27 */
Tcl_Obj * (*tcl_GetObjectName) (Tcl_Interp *interp, Tcl_Object object); /* 28 */
Index: generic/tclOOIntDecls.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclOOIntDecls.h,v
retrieving revision 1.12
diff -c -r1.12 tclOOIntDecls.h
*** generic/tclOOIntDecls.h 5 Feb 2010 10:03:23 -0000 1.12
--- generic/tclOOIntDecls.h 1 Mar 2010 22:10:17 -0000
***************
*** 101,108 ****
/* 9 */
EXTERN Tcl_Method TclOONewProcInstanceMethodEx(Tcl_Interp *interp,
Tcl_Object oPtr,
! TclOO_PreCallProc preCallPtr,
! TclOO_PostCallProc postCallPtr,
ProcErrorProc *errProc,
ClientData clientData, Tcl_Obj *nameObj,
Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
--- 101,108 ----
/* 9 */
EXTERN Tcl_Method TclOONewProcInstanceMethodEx(Tcl_Interp *interp,
Tcl_Object oPtr,
! TclOO_PreCallProc *preCallPtr,
! TclOO_PostCallProc *postCallPtr,
ProcErrorProc *errProc,
ClientData clientData, Tcl_Obj *nameObj,
Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
***************
*** 113,120 ****
/* 10 */
EXTERN Tcl_Method TclOONewProcMethodEx(Tcl_Interp *interp,
Tcl_Class clsPtr,
! TclOO_PreCallProc preCallPtr,
! TclOO_PostCallProc postCallPtr,
ProcErrorProc *errProc,
ClientData clientData, Tcl_Obj *nameObj,
Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
--- 113,120 ----
/* 10 */
EXTERN Tcl_Method TclOONewProcMethodEx(Tcl_Interp *interp,
Tcl_Class clsPtr,
! TclOO_PreCallProc *preCallPtr,
! TclOO_PostCallProc *postCallPtr,
ProcErrorProc *errProc,
ClientData clientData, Tcl_Obj *nameObj,
Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
***************
*** 168,175 ****
int (*tclOOIsReachable) (Class *targetPtr, Class *startPtr); /* 6 */
Method * (*tclOONewForwardMethod) (Tcl_Interp *interp, Class *clsPtr, int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj); /* 7 */
Method * (*tclOONewForwardInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj); /* 8 */
! Tcl_Method (*tclOONewProcInstanceMethodEx) (Tcl_Interp *interp, Tcl_Object oPtr, TclOO_PreCallProc preCallPtr, TclOO_PostCallProc postCallPtr, ProcErrorProc *errProc, ClientData clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 9 */
! Tcl_Method (*tclOONewProcMethodEx) (Tcl_Interp *interp, Tcl_Class clsPtr, TclOO_PreCallProc preCallPtr, TclOO_PostCallProc postCallPtr, ProcErrorProc *errProc, ClientData clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 10 */
int (*tclOOInvokeObject) (Tcl_Interp *interp, Tcl_Object object, Tcl_Class startCls, int publicPrivate, int objc, Tcl_Obj *const *objv); /* 11 */
void (*tclOOObjectSetFilters) (Object *oPtr, int numFilters, Tcl_Obj *const *filters); /* 12 */
void (*tclOOClassSetFilters) (Tcl_Interp *interp, Class *classPtr, int numFilters, Tcl_Obj *const *filters); /* 13 */
--- 168,175 ----
int (*tclOOIsReachable) (Class *targetPtr, Class *startPtr); /* 6 */
Method * (*tclOONewForwardMethod) (Tcl_Interp *interp, Class *clsPtr, int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj); /* 7 */
Method * (*tclOONewForwardInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj); /* 8 */
! Tcl_Method (*tclOONewProcInstanceMethodEx) (Tcl_Interp *interp, Tcl_Object oPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, ClientData clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 9 */
! Tcl_Method (*tclOONewProcMethodEx) (Tcl_Interp *interp, Tcl_Class clsPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, ClientData clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 10 */
int (*tclOOInvokeObject) (Tcl_Interp *interp, Tcl_Object object, Tcl_Class startCls, int publicPrivate, int objc, Tcl_Obj *const *objv); /* 11 */
void (*tclOOObjectSetFilters) (Object *oPtr, int numFilters, Tcl_Obj *const *filters); /* 12 */
void (*tclOOClassSetFilters) (Tcl_Interp *interp, Class *classPtr, int numFilters, Tcl_Obj *const *filters); /* 13 */
Index: generic/tclOOMethod.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclOOMethod.c,v
retrieving revision 1.24
diff -c -r1.24 tclOOMethod.c
*** generic/tclOOMethod.c 24 Feb 2010 10:45:04 -0000 1.24
--- generic/tclOOMethod.c 1 Mar 2010 22:10:18 -0000
***************
*** 1655,1662 ****
TclOONewProcInstanceMethodEx(
Tcl_Interp *interp, /* The interpreter containing the object. */
Tcl_Object oPtr, /* The object to modify. */
! TclOO_PreCallProc preCallPtr,
! TclOO_PostCallProc postCallPtr,
ProcErrorProc *errProc,
ClientData clientData,
Tcl_Obj *nameObj, /* The name of the method, which must not be
--- 1655,1662 ----
TclOONewProcInstanceMethodEx(
Tcl_Interp *interp, /* The interpreter containing the object. */
Tcl_Object oPtr, /* The object to modify. */
! TclOO_PreCallProc *preCallPtr,
! TclOO_PostCallProc *postCallPtr,
ProcErrorProc *errProc,
ClientData clientData,
Tcl_Obj *nameObj, /* The name of the method, which must not be
Index: generic/tclOO.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclOO.c,v
retrieving revision 1.33
diff -c -r1.33 tclOO.c
*** generic/tclOO.c 15 Feb 2010 22:56:20 -0000 1.33
--- generic/tclOO.c 1 Mar 2010 22:10:15 -0000
***************
*** 2685,2691 ****
return (Tcl_Object) ((Class *)clazz)->thisPtr;
}
! Tcl_ObjectMapMethodNameProc
Tcl_ObjectGetMethodNameMapper(
Tcl_Object object)
{
--- 2685,2691 ----
return (Tcl_Object) ((Class *)clazz)->thisPtr;
}
! Tcl_ObjectMapMethodNameProc *
Tcl_ObjectGetMethodNameMapper(
Tcl_Object object)
{
***************
*** 2695,2701 ****
void
Tcl_ObjectSetMethodNameMapper(
Tcl_Object object,
! Tcl_ObjectMapMethodNameProc mapMethodNameProc)
{
((Object *) object)->mapMethodNameProc = mapMethodNameProc;
}
--- 2695,2701 ----
void
Tcl_ObjectSetMethodNameMapper(
Tcl_Object object,
! Tcl_ObjectMapMethodNameProc *mapMethodNameProc)
{
((Object *) object)->mapMethodNameProc = mapMethodNameProc;
}
Index: pkgs/itcl/generic/itcl2TclOO.c
===================================================================
RCS file: /cvsroot/tcl/itcl/generic/itcl2TclOO.c,v
retrieving revision 1.1.1.1
diff -c -r1.1.1.1 itcl2TclOO.c
*** pkgs/itcl/generic/itcl2TclOO.c 13 Jan 2009 21:26:04 -0000 1.1.1.1
--- pkgs/itcl/generic/itcl2TclOO.c 1 Mar 2010 22:10:18 -0000
***************
*** 62,68 ****
int result)
{
Tcl_Namespace *nsPtr = data[0];
! TclOO_PostCallProc postCallProc = data[1];
ClientData clientData = data[2];
/*
--- 62,68 ----
int result)
{
Tcl_Namespace *nsPtr = data[0];
! TclOO_PostCallProc *postCallProc = data[1];
ClientData clientData = data[2];
/*
