Mercurial > repos > rliterman > csp2

comparison CSP2/CSP2_env/env-d9b9114564458d9d-741b3de822f2aaca6c6caa4325c4afce/include/itclInt.h @ 69:33d812a61356

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
planemo upload commit 2e9511a184a1ca667c7be0c6321a36dc4e3d116d
author jpayne
date Tue, 18 Mar 2025 17:55:14 -0400
parents
children
comparison
equal deleted inserted replaced
67:0e9998148a16 69:33d812a61356
1 /*
2 * itclInt.h --
3 *
4 * This file contains internal definitions for the C-implemented part of a
5 * Itcl
6 *
7 * Copyright (c) 2007 by Arnulf P. Wiedemann
8 *
9 * See the file "license.terms" for information on usage and redistribution of
10 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
11 */
12
13 #ifdef HAVE_UNISTD_H
14 #include <unistd.h>
15 #endif
16 #ifdef HAVE_STDINT_H
17 #include <stdint.h>
18 #endif
19 #include <stddef.h>
20
21 /*
22 * Used to tag functions that are only to be visible within the module being
23 * built and not outside it (where this is supported by the linker).
24 */
25
26 #ifndef MODULE_SCOPE
27 # ifdef __cplusplus
28 # define MODULE_SCOPE extern "C"
29 # else
30 # define MODULE_SCOPE extern
31 # endif
32 #endif
33
34 #include <string.h>
35 #include <ctype.h>
36 #include <tclOO.h>
37 #include "itcl.h"
38 #include "itclMigrate2TclCore.h"
39 #include "itclTclIntStubsFcn.h"
40
41 /*
42 * Utility macros: STRINGIFY takes an argument and wraps it in "" (double
43 * quotation marks).
44 */
45
46 #ifndef STRINGIFY
47 # define STRINGIFY(x) STRINGIFY1(x)
48 # define STRINGIFY1(x) #x
49 #endif
50
51 /*
52 * MSVC 8.0 started to mark many standard C library functions depreciated
53 * including the *printf family and others. Tell it to shut up.
54 * (_MSC_VER is 1200 for VC6, 1300 or 1310 for vc7.net, 1400 for 8.0)
55 */
56 #if defined(_MSC_VER)
57 # pragma warning(disable:4244)
58 # if _MSC_VER >= 1400
59 # pragma warning(disable:4267)
60 # pragma warning(disable:4996)
61 # endif
62 #endif
63
64 #ifndef JOIN
65 # define JOIN(a,b) JOIN1(a,b)
66 # define JOIN1(a,b) a##b
67 #endif
68
69 #ifndef TCL_UNUSED
70 # if defined(__cplusplus)
71 # define TCL_UNUSED(T) T
72 # elif defined(__GNUC__) && (__GNUC__ > 2)
73 # define TCL_UNUSED(T) T JOIN(dummy, __LINE__) __attribute__((unused))
74 # else
75 # define TCL_UNUSED(T) T JOIN(dummy, __LINE__)
76 # endif
77 #endif
78
79 #if TCL_MAJOR_VERSION == 8
80 # define ITCL_Z_MODIFIER ""
81 #else
82 # define ITCL_Z_MODIFIER TCL_Z_MODIFIER
83 #endif
84
85 /*
86 * Since the Tcl/Tk distribution doesn't perform any asserts,
87 * dynamic loading can fail to find the __assert function.
88 * As a workaround, we'll include our own.
89 */
90
91 #undef assert
92 #if defined(NDEBUG) && !defined(DEBUG)
93 #define assert(EX) ((void)0)
94 #else /* !NDEBUG || DEBUG */
95 #define assert(EX) (void)((EX) || (Itcl_Assert(STRINGIFY(EX), __FILE__, __LINE__), 0))
96 #endif
97
98 #define ITCL_INTERP_DATA "itcl_data"
99 #define ITCL_TK_VERSION "8.6"
100
101 /*
102 * Convenience macros for iterating through hash tables. FOREACH_HASH_DECLS
103 * sets up the declarations needed for the main macro, FOREACH_HASH, which
104 * does the actual iteration. FOREACH_HASH_VALUE is a restricted version that
105 * only iterates over values.
106 */
107
108 #define FOREACH_HASH_DECLS \
109 Tcl_HashEntry *hPtr;Tcl_HashSearch search
110 #define FOREACH_HASH(key,val,tablePtr) \
111 for(hPtr=Tcl_FirstHashEntry((tablePtr),&search); hPtr!=NULL ? \
112 (*(void **)&(key)=Tcl_GetHashKey((tablePtr),hPtr),\
113 *(void **)&(val)=Tcl_GetHashValue(hPtr),1):0; hPtr=Tcl_NextHashEntry(&search))
114 #define FOREACH_HASH_VALUE(val,tablePtr) \
115 for(hPtr=Tcl_FirstHashEntry((tablePtr),&search); hPtr!=NULL ? \
116 (*(void **)&(val)=Tcl_GetHashValue(hPtr),1):0;hPtr=Tcl_NextHashEntry(&search))
117
118 /*
119 * What sort of size of things we like to allocate.
120 */
121
122 #define ALLOC_CHUNK 8
123
124 #define ITCL_INT_NAMESPACE ITCL_NAMESPACE"::internal"
125 #define ITCL_INTDICTS_NAMESPACE ITCL_INT_NAMESPACE"::dicts"
126 #define ITCL_VARIABLES_NAMESPACE ITCL_INT_NAMESPACE"::variables"
127 #define ITCL_COMMANDS_NAMESPACE ITCL_INT_NAMESPACE"::commands"
128
129 typedef struct ItclFoundation {
130 Itcl_Stack methodCallStack;
131 Tcl_Command dispatchCommand;
132 } ItclFoundation;
133
134 typedef struct ItclArgList {
135 struct ItclArgList *nextPtr; /* pointer to next argument */
136 Tcl_Obj *namePtr; /* name of the argument */
137 Tcl_Obj *defaultValuePtr; /* default value or NULL if none */
138 } ItclArgList;
139
140 /*
141 * Common info for managing all known objects.
142 * Each interpreter has one of these data structures stored as
143 * clientData in the "itcl" namespace. It is also accessible
144 * as associated data via the key ITCL_INTERP_DATA.
145 */
146 struct ItclClass;
147 struct ItclObject;
148 struct ItclMemberFunc;
149 struct EnsembleInfo;
150 struct ItclDelegatedOption;
151 struct ItclDelegatedFunction;
152
153 typedef struct ItclObjectInfo {
154 Tcl_Interp *interp; /* interpreter that manages this info */
155 Tcl_HashTable objects; /* list of all known objects key is
156 * ioPtr */
157 Tcl_HashTable objectCmds; /* list of known objects using accessCmd */
158 Tcl_HashTable unused5; /* list of known objects using namePtr */
159 Tcl_HashTable classes; /* list of all known classes,
160 * key is iclsPtr */
161 Tcl_HashTable nameClasses; /* maps from fullNamePtr to iclsPtr */
162 Tcl_HashTable namespaceClasses; /* maps from nsPtr to iclsPtr */
163 Tcl_HashTable procMethods; /* maps from procPtr to mFunc */
164 Tcl_HashTable instances; /* maps from instanceNumber to ioPtr */
165 Tcl_HashTable unused8; /* maps from ioPtr to instanceNumber */
166 Tcl_HashTable frameContext; /* maps frame to context stack */
167 Tcl_HashTable classTypes; /* maps from class type i.e. "widget"
168 * to define value i.e. ITCL_WIDGET */
169 int protection; /* protection level currently in effect */
170 int useOldResolvers; /* whether to use the "old" style
171 * resolvers or the CallFrame resolvers */
172 Itcl_Stack clsStack; /* stack of class definitions currently
173 * being parsed */
174 Itcl_Stack unused; /* Removed */
175 Itcl_Stack unused6; /* obsolete field */
176 struct ItclObject *currIoPtr; /* object currently being constructed
177 * set only during calling of constructors
178 * otherwise NULL */
179 Tcl_ObjectMetadataType *class_meta_type;
180 /* type for getting the Itcl class info
181 * from a TclOO Tcl_Object */
182 const Tcl_ObjectMetadataType *object_meta_type;
183 /* type for getting the Itcl object info
184 * from a TclOO Tcl_Object */
185 Tcl_Object clazzObjectPtr; /* the root object of Itcl */
186 Tcl_Class clazzClassPtr; /* the root class of Itcl */
187 struct EnsembleInfo *ensembleInfo;
188 struct ItclClass *currContextIclsPtr;
189 /* context class for delegated option
190 * handling */
191 int currClassFlags; /* flags for the class just in creation */
192 int buildingWidget; /* set if in construction of a widget */
193 Tcl_Size unparsedObjc; /* number options not parsed by
194 ItclExtendedConfigure/-Cget function */
195 Tcl_Obj **unparsedObjv; /* options not parsed by
196 ItclExtendedConfigure/-Cget function */
197 int functionFlags; /* used for creating of ItclMemberCode */
198 int unused7;
199 struct ItclDelegatedOption *currIdoPtr;
200 /* the current delegated option info */
201 int inOptionHandling; /* used to indicate for type/widget ...
202 * that there is an option processing
203 * and methods are allowed to be called */
204 /* these are the Tcl_Obj Ptrs for the clazz unknown procedure */
205 /* need to store them to be able to free them at the end */
206 int itclWidgetInitted; /* set to 1 if itclWidget.tcl has already
207 * been called
208 */
209 int itclHullCmdsInitted; /* set to 1 if itclHullCmds.tcl has already
210 * been called
211 */
212 Tcl_Obj *unused2;
213 Tcl_Obj *unused3;
214 Tcl_Obj *unused4;
215 Tcl_Obj *infoVarsPtr;
216 Tcl_Obj *unused9;
217 Tcl_Obj *infoVars4Ptr;
218 Tcl_Obj *typeDestructorArgumentPtr;
219 struct ItclObject *lastIoPtr; /* last object constructed */
220 Tcl_Command infoCmd;
221 } ItclObjectInfo;
222
223 typedef struct EnsembleInfo {
224 Tcl_HashTable ensembles; /* list of all known ensembles */
225 Tcl_HashTable subEnsembles; /* list of all known subensembles */
226 Tcl_Size numEnsembles;
227 Tcl_Namespace *ensembleNsPtr;
228 } EnsembleInfo;
229 /*
230 * Representation for each [incr Tcl] class.
231 */
232 #define ITCL_CLASS 0x1
233 #define ITCL_TYPE 0x2
234 #define ITCL_WIDGET 0x4
235 #define ITCL_WIDGETADAPTOR 0x8
236 #define ITCL_ECLASS 0x10
237 #define ITCL_NWIDGET 0x20
238 #define ITCL_WIDGET_FRAME 0x40
239 #define ITCL_WIDGET_LABEL_FRAME 0x80
240 #define ITCL_WIDGET_TOPLEVEL 0x100
241 #define ITCL_WIDGET_TTK_FRAME 0x200
242 #define ITCL_WIDGET_TTK_LABEL_FRAME 0x400
243 #define ITCL_WIDGET_TTK_TOPLEVEL 0x800
244 #define ITCL_CLASS_IS_DELETED 0x1000
245 #define ITCL_CLASS_IS_DESTROYED 0x2000
246 #define ITCL_CLASS_NS_IS_DESTROYED 0x4000
247 #define ITCL_CLASS_IS_RENAMED 0x8000 /* unused */
248 #define ITCL_CLASS_IS_FREED 0x10000
249 #define ITCL_CLASS_DERIVED_RELEASED 0x20000
250 #define ITCL_CLASS_NS_TEARDOWN 0x40000
251 #define ITCL_CLASS_NO_VARNS_DELETE 0x80000
252 #define ITCL_CLASS_SHOULD_VARNS_DELETE 0x100000
253 #define ITCL_CLASS_DESTRUCTOR_CALLED 0x400000
254
255
256 typedef struct ItclClass {
257 Tcl_Obj *namePtr; /* class name */
258 Tcl_Obj *fullNamePtr; /* fully qualified class name */
259 Tcl_Interp *interp; /* interpreter that manages this info */
260 Tcl_Namespace *nsPtr; /* namespace representing class scope */
261 Tcl_Command accessCmd; /* access command for creating instances */
262 Tcl_Command thisCmd; /* needed for deletion of class */
263
264 struct ItclObjectInfo *infoPtr;
265 /* info about all known objects
266 * and other stuff like stacks */
267 Itcl_List bases; /* list of base classes */
268 Itcl_List derived; /* list of all derived classes */
269 Tcl_HashTable heritage; /* table of all base classes. Look up
270 * by pointer to class definition. This
271 * provides fast lookup for inheritance
272 * tests. */
273 Tcl_Obj *initCode; /* initialization code for new objs */
274 Tcl_HashTable variables; /* definitions for all data members
275 in this class. Look up simple string
276 names and get back ItclVariable* ptrs */
277 Tcl_HashTable options; /* definitions for all option members
278 in this class. Look up simple string
279 names and get back ItclOption* ptrs */
280 Tcl_HashTable components; /* definitions for all component members
281 in this class. Look up simple string
282 names and get back ItclComponent* ptrs */
283 Tcl_HashTable functions; /* definitions for all member functions
284 in this class. Look up simple string
285 names and get back ItclMemberFunc* ptrs */
286 Tcl_HashTable delegatedOptions; /* definitions for all delegated options
287 in this class. Look up simple string
288 names and get back
289 ItclDelegatedOption * ptrs */
290 Tcl_HashTable delegatedFunctions; /* definitions for all delegated methods
291 or procs in this class. Look up simple
292 string names and get back
293 ItclDelegatedFunction * ptrs */
294 Tcl_HashTable methodVariables; /* definitions for all methodvariable members
295 in this class. Look up simple string
296 names and get back
297 ItclMethodVariable* ptrs */
298 Tcl_Size numInstanceVars; /* number of instance vars in variables
299 table */
300 Tcl_HashTable classCommons; /* used for storing variable namespace
301 * string for Tcl_Resolve */
302 Tcl_HashTable resolveVars; /* all possible names for variables in
303 * this class (e.g., x, foo::x, etc.) */
304 Tcl_HashTable resolveCmds; /* all possible names for functions in
305 * this class (e.g., x, foo::x, etc.) */
306 Tcl_HashTable contextCache; /* cache for function contexts */
307 struct ItclMemberFunc *unused2;
308 /* the class constructor or NULL */
309 struct ItclMemberFunc *unused3;
310 /* the class destructor or NULL */
311 struct ItclMemberFunc *unused1;
312 Tcl_Resolve *resolvePtr;
313 Tcl_Obj *widgetClassPtr; /* class name for widget if class is a
314 * ::itcl::widget */
315 Tcl_Obj *hullTypePtr; /* hulltype name for widget if class is a
316 * ::itcl::widget */
317 Tcl_Object oPtr; /* TclOO class object */
318 Tcl_Class clsPtr; /* TclOO class */
319 Tcl_Size numCommons; /* number of commons in this class */
320 Tcl_Size numVariables; /* number of variables in this class */
321 Tcl_Size numOptions; /* number of options in this class */
322 Tcl_Size unique; /* unique number for #auto generation */
323 int flags; /* maintains class status */
324 Tcl_Size callRefCount; /* prevent deleting of class if refcount>1 */
325 Tcl_Obj *typeConstructorPtr; /* initialization for types */
326 int destructorHasBeenCalled; /* prevent multiple invocations of destrcutor */
327 Tcl_Size refCount;
328 } ItclClass;
329
330 typedef struct ItclHierIter {
331 ItclClass *current; /* current position in hierarchy */
332 Itcl_Stack stack; /* stack used for traversal */
333 } ItclHierIter;
334
335 #define ITCL_OBJECT_IS_DELETED 0x01
336 #define ITCL_OBJECT_IS_DESTRUCTED 0x02
337 #define ITCL_OBJECT_IS_DESTROYED 0x04
338 #define ITCL_OBJECT_IS_RENAMED 0x08
339 #define ITCL_OBJECT_CLASS_DESTRUCTED 0x10
340 #define ITCL_TCLOO_OBJECT_IS_DELETED 0x20
341 #define ITCL_OBJECT_DESTRUCT_ERROR 0x40
342 #define ITCL_OBJECT_SHOULD_VARNS_DELETE 0x80
343 #define ITCL_OBJECT_ROOT_METHOD 0x8000
344
345 /*
346 * Representation for each [incr Tcl] object.
347 */
348 typedef struct ItclObject {
349 ItclClass *iclsPtr; /* most-specific class */
350 Tcl_Command accessCmd; /* object access command */
351
352 Tcl_HashTable *constructed; /* temp storage used during construction */
353 Tcl_HashTable *destructed; /* temp storage used during destruction */
354 Tcl_HashTable objectVariables;
355 /* used for storing Tcl_Var entries for
356 * variable resolving, key is ivPtr of
357 * variable, value is varPtr */
358 Tcl_HashTable objectOptions; /* definitions for all option members
359 in this object. Look up option namePtr
360 names and get back ItclOption* ptrs */
361 Tcl_HashTable objectComponents; /* definitions for all component members
362 in this object. Look up component namePtr
363 names and get back ItclComponent* ptrs */
364 Tcl_HashTable objectMethodVariables;
365 /* definitions for all methodvariable members
366 in this object. Look up methodvariable
367 namePtr names and get back
368 ItclMethodVariable* ptrs */
369 Tcl_HashTable objectDelegatedOptions;
370 /* definitions for all delegated option
371 members in this object. Look up option
372 namePtr names and get back
373 ItclOption* ptrs */
374 Tcl_HashTable objectDelegatedFunctions;
375 /* definitions for all delegated function
376 members in this object. Look up function
377 namePtr names and get back
378 ItclMemberFunc * ptrs */
379 Tcl_HashTable contextCache; /* cache for function contexts */
380 Tcl_Obj *namePtr;
381 Tcl_Obj *origNamePtr; /* the original name before any rename */
382 Tcl_Obj *createNamePtr; /* the temp name before any rename
383 * mostly used for widgetadaptor
384 * because that hijackes the name
385 * often when installing the hull */
386 Tcl_Interp *interp;
387 ItclObjectInfo *infoPtr;
388 Tcl_Obj *varNsNamePtr;
389 Tcl_Object oPtr; /* the TclOO object */
390 Tcl_Resolve *resolvePtr;
391 int flags;
392 Tcl_Size callRefCount; /* prevent deleting of object if refcount > 1 */
393 Tcl_Obj *hullWindowNamePtr; /* the window path name for the hull
394 * (before renaming in installhull) */
395 int destructorHasBeenCalled; /* is set when the destructor is called
396 * to avoid callin destructor twice */
397 int noComponentTrace; /* don't call component traces if
398 * setting components in DelegationInstall */
399 int hadConstructorError; /* needed for multiple calls of CallItclObjectCmd */
400 } ItclObject;
401
402 #define ITCL_IGNORE_ERRS 0x002 /* useful for construction/destruction */
403
404 typedef struct ItclResolveInfo {
405 int flags;
406 ItclClass *iclsPtr;
407 ItclObject *ioPtr;
408 } ItclResolveInfo;
409
410 #define ITCL_RESOLVE_CLASS 0x01
411 #define ITCL_RESOLVE_OBJECT 0x02
412
413 /*
414 * Implementation for any code body in an [incr Tcl] class.
415 */
416 typedef struct ItclMemberCode {
417 int flags; /* flags describing implementation */
418 Tcl_Size argcount; /* number of args in arglist */
419 Tcl_Size maxargcount; /* max number of args in arglist */
420 Tcl_Obj *usagePtr; /* usage string for error messages */
421 Tcl_Obj *argumentPtr; /* the function arguments */
422 Tcl_Obj *bodyPtr; /* the function body */
423 ItclArgList *argListPtr; /* the parsed arguments */
424 union {
425 Tcl_CmdProc *argCmd; /* (argc,argv) C implementation */
426 Tcl_ObjCmdProc *objCmd; /* (objc,objv) C implementation */
427 } cfunc;
428 void *clientData; /* client data for C implementations */
429 } ItclMemberCode;
430
431 /*
432 * Flag bits for ItclMemberCode:
433 */
434 #define ITCL_IMPLEMENT_NONE 0x001 /* no implementation */
435 #define ITCL_IMPLEMENT_TCL 0x002 /* Tcl implementation */
436 #define ITCL_IMPLEMENT_ARGCMD 0x004 /* (argc,argv) C implementation */
437 #define ITCL_IMPLEMENT_OBJCMD 0x008 /* (objc,objv) C implementation */
438 #define ITCL_IMPLEMENT_C 0x00c /* either kind of C implementation */
439
440 #define Itcl_IsMemberCodeImplemented(mcode) \
441 (((mcode)->flags & ITCL_IMPLEMENT_NONE) == 0)
442
443 /*
444 * Flag bits for ItclMember: functions and variables
445 */
446 #define ITCL_COMMON 0x010 /* non-zero => is a "proc" or common
447 * variable */
448
449 /*
450 * Flag bits for ItclMember: functions
451 */
452 #define ITCL_CONSTRUCTOR 0x020 /* non-zero => is a constructor */
453 #define ITCL_DESTRUCTOR 0x040 /* non-zero => is a destructor */
454 #define ITCL_ARG_SPEC 0x080 /* non-zero => has an argument spec */
455 #define ITCL_BODY_SPEC 0x100 /* non-zero => has an body spec */
456 #define ITCL_BUILTIN 0x400 /* non-zero => built-in method */
457 #define ITCL_COMPONENT 0x800 /* non-zero => component */
458 #define ITCL_TYPE_METHOD 0x1000 /* non-zero => typemethod */
459 #define ITCL_METHOD 0x2000 /* non-zero => method */
460
461 /*
462 * Flag bits for ItclMember: variables
463 */
464 #define ITCL_THIS_VAR 0x20 /* non-zero => built-in "this" variable */
465 #define ITCL_OPTIONS_VAR 0x40 /* non-zero => built-in "itcl_options"
466 * variable */
467 #define ITCL_TYPE_VAR 0x80 /* non-zero => built-in "type" variable */
468 /* no longer used ??? */
469 #define ITCL_SELF_VAR 0x100 /* non-zero => built-in "self" variable */
470 #define ITCL_SELFNS_VAR 0x200 /* non-zero => built-in "selfns"
471 * variable */
472 #define ITCL_WIN_VAR 0x400 /* non-zero => built-in "win" variable */
473 #define ITCL_COMPONENT_VAR 0x800 /* non-zero => component variable */
474 #define ITCL_HULL_VAR 0x1000 /* non-zero => built-in "itcl_hull"
475 * variable */
476 #define ITCL_OPTION_READONLY 0x2000 /* non-zero => readonly */
477 #define ITCL_VARIABLE 0x4000 /* non-zero => normal variable */
478 #define ITCL_TYPE_VARIABLE 0x8000 /* non-zero => typevariable */
479 #define ITCL_OPTION_INITTED 0x10000 /* non-zero => option has been initialized */
480 #define ITCL_OPTION_COMP_VAR 0x20000 /* variable to collect option components of extendedclass */
481
482 /*
483 * Instance components.
484 */
485 struct ItclVariable;
486 typedef struct ItclComponent {
487 Tcl_Obj *namePtr; /* member name */
488 struct ItclVariable *ivPtr; /* variable for this component */
489 int flags;
490 int haveKeptOptions;
491 Tcl_HashTable keptOptions; /* table of options to keep */
492 } ItclComponent;
493
494 #define ITCL_COMPONENT_INHERIT 0x01
495 #define ITCL_COMPONENT_PUBLIC 0x02
496
497 typedef struct ItclDelegatedFunction {
498 Tcl_Obj *namePtr;
499 ItclComponent *icPtr;
500 Tcl_Obj *asPtr;
501 Tcl_Obj *usingPtr;
502 Tcl_HashTable exceptions;
503 int flags;
504 } ItclDelegatedFunction;
505
506 /*
507 * Representation of member functions in an [incr Tcl] class.
508 */
509 typedef struct ItclMemberFunc {
510 Tcl_Obj* namePtr; /* member name */
511 Tcl_Obj* fullNamePtr; /* member name with "class::" qualifier */
512 ItclClass* iclsPtr; /* class containing this member */
513 int protection; /* protection level */
514 int flags; /* flags describing member (see above) */
515 ItclObjectInfo *infoPtr;
516 ItclMemberCode *codePtr; /* code associated with member */
517 Tcl_Command accessCmd; /* Tcl command installed for this function */
518 Tcl_Size argcount; /* number of args in arglist */
519 Tcl_Size maxargcount; /* max number of args in arglist */
520 Tcl_Obj *usagePtr; /* usage string for error messages */
521 Tcl_Obj *argumentPtr; /* the function arguments */
522 Tcl_Obj *builtinArgumentPtr; /* the function arguments for builtin functions */
523 Tcl_Obj *origArgsPtr; /* the argument string of the original definition */
524 Tcl_Obj *bodyPtr; /* the function body */
525 ItclArgList *argListPtr; /* the parsed arguments */
526 ItclClass *declaringClassPtr; /* the class which declared the method/proc */
527 void *tmPtr; /* TclOO methodPtr */
528 ItclDelegatedFunction *idmPtr;
529 /* if the function is delegated != NULL */
530 } ItclMemberFunc;
531
532 /*
533 * Instance variables.
534 */
535 typedef struct ItclVariable {
536 Tcl_Obj *namePtr; /* member name */
537 Tcl_Obj *fullNamePtr; /* member name with "class::" qualifier */
538 ItclClass *iclsPtr; /* class containing this member */
539 ItclObjectInfo *infoPtr;
540 ItclMemberCode *codePtr; /* code associated with member */
541 Tcl_Obj *init; /* initial value */
542 Tcl_Obj *arrayInitPtr; /* initial value if variable should be array */
543 int protection; /* protection level */
544 int flags; /* flags describing member (see below) */
545 int initted; /* is set when first time initted, to check
546 * for example itcl_hull var, which can be only
547 * initialized once */
548 } ItclVariable;
549
550
551 struct ItclOption;
552
553 typedef struct ItclDelegatedOption {
554 Tcl_Obj *namePtr;
555 Tcl_Obj *resourceNamePtr;
556 Tcl_Obj *classNamePtr;
557 struct ItclOption *ioptPtr; /* the option name or null for "*" */
558 ItclComponent *icPtr; /* the component where the delegation goes
559 * to */
560 Tcl_Obj *asPtr;
561 Tcl_HashTable exceptions; /* exceptions from delegation */
562 } ItclDelegatedOption;
563
564 /*
565 * Instance options.
566 */
567 typedef struct ItclOption {
568 /* within a class hierarchy there must be only
569 * one option with the same name !! */
570 Tcl_Obj *namePtr; /* member name */
571 Tcl_Obj *fullNamePtr; /* member name with "class::" qualifier */
572 Tcl_Obj *resourceNamePtr;
573 Tcl_Obj *classNamePtr;
574 ItclClass *iclsPtr; /* class containing this member */
575 int protection; /* protection level */
576 int flags; /* flags describing member (see below) */
577 ItclMemberCode *codePtr; /* code associated with member */
578 Tcl_Obj *defaultValuePtr; /* initial value */
579 Tcl_Obj *cgetMethodPtr;
580 Tcl_Obj *cgetMethodVarPtr;
581 Tcl_Obj *configureMethodPtr;
582 Tcl_Obj *configureMethodVarPtr;
583 Tcl_Obj *validateMethodPtr;
584 Tcl_Obj *validateMethodVarPtr;
585 ItclDelegatedOption *idoPtr;
586 /* if the option is delegated != NULL */
587 } ItclOption;
588
589 /*
590 * Instance methodvariables.
591 */
592 typedef struct ItclMethodVariable {
593 Tcl_Obj *namePtr; /* member name */
594 Tcl_Obj *fullNamePtr; /* member name with "class::" qualifier */
595 ItclClass *iclsPtr; /* class containing this member */
596 int protection; /* protection level */
597 int flags; /* flags describing member (see below) */
598 Tcl_Obj *defaultValuePtr;
599 Tcl_Obj *callbackPtr;
600 } ItclMethodVariable;
601
602 #define VAR_TYPE_VARIABLE 1
603 #define VAR_TYPE_COMMON 2
604
605 #define CMD_TYPE_METHOD 1
606 #define CMD_TYPE_PROC 2
607
608 typedef struct ItclClassCmdInfo {
609 int type;
610 int protection;
611 #if TCL_MAJOR_VERSION == 8
612 int cmdNum; /* not actually used */
613 #endif
614 Tcl_Namespace *nsPtr;
615 Tcl_Namespace *declaringNsPtr;
616 } ItclClassCmdInfo;
617
618 /*
619 * Instance variable lookup entry.
620 */
621 typedef struct ItclVarLookup {
622 ItclVariable* ivPtr; /* variable definition */
623 int usage; /* number of uses for this record */
624 int accessible; /* non-zero => accessible from class with
625 * this lookup record in its resolveVars */
626 char *leastQualName; /* simplist name for this variable, with
627 * the fewest qualifiers. This string is
628 * taken from the resolveVars table, so
629 * it shouldn't be freed. */
630 Tcl_Size varNum;
631 Tcl_Var varPtr;
632 } ItclVarLookup;
633
634 /*
635 * Instance command lookup entry.
636 */
637 typedef struct ItclCmdLookup {
638 ItclMemberFunc* imPtr; /* function definition */
639 #if TCL_MAJOR_VERSION == 8
640 int cmdNum; /* not actually used */
641 #endif
642 ItclClassCmdInfo *classCmdInfoPtr;
643 Tcl_Command cmdPtr;
644 } ItclCmdLookup;
645
646 typedef struct ItclCallContext {
647 int objectFlags;
648 Tcl_Namespace *nsPtr;
649 ItclObject *ioPtr;
650 ItclMemberFunc *imPtr;
651 Tcl_Size refCount;
652 } ItclCallContext;
653
654 /*
655 * The macro below is used to modify a "char" value (e.g. by casting
656 * it to an unsigned character) so that it can be used safely with
657 * macros such as isspace.
658 */
659
660 #define UCHAR(c) ((unsigned char) (c))
661 /*
662 * Macros used to cast between pointers and integers (e.g. when storing an int
663 * in ClientData), on 64-bit architectures they avoid gcc warning about "cast
664 * to/from pointer from/to integer of different size".
665 */
666
667 #if !defined(INT2PTR)
668 # define INT2PTR(p) ((void *)(ptrdiff_t)(p))
669 #endif
670 #if !defined(PTR2INT)
671 # define PTR2INT(p) ((ptrdiff_t)(p))
672 #endif
673
674 #ifdef ITCL_DEBUG
675 MODULE_SCOPE int _itcl_debug_level;
676 MODULE_SCOPE void ItclShowArgs(int level, const char *str, size_t objc,
677 Tcl_Obj *const *objv);
678 #else
679 #define ItclShowArgs(a,b,c,d) do {(void)(c);(void)(d);} while(0)
680 #endif
681
682 MODULE_SCOPE Tcl_ObjCmdProc ItclCallCCommand;
683 MODULE_SCOPE Tcl_ObjCmdProc ItclObjectUnknownCommand;
684 MODULE_SCOPE int ItclCheckCallProc(void *clientData, Tcl_Interp *interp,
685 Tcl_ObjectContext contextPtr, Tcl_CallFrame *framePtr, int *isFinished);
686
687 MODULE_SCOPE void ItclPreserveClass(ItclClass *iclsPtr);
688 MODULE_SCOPE void ItclReleaseClass(void *iclsPtr);
689
690 MODULE_SCOPE ItclFoundation *ItclGetFoundation(Tcl_Interp *interp);
691 MODULE_SCOPE Tcl_ObjCmdProc ItclClassCommandDispatcher;
692 MODULE_SCOPE Tcl_Command Itcl_CmdAliasProc(Tcl_Interp *interp,
693 Tcl_Namespace *nsPtr, const char *cmdName, void *clientData);
694 MODULE_SCOPE Tcl_Var Itcl_VarAliasProc(Tcl_Interp *interp,
695 Tcl_Namespace *nsPtr, const char *VarName, void *clientData);
696 MODULE_SCOPE int ItclIsClass(Tcl_Interp *interp, Tcl_Command cmd);
697 MODULE_SCOPE int ItclCheckCallMethod(void *clientData, Tcl_Interp *interp,
698 Tcl_ObjectContext contextPtr, Tcl_CallFrame *framePtr, int *isFinished);
699 MODULE_SCOPE int ItclAfterCallMethod(void *clientData, Tcl_Interp *interp,
700 Tcl_ObjectContext contextPtr, Tcl_Namespace *nsPtr, int result);
701 MODULE_SCOPE void ItclReportObjectUsage(Tcl_Interp *interp,
702 ItclObject *contextIoPtr, Tcl_Namespace *callerNsPtr,
703 Tcl_Namespace *contextNsPtr);
704 MODULE_SCOPE int ItclMapMethodNameProc(Tcl_Interp *interp, Tcl_Object oPtr,
705 Tcl_Class *startClsPtr, Tcl_Obj *methodObj);
706 MODULE_SCOPE int ItclCreateArgList(Tcl_Interp *interp, const char *str,
707 Tcl_Size *argcPtr, Tcl_Size *maxArgcPtr, Tcl_Obj **usagePtr,
708 ItclArgList **arglistPtrPtr, ItclMemberFunc *imPtr,
709 const char *commandName);
710 MODULE_SCOPE int ItclObjectCmd(void *clientData, Tcl_Interp *interp,
711 Tcl_Object oPtr, Tcl_Class clsPtr, size_t objc, Tcl_Obj *const *objv);
712 MODULE_SCOPE int ItclCreateObject (Tcl_Interp *interp, const char* name,
713 ItclClass *iclsPtr, size_t objc, Tcl_Obj *const objv[]);
714 MODULE_SCOPE void ItclDeleteObjectVariablesNamespace(Tcl_Interp *interp,
715 ItclObject *ioPtr);
716 MODULE_SCOPE void ItclDeleteClassVariablesNamespace(Tcl_Interp *interp,
717 ItclClass *iclsPtr);
718 MODULE_SCOPE int ItclInfoInit(Tcl_Interp *interp, ItclObjectInfo *infoPtr);
719
720 MODULE_SCOPE Tcl_HashEntry *ItclResolveVarEntry(
721 ItclClass* iclsPtr, const char *varName);
722
723 struct Tcl_ResolvedVarInfo;
724 MODULE_SCOPE int Itcl_ClassCmdResolver(Tcl_Interp *interp, const char* name,
725 Tcl_Namespace *nsPtr, int flags, Tcl_Command *rPtr);
726 MODULE_SCOPE int Itcl_ClassVarResolver(Tcl_Interp *interp, const char* name,
727 Tcl_Namespace *nsPtr, int flags, Tcl_Var *rPtr);
728 MODULE_SCOPE int Itcl_ClassCompiledVarResolver(Tcl_Interp *interp,
729 const char* name, Tcl_Size length, Tcl_Namespace *nsPtr,
730 struct Tcl_ResolvedVarInfo **rPtr);
731 MODULE_SCOPE int Itcl_ClassCmdResolver2(Tcl_Interp *interp, const char* name,
732 Tcl_Namespace *nsPtr, int flags, Tcl_Command *rPtr);
733 MODULE_SCOPE int Itcl_ClassVarResolver2(Tcl_Interp *interp, const char* name,
734 Tcl_Namespace *nsPtr, int flags, Tcl_Var *rPtr);
735 MODULE_SCOPE int ItclSetParserResolver(Tcl_Namespace *nsPtr);
736 MODULE_SCOPE void ItclProcErrorProc(Tcl_Interp *interp, Tcl_Obj *procNameObj);
737 MODULE_SCOPE int Itcl_CreateOption (Tcl_Interp *interp, ItclClass *iclsPtr,
738 ItclOption *ioptPtr);
739 MODULE_SCOPE int ItclCreateMethodVariable(Tcl_Interp *interp,
740 ItclVariable *ivPtr, Tcl_Obj* defaultPtr, Tcl_Obj* callbackPtr,
741 ItclMethodVariable** imvPtrPtr);
742 MODULE_SCOPE int DelegationInstall(Tcl_Interp *interp, ItclObject *ioPtr,
743 ItclClass *iclsPtr);
744 MODULE_SCOPE ItclClass *ItclNamespace2Class(Tcl_Namespace *nsPtr);
745 MODULE_SCOPE const char* ItclGetCommonInstanceVar(Tcl_Interp *interp,
746 const char *name, const char *name2, ItclObject *contextIoPtr,
747 ItclClass *contextIclsPtr);
748 MODULE_SCOPE int ItclCreateMethod(Tcl_Interp* interp, ItclClass *iclsPtr,
749 Tcl_Obj *namePtr, const char* arglist, const char* body,
750 ItclMemberFunc **imPtrPtr);
751 MODULE_SCOPE int Itcl_WidgetParseInit(Tcl_Interp *interp,
752 ItclObjectInfo *infoPtr);
753 MODULE_SCOPE void ItclDeleteObjectMetadata(void *clientData);
754 MODULE_SCOPE void ItclDeleteClassMetadata(void *clientData);
755 MODULE_SCOPE void ItclDeleteArgList(ItclArgList *arglistPtr);
756 MODULE_SCOPE int Itcl_ClassOptionCmd(void *clientData, Tcl_Interp *interp,
757 int objc, Tcl_Obj *const objv[]);
758 MODULE_SCOPE int DelegatedOptionsInstall(Tcl_Interp *interp,
759 ItclClass *iclsPtr);
760 MODULE_SCOPE int Itcl_HandleDelegateOptionCmd(Tcl_Interp *interp,
761 ItclObject *ioPtr, ItclClass *iclsPtr, ItclDelegatedOption **idoPtrPtr,
762 size_t objc, Tcl_Obj *const objv[]);
763 MODULE_SCOPE int Itcl_HandleDelegateMethodCmd(Tcl_Interp *interp,
764 ItclObject *ioPtr, ItclClass *iclsPtr,
765 ItclDelegatedFunction **idmPtrPtr, size_t objc, Tcl_Obj *const objv[]);
766 MODULE_SCOPE int DelegateFunction(Tcl_Interp *interp, ItclObject *ioPtr,
767 ItclClass *iclsPtr, Tcl_Obj *componentNamePtr,
768 ItclDelegatedFunction *idmPtr);
769 MODULE_SCOPE int ItclInitObjectMethodVariables(Tcl_Interp *interp,
770 ItclObject *ioPtr, ItclClass *iclsPtr, const char *name);
771 MODULE_SCOPE int InitTclOOFunctionPointers(Tcl_Interp *interp);
772 MODULE_SCOPE ItclOption* ItclNewOption(Tcl_Interp *interp, ItclObject *ioPtr,
773 ItclClass *iclsPtr, Tcl_Obj *namePtr, const char *resourceName,
774 const char *className, char *init, ItclMemberCode *mCodePtr);
775 MODULE_SCOPE int ItclParseOption(ItclObjectInfo *infoPtr, Tcl_Interp *interp,
776 size_t objc, Tcl_Obj *const objv[], ItclClass *iclsPtr,
777 ItclObject *ioPtr, ItclOption **ioptPtrPtr);
778 MODULE_SCOPE void ItclDestroyClassNamesp(void *cdata);
779 MODULE_SCOPE int ExpandDelegateAs(Tcl_Interp *interp, ItclObject *ioPtr,
780 ItclClass *iclsPtr, ItclDelegatedFunction *idmPtr,
781 const char *funcName, Tcl_Obj *listPtr);
782 MODULE_SCOPE int ItclCheckForInitializedComponents(Tcl_Interp *interp,
783 ItclClass *iclsPtr, ItclObject *ioPtr);
784 MODULE_SCOPE int ItclCreateDelegatedFunction(Tcl_Interp *interp,
785 ItclClass *iclsPtr, Tcl_Obj *methodNamePtr, ItclComponent *icPtr,
786 Tcl_Obj *targetPtr, Tcl_Obj *usingPtr, Tcl_Obj *exceptionsPtr,
787 ItclDelegatedFunction **idmPtrPtr);
788 MODULE_SCOPE void ItclDeleteDelegatedOption(char *cdata);
789 MODULE_SCOPE void Itcl_FinishList();
790 MODULE_SCOPE void ItclDeleteDelegatedFunction(ItclDelegatedFunction *idmPtr);
791 MODULE_SCOPE void ItclFinishEnsemble(ItclObjectInfo *infoPtr);
792 MODULE_SCOPE int Itcl_EnsembleDeleteCmd(void *clientData,
793 Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
794 MODULE_SCOPE int ItclAddClassesDictInfo(Tcl_Interp *interp, ItclClass *iclsPtr);
795 MODULE_SCOPE int ItclDeleteClassesDictInfo(Tcl_Interp *interp,
796 ItclClass *iclsPtr);
797 MODULE_SCOPE int ItclAddObjectsDictInfo(Tcl_Interp *interp, ItclObject *ioPtr);
798 MODULE_SCOPE int ItclDeleteObjectsDictInfo(Tcl_Interp *interp,
799 ItclObject *ioPtr);
800 MODULE_SCOPE int ItclAddOptionDictInfo(Tcl_Interp *interp, ItclClass *iclsPtr,
801 ItclOption *ioptPtr);
802 MODULE_SCOPE int ItclAddDelegatedOptionDictInfo(Tcl_Interp *interp,
803 ItclClass *iclsPtr, ItclDelegatedOption *idoPtr);
804 MODULE_SCOPE int ItclAddClassComponentDictInfo(Tcl_Interp *interp,
805 ItclClass *iclsPtr, ItclComponent *icPtr);
806 MODULE_SCOPE int ItclAddClassVariableDictInfo(Tcl_Interp *interp,
807 ItclClass *iclsPtr, ItclVariable *ivPtr);
808 MODULE_SCOPE int ItclAddClassFunctionDictInfo(Tcl_Interp *interp,
809 ItclClass *iclsPtr, ItclMemberFunc *imPtr);
810 MODULE_SCOPE int ItclAddClassDelegatedFunctionDictInfo(Tcl_Interp *interp,
811 ItclClass *iclsPtr, ItclDelegatedFunction *idmPtr);
812 MODULE_SCOPE int ItclClassCreateObject(void *clientData, Tcl_Interp *interp,
813 size_t objc, Tcl_Obj *const objv[]);
814
815 MODULE_SCOPE void ItclRestoreInfoVars(void *clientData);
816
817 MODULE_SCOPE Tcl_ObjCmdProc Itcl_BiMyProcCmd;
818 MODULE_SCOPE Tcl_ObjCmdProc Itcl_BiInstallComponentCmd;
819 MODULE_SCOPE Tcl_ObjCmdProc Itcl_BiCallInstanceCmd;
820 MODULE_SCOPE Tcl_ObjCmdProc Itcl_BiGetInstanceVarCmd;
821 MODULE_SCOPE Tcl_ObjCmdProc Itcl_BiMyTypeMethodCmd;
822 MODULE_SCOPE Tcl_ObjCmdProc Itcl_BiMyMethodCmd;
823 MODULE_SCOPE Tcl_ObjCmdProc Itcl_BiMyTypeVarCmd;
824 MODULE_SCOPE Tcl_ObjCmdProc Itcl_BiMyVarCmd;
825 MODULE_SCOPE Tcl_ObjCmdProc Itcl_BiItclHullCmd;
826 MODULE_SCOPE Tcl_ObjCmdProc Itcl_ThisCmd;
827 MODULE_SCOPE Tcl_ObjCmdProc Itcl_ExtendedClassCmd;
828 MODULE_SCOPE Tcl_ObjCmdProc Itcl_TypeClassCmd;
829 MODULE_SCOPE Tcl_ObjCmdProc Itcl_AddObjectOptionCmd;
830 MODULE_SCOPE Tcl_ObjCmdProc Itcl_AddDelegatedOptionCmd;
831 MODULE_SCOPE Tcl_ObjCmdProc Itcl_AddDelegatedFunctionCmd;
832 MODULE_SCOPE Tcl_ObjCmdProc Itcl_SetComponentCmd;
833 MODULE_SCOPE Tcl_ObjCmdProc Itcl_ClassHullTypeCmd;
834 MODULE_SCOPE Tcl_ObjCmdProc Itcl_ClassWidgetClassCmd;
835
836 typedef int (ItclRootMethodProc)(ItclObject *ioPtr, Tcl_Interp *interp,
837 int objc, Tcl_Obj *const objv[]);
838
839 MODULE_SCOPE const Tcl_MethodType itclRootMethodType;
840 MODULE_SCOPE ItclRootMethodProc ItclUnknownGuts;
841 MODULE_SCOPE ItclRootMethodProc ItclConstructGuts;
842 MODULE_SCOPE ItclRootMethodProc ItclInfoGuts;
843
844 #include "itcl2TclOO.h"
845
846 /*
847 * Include all the private API, generated from itcl.decls.
848 */
849
850 #include "itclIntDecls.h"