Tcl Source Code

Check-in [6723a5d58c]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:[Patch 2961556]: Change TclOO to use the same style of function typedefs as Tcl, as this is about the last chance to get this right.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk | potential incompatibility
Files: files | file ages | folders
SHA1: 6723a5d58cf061918d17b16c9d273719638c01a4
User & Date: dkf 2010-03-05 15:32:15
Context
2010-03-05
22:50
Fix [Bug 2964425]. check-in: c25ea55b7c user: dkf tags: trunk
15:32
[Patch 2961556]: Change TclOO to use the same style of function typedefs as Tcl, as this is about th... check-in: 6723a5d58c user: dkf tags: trunk, potential incompatibility
14:34
Code Audit results: * use do { ... } while (0) in macros * avoid shadowing one local variable with... check-in: 4d8a4f639d user: dkf tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.












1
2
3
4
5
6
7










2010-03-04  Donal K. Fellows  <[email protected]>

	* generic/tclOO.c (ObjectRenamedTrace): [Bug 2962664]: Add special
	handling so that when the class of classes is deleted, so is the class
	of objects. Immediately.

	* generic/tclOOInt.h (ROOT_CLASS): Add new flag for specially marking
>
>
>
>
>
>
>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
2010-03-05  Donal K. Fellows  <[email protected]>

	* generic/tclOO.h, generic/tclOOInt.h: [Patch 2961556]: Change TclOO
	to use the same style of function typedefs as Tcl, as this is about
	the last chance to get this right.

	***POTENTIAL INCOMPATIBILITY***
	Source code that uses function typedefs from TclOO will need to update
	variables and argument definitions so that pointers to the function
	values are used instead. Binary compatibility is not affected.

2010-03-04  Donal K. Fellows  <[email protected]>

	* generic/tclOO.c (ObjectRenamedTrace): [Bug 2962664]: Add special
	handling so that when the class of classes is deleted, so is the class
	of objects. Immediately.

	* generic/tclOOInt.h (ROOT_CLASS): Add new flag for specially marking

Changes to generic/tclOO.c.

4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
....
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
 *	This file contains the object-system core (NB: not Tcl_Obj, but ::oo)
 *
 * Copyright (c) 2005-2008 by Donal K. Fellows
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclOO.c,v 1.35 2010/03/05 14:34:04 dkf Exp $
 */

#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include "tclInt.h"
#include "tclOOInt.h"
................................................................................
Tcl_Object
Tcl_GetClassAsObject(
    Tcl_Class clazz)
{
    return (Tcl_Object) ((Class *)clazz)->thisPtr;
}

Tcl_ObjectMapMethodNameProc
Tcl_ObjectGetMethodNameMapper(
    Tcl_Object object)
{
    return ((Object *) object)->mapMethodNameProc;
}

void
Tcl_ObjectSetMethodNameMapper(
    Tcl_Object object,
    Tcl_ObjectMapMethodNameProc mapMethodNameProc)
{
    ((Object *) object)->mapMethodNameProc = mapMethodNameProc;
}
 
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






|







 







|









|











4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
....
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
 *	This file contains the object-system core (NB: not Tcl_Obj, but ::oo)
 *
 * Copyright (c) 2005-2008 by Donal K. Fellows
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclOO.c,v 1.36 2010/03/05 15:32:16 dkf Exp $
 */

#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include "tclInt.h"
#include "tclOOInt.h"
................................................................................
Tcl_Object
Tcl_GetClassAsObject(
    Tcl_Class clazz)
{
    return (Tcl_Object) ((Class *)clazz)->thisPtr;
}

Tcl_ObjectMapMethodNameProc *
Tcl_ObjectGetMethodNameMapper(
    Tcl_Object object)
{
    return ((Object *) object)->mapMethodNameProc;
}

void
Tcl_ObjectSetMethodNameMapper(
    Tcl_Object object,
    Tcl_ObjectMapMethodNameProc *mapMethodNameProc)
{
    ((Object *) object)->mapMethodNameProc = mapMethodNameProc;
}
 
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclOO.decls.

1
2
3
4
5
6
7
8
..
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
...
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
# $Id: tclOO.decls,v 1.6 2010/02/05 10:03:23 nijtmans Exp $

library tclOO
 
######################################################################
# public API
#

................................................................................
}
declare 23 generic {
    int Tcl_ObjectContextInvokeNext(Tcl_Interp *interp,
	    Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv,
	    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,
	    Tcl_Method method)
}
declare 27 generic {
    void Tcl_ClassSetDestructor(Tcl_Interp *interp, Tcl_Class clazz,
................................................................................
}
declare 8 generic {
    Method *TclOONewForwardInstanceMethod(Tcl_Interp *interp, Object *oPtr,
	    int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj)
}
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)
}
declare 11 generic {
    int TclOOInvokeObject(Tcl_Interp *interp, Tcl_Object object,
	    Tcl_Class startCls, int publicPrivate, int objc,
|







 







|




|







 







|
|





|







1
2
3
4
5
6
7
8
..
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
...
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
# $Id: tclOO.decls,v 1.7 2010/03/05 15:32:16 dkf Exp $

library tclOO
 
######################################################################
# public API
#

................................................................................
}
declare 23 generic {
    int Tcl_ObjectContextInvokeNext(Tcl_Interp *interp,
	    Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv,
	    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,
	    Tcl_Method method)
}
declare 27 generic {
    void Tcl_ClassSetDestructor(Tcl_Interp *interp, Tcl_Class clazz,
................................................................................
}
declare 8 generic {
    Method *TclOONewForwardInstanceMethod(Tcl_Interp *interp, Object *oPtr,
	    int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj)
}
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)
}
declare 11 generic {
    int TclOOInvokeObject(Tcl_Interp *interp, Tcl_Object object,
	    Tcl_Class startCls, int publicPrivate, int objc,

Changes to generic/tclOO.h.

5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
..
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
..
68
69
70
71
72
73
74

75
76
77
78
79
80
81
82
83
84
85
86
87
..
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
 *	declarations for the object-system (NB: not Tcl_Obj, but ::oo).
 *
 * Copyright (c) 2006-2008 by Donal K. Fellows
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclOO.h,v 1.9 2009/11/27 07:27:52 dkf Exp $
 */

#ifndef TCLOO_H_INCLUDED
#define TCLOO_H_INCLUDED
#include "tcl.h"

#if defined(BUILD_tcloo)
................................................................................
 
/*
 * Public datatypes for callbacks and structures used in the TIP#257 (OO)
 * implementation. These are used to implement custom types of method calls
 * 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);
 
/*
 * The type of a method implementation. This describes how to call the method
 * implementation, how to delete it (when the object or class is deleted) and
 * how to create a clone of it (when the object or class is copied).
 */
................................................................................

typedef struct {
    int version;		/* Structure version field. Always to be equal
				 * to TCL_OO_METHOD_VERSION_CURRENT in
				 * 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;

/*
 * The correct value for the version field of the Tcl_MethodType structure.
 * This allows new versions of the structure to be introduced without breaking
................................................................................
 */

typedef struct {
    int version;		/* Structure version field. Always to be equal
				 * 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;

/*
 * The correct value for the version field of the Tcl_ObjectMetadataType
 * structure. This allows new versions of the structure to be introduced






|







 







|

|
|

|
|







 







>
|
|



|







 







|


|







5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
..
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
..
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
..
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
 *	declarations for the object-system (NB: not Tcl_Obj, but ::oo).
 *
 * Copyright (c) 2006-2008 by Donal K. Fellows
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclOO.h,v 1.10 2010/03/05 15:32:16 dkf Exp $
 */

#ifndef TCLOO_H_INCLUDED
#define TCLOO_H_INCLUDED
#include "tcl.h"

#if defined(BUILD_tcloo)
................................................................................
 
/*
 * Public datatypes for callbacks and structures used in the TIP#257 (OO)
 * implementation. These are used to implement custom types of method calls
 * 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);
 
/*
 * The type of a method implementation. This describes how to call the method
 * implementation, how to delete it (when the object or class is deleted) and
 * how to create a clone of it (when the object or class is copied).
 */
................................................................................

typedef struct {
    int version;		/* Structure version field. Always to be equal
				 * to TCL_OO_METHOD_VERSION_CURRENT in
				 * 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;

/*
 * The correct value for the version field of the Tcl_MethodType structure.
 * This allows new versions of the structure to be introduced without breaking
................................................................................
 */

typedef struct {
    int version;		/* Structure version field. Always to be equal
				 * 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;

/*
 * The correct value for the version field of the Tcl_ObjectMetadataType
 * structure. This allows new versions of the structure to be introduced

Changes to generic/tclOODecls.h.

1
2
3
4
5
6
7
8
9
...
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
...
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
/*
 * $Id: tclOODecls.h,v 1.14 2010/02/05 10:03:23 nijtmans Exp $
 *
 * This file is (mostly) automatically generated from tclOO.decls.
 */

#ifndef _TCLOODECLS
#define _TCLOODECLS

................................................................................
EXTERN int		Tcl_ObjectContextInvokeNext(Tcl_Interp *interp,
				Tcl_ObjectContext context, int objc,
				Tcl_Obj *const *objv, int skip);
#endif
#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
/* 26 */
EXTERN void		Tcl_ClassSetConstructor(Tcl_Interp *interp,
				Tcl_Class clazz, Tcl_Method method);
#endif
................................................................................
    Tcl_Object (*tcl_ObjectContextObject) (Tcl_ObjectContext context); /* 17 */
    int (*tcl_ObjectContextSkippedArgs) (Tcl_ObjectContext context); /* 18 */
    ClientData (*tcl_ClassGetMetadata) (Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr); /* 19 */
    void (*tcl_ClassSetMetadata) (Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr, ClientData metadata); /* 20 */
    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 */
} TclOOStubs;

#if defined(USE_TCLOO_STUBS) && !defined(USE_TCLOO_STUB_PROCS)
extern const TclOOStubs *tclOOStubsPtr;
|







 







|






|







 







|
|







1
2
3
4
5
6
7
8
9
...
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
...
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
/*
 * $Id: tclOODecls.h,v 1.15 2010/03/05 15:32:16 dkf Exp $
 *
 * This file is (mostly) automatically generated from tclOO.decls.
 */

#ifndef _TCLOODECLS
#define _TCLOODECLS

................................................................................
EXTERN int		Tcl_ObjectContextInvokeNext(Tcl_Interp *interp,
				Tcl_ObjectContext context, int objc,
				Tcl_Obj *const *objv, int skip);
#endif
#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
/* 26 */
EXTERN void		Tcl_ClassSetConstructor(Tcl_Interp *interp,
				Tcl_Class clazz, Tcl_Method method);
#endif
................................................................................
    Tcl_Object (*tcl_ObjectContextObject) (Tcl_ObjectContext context); /* 17 */
    int (*tcl_ObjectContextSkippedArgs) (Tcl_ObjectContext context); /* 18 */
    ClientData (*tcl_ClassGetMetadata) (Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr); /* 19 */
    void (*tcl_ClassSetMetadata) (Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr, ClientData metadata); /* 20 */
    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 */
} TclOOStubs;

#if defined(USE_TCLOO_STUBS) && !defined(USE_TCLOO_STUB_PROCS)
extern const TclOOStubs *tclOOStubsPtr;

Changes to generic/tclOOInt.h.

5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
..
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
..
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
...
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
 *	declarations for the object-system (NB: not Tcl_Obj, but ::oo).
 *
 * Copyright (c) 2006 by Donal K. Fellows
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclOOInt.h,v 1.16 2010/03/04 23:42:54 dkf Exp $
 */

#ifndef TCL_OO_INTERNAL_H
#define TCL_OO_INTERNAL_H 1

#include <tclInt.h>
#include "tclOO.h"
................................................................................
} Method;

/*
 * Pre- and post-call callbacks, to allow procedure-like methods to be fine
 * 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.
 */

typedef struct ProcedureMethod {
    int version;		/* Version of this structure. Currently must
................................................................................
				 * be 0. */
    Proc *procPtr;		/* Core of the implementation of the method;
				 * includes the argument definition and the
				 * body bytecodes. */
    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;
				/* Callback to allow for fine tuning of how
				 * the method reports itself. */
} ProcedureMethod;

................................................................................
				 * the ClientData values that are the values
				 * of each piece of attached metadata. This
				 * field starts out as NULL and is only
				 * allocated if metadata is attached. */
    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;
} Object;

#define OBJECT_DELETED	1	/* Flag to say that an object has been
				 * destroyed. */






|







 







|

|

|
|







 







|
|

|


|







 







|







5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
..
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
..
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
...
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
 *	declarations for the object-system (NB: not Tcl_Obj, but ::oo).
 *
 * Copyright (c) 2006 by Donal K. Fellows
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclOOInt.h,v 1.17 2010/03/05 15:32:16 dkf Exp $
 */

#ifndef TCL_OO_INTERNAL_H
#define TCL_OO_INTERNAL_H 1

#include <tclInt.h>
#include "tclOO.h"
................................................................................
} Method;

/*
 * Pre- and post-call callbacks, to allow procedure-like methods to be fine
 * 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.
 */

typedef struct ProcedureMethod {
    int version;		/* Version of this structure. Currently must
................................................................................
				 * be 0. */
    Proc *procPtr;		/* Core of the implementation of the method;
				 * includes the argument definition and the
				 * body bytecodes. */
    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;
				/* Callback to allow for fine tuning of how
				 * the method reports itself. */
} ProcedureMethod;

................................................................................
				 * the ClientData values that are the values
				 * of each piece of attached metadata. This
				 * field starts out as NULL and is only
				 * allocated if metadata is attached. */
    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;
} Object;

#define OBJECT_DELETED	1	/* Flag to say that an object has been
				 * destroyed. */

Changes to generic/tclOOIntDecls.h.

1
2
3
4
5
6
7
8
9
..
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
...
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
/*
 * $Id: tclOOIntDecls.h,v 1.12 2010/02/05 10:03:23 nijtmans Exp $
 *
 * This file is (mostly) automatically generated from tclOO.decls.
 */

#ifndef _TCLOOINTDECLS
#define _TCLOOINTDECLS

................................................................................
				Tcl_Obj *prefixObj);
#endif
#ifndef TclOONewProcInstanceMethodEx_TCL_DECLARED
#define TclOONewProcInstanceMethodEx_TCL_DECLARED
/* 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,
				int flags, void **internalTokenPtr);
#endif
#ifndef TclOONewProcMethodEx_TCL_DECLARED
#define TclOONewProcMethodEx_TCL_DECLARED
/* 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,
				int flags, void **internalTokenPtr);
#endif
#ifndef TclOOInvokeObject_TCL_DECLARED
#define TclOOInvokeObject_TCL_DECLARED
................................................................................
    Tcl_Method (*tclOOMakeProcMethod) (Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, const char *namePtr, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, ClientData clientData, Proc **procPtrPtr); /* 2 */
    Method * (*tclOONewProcInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr); /* 3 */
    Method * (*tclOONewProcMethod) (Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr); /* 4 */
    int (*tclOOObjectCmdCore) (Object *oPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv, int publicOnly, Class *startCls); /* 5 */
    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 */
    void (*tclOOObjectSetMixins) (Object *oPtr, int numMixins, Class *const *mixins); /* 14 */
    void (*tclOOClassSetMixins) (Tcl_Interp *interp, Class *classPtr, int numMixins, Class *const *mixins); /* 15 */
} TclOOIntStubs;

|







 







|
|










|
|







 







|
|







1
2
3
4
5
6
7
8
9
..
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
...
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
/*
 * $Id: tclOOIntDecls.h,v 1.13 2010/03/05 15:32:16 dkf Exp $
 *
 * This file is (mostly) automatically generated from tclOO.decls.
 */

#ifndef _TCLOOINTDECLS
#define _TCLOOINTDECLS

................................................................................
				Tcl_Obj *prefixObj);
#endif
#ifndef TclOONewProcInstanceMethodEx_TCL_DECLARED
#define TclOONewProcInstanceMethodEx_TCL_DECLARED
/* 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,
				int flags, void **internalTokenPtr);
#endif
#ifndef TclOONewProcMethodEx_TCL_DECLARED
#define TclOONewProcMethodEx_TCL_DECLARED
/* 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,
				int flags, void **internalTokenPtr);
#endif
#ifndef TclOOInvokeObject_TCL_DECLARED
#define TclOOInvokeObject_TCL_DECLARED
................................................................................
    Tcl_Method (*tclOOMakeProcMethod) (Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, const char *namePtr, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, ClientData clientData, Proc **procPtrPtr); /* 2 */
    Method * (*tclOONewProcInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr); /* 3 */
    Method * (*tclOONewProcMethod) (Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr); /* 4 */
    int (*tclOOObjectCmdCore) (Object *oPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv, int publicOnly, Class *startCls); /* 5 */
    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 */
    void (*tclOOObjectSetMixins) (Object *oPtr, int numMixins, Class *const *mixins); /* 14 */
    void (*tclOOClassSetMixins) (Tcl_Interp *interp, Class *classPtr, int numMixins, Class *const *mixins); /* 15 */
} TclOOIntStubs;