1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
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
89
90
91
92
93
94
95
96
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
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
|
/*
* ------------------------------------------------------------------------
* PACKAGE: [incr Tcl]
* DESCRIPTION: Object-Oriented Extensions to Tcl
*
* [incr Tcl] provides object-oriented extensions to Tcl, much as
* C++ provides object-oriented extensions to C. It provides a means
* of encapsulating related procedures together with their shared data
* in a local namespace that is hidden from the outside world. It
* promotes code re-use through inheritance. More than anything else,
* it encourages better organization of Tcl applications through the
* object-oriented paradigm, leading to code that is easier to
* understand and maintain.
*
* ADDING [incr Tcl] TO A Tcl-BASED APPLICATION:
*
* To add [incr Tcl] facilities to a Tcl application, modify the
* Tcl_AppInit() routine as follows:
*
* 1) Include this header file near the top of the file containing
* Tcl_AppInit():
*
* #include "itcl.h"
*
* 2) Within the body of Tcl_AppInit(), add the following lines:
*
* if (Itcl_Init(interp) == TCL_ERROR) {
* return TCL_ERROR;
* }
*
* 3) Link your application with libitcl.a
*
* NOTE: An example file "tclAppInit.c" containing the changes shown
* above is included in this distribution.
*
* ========================================================================
* AUTHOR: Michael J. McLennan
* Bell Labs Innovations for Lucent Technologies
* mmclennan@lucent.com
* http://www.tcltk.com/itcl
*
* RCS: $Id$
* ========================================================================
* Copyright (c) 1993-1998 Lucent Technologies, Inc.
* ------------------------------------------------------------------------
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#ifndef ITCLINT_H
#define ITCLINT_H
#include "itcl.h"
#include "tclInt.h"
#ifdef BUILD_itcl
# undef TCL_STORAGE_CLASS
# define TCL_STORAGE_CLASS DLLEXPORT
#endif
/*
* Common info for managing all known objects.
* Each interpreter has one of these data structures stored as
* clientData in the "itcl" namespace. It is also accessible
* as associated data via the key ITCL_INTERP_DATA.
*/
struct ItclObject;
typedef struct ItclObjectInfo {
Tcl_Interp *interp; /* interpreter that manages this info */
Tcl_HashTable objects; /* list of all known objects */
Itcl_Stack transparentFrames; /* stack of call frames that should be
* treated transparently. When
* Itcl_EvalMemberCode is invoked in
* one of these contexts, it does an
* "uplevel" to get past the transparent
* frame and back to the calling context. */
Tcl_HashTable contextFrames; /* object contexts for active call frames */
int protection; /* protection level currently in effect */
Itcl_Stack cdefnStack; /* stack of class definitions currently
* being parsed */
} ItclObjectInfo;
#define ITCL_INTERP_DATA "itcl_data"
/*
* Representation for each [incr Tcl] class.
*/
typedef struct ItclClass {
char *name; /* class name */
char *fullname; /* fully qualified class name */
Tcl_Interp *interp; /* interpreter that manages this info */
Tcl_Namespace *namesp; /* namespace representing class scope */
Tcl_Command accessCmd; /* access command for creating instances */
struct ItclObjectInfo *info; /* info about all known objects */
Itcl_List bases; /* list of base classes */
Itcl_List derived; /* list of all derived classes */
Tcl_HashTable heritage; /* table of all base classes. Look up
* by pointer to class definition. This
* provides fast lookup for inheritance
* tests. */
Tcl_Obj *initCode; /* initialization code for new objs */
Tcl_HashTable variables; /* definitions for all data members
in this class. Look up simple string
names and get back ItclVarDefn* ptrs */
Tcl_HashTable functions; /* definitions for all member functions
in this class. Look up simple string
names and get back ItclMemberFunc* ptrs */
int numInstanceVars; /* number of instance vars in variables
table */
Tcl_HashTable resolveVars; /* all possible names for variables in
* this class (e.g., x, foo::x, etc.) */
Tcl_HashTable resolveCmds; /* all possible names for functions in
* this class (e.g., x, foo::x, etc.) */
int unique; /* unique number for #auto generation */
int flags; /* maintains class status */
} ItclClass;
typedef struct ItclHierIter {
ItclClass *current; /* current position in hierarchy */
Itcl_Stack stack; /* stack used for traversal */
} ItclHierIter;
/*
* Representation for each [incr Tcl] object.
*/
typedef struct ItclObject {
ItclClass *classDefn; /* most-specific class */
Tcl_Command accessCmd; /* object access command */
int dataSize; /* number of elements in data array */
Var** data; /* all object-specific data members */
Tcl_HashTable* constructed; /* temp storage used during construction */
Tcl_HashTable* destructed; /* temp storage used during destruction */
} ItclObject;
#define ITCL_IGNORE_ERRS 0x002 /* useful for construction/destruction */
/*
* Implementation for any code body in an [incr Tcl] class.
*/
typedef struct ItclMemberCode {
int flags; /* flags describing implementation */
CompiledLocal *arglist; /* list of arg names and initial values */
int argcount; /* number of args in arglist */
Proc *procPtr; /* Tcl proc representation (needed to
* handle compiled locals) */
union {
Tcl_CmdProc *argCmd; /* (argc,argv) C implementation */
Tcl_ObjCmdProc *objCmd; /* (objc,objv) C implementation */
} cfunc;
ClientData clientData; /* client data for C implementations */
} ItclMemberCode;
/*
* Basic representation for class members (commands/variables)
*/
typedef struct ItclMember {
Tcl_Interp* interp; /* interpreter containing the class */
ItclClass* classDefn; /* class containing this member */
char* name; /* member name */
char* fullname; /* member name with "class::" qualifier */
int protection; /* protection level */
int flags; /* flags describing member (see below) */
ItclMemberCode *code; /* code associated with member */
} ItclMember;
/*
* Flag bits for ItclMemberCode and ItclMember:
*/
#define ITCL_IMPLEMENT_NONE 0x001 /* no implementation */
#define ITCL_IMPLEMENT_TCL 0x002 /* Tcl implementation */
#define ITCL_IMPLEMENT_ARGCMD 0x004 /* (argc,argv) C implementation */
#define ITCL_IMPLEMENT_OBJCMD 0x008 /* (objc,objv) C implementation */
#define ITCL_IMPLEMENT_C 0x00c /* either kind of C implementation */
#define ITCL_CONSTRUCTOR 0x010 /* non-zero => is a constructor */
#define ITCL_DESTRUCTOR 0x020 /* non-zero => is a destructor */
#define ITCL_COMMON 0x040 /* non-zero => is a "proc" */
#define ITCL_ARG_SPEC 0x080 /* non-zero => has an argument spec */
#define ITCL_OLD_STYLE 0x100 /* non-zero => old-style method
* (process "config" argument) */
#define ITCL_THIS_VAR 0x200 /* non-zero => built-in "this" variable */
/*
* Representation of member functions in an [incr Tcl] class.
*/
typedef struct ItclMemberFunc {
ItclMember *member; /* basic member info */
Tcl_Command accessCmd; /* Tcl command installed for this function */
CompiledLocal *arglist; /* list of arg names and initial values */
int argcount; /* number of args in arglist */
} ItclMemberFunc;
/*
* Instance variables.
*/
typedef struct ItclVarDefn {
ItclMember *member; /* basic member info */
char* init; /* initial value */
} ItclVarDefn;
/*
* Instance variable lookup entry.
*/
typedef struct ItclVarLookup {
ItclVarDefn* vdefn; /* variable definition */
int usage; /* number of uses for this record */
int accessible; /* non-zero => accessible from class with
* this lookup record in its resolveVars */
char *leastQualName; /* simplist name for this variable, with
* the fewest qualifiers. This string is
* taken from the resolveVars table, so
* it shouldn't be freed. */
union {
int index; /* index into virtual table (instance data) */
Tcl_Var common; /* variable (common data) */
} var;
} ItclVarLookup;
/*
* Representation for the context in which a body of [incr Tcl]
* code executes. In ordinary Tcl, this is a CallFrame. But for
* [incr Tcl] code bodies, we must be careful to set up the
* CallFrame properly, to plug in instance variables before
* executing the code body.
*/
typedef struct ItclContext {
ItclClass *classDefn; /* class definition */
CallFrame frame; /* call frame for object context */
Var *compiledLocals; /* points to storage for compiled locals */
Var localStorage[20]; /* default storage for compiled locals */
} ItclContext;
#include "itclIntDecls.h"
/*
* Since the Tcl/Tk distribution doesn't perform any asserts,
* dynamic loading can fail to find the __assert function.
* As a workaround, we'll include our own.
*/
#undef assert
#ifdef NDEBUG
#define assert(EX) ((void)0)
#else
#if defined(__STDC__)
#define assert(EX) (void)((EX) || (Itcl_Assert(#EX, __FILE__, __LINE__), 0))
#else
#define assert(EX) (void)((EX) || (Itcl_Assert("EX", __FILE__, __LINE__), 0))
#endif /* __STDC__ */
#endif /* NDEBUG */
#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT
#endif /* ITCLINT_H */
|
