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