Back to home page

EIC code displayed by LXR

 
 

    


File indexing completed on 2024-05-18 08:30:03

0001 /*
0002  * itclInt.h --
0003  *
0004  * This file contains internal definitions for the C-implemented part of a
0005  * Itcl
0006  *
0007  * Copyright (c) 2007 by Arnulf P. Wiedemann
0008  *
0009  * See the file "license.terms" for information on usage and redistribution of
0010  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
0011  */
0012 
0013 #ifdef HAVE_UNISTD_H
0014 #include <unistd.h>
0015 #endif
0016 #ifdef HAVE_STDINT_H
0017 #include <stdint.h>
0018 #endif
0019 
0020 /*
0021  * Used to tag functions that are only to be visible within the module being
0022  * built and not outside it (where this is supported by the linker).
0023  */
0024 
0025 #ifndef MODULE_SCOPE
0026 #   ifdef __cplusplus
0027 #       define MODULE_SCOPE extern "C"
0028 #   else
0029 #       define MODULE_SCOPE extern
0030 #   endif
0031 #endif
0032 
0033 #include <string.h>
0034 #include <ctype.h>
0035 #include <tclOO.h>
0036 #include "itcl.h"
0037 #include "itclMigrate2TclCore.h"
0038 #include "itclTclIntStubsFcn.h"
0039 
0040 /*
0041  * Utility macros: STRINGIFY takes an argument and wraps it in "" (double
0042  * quotation marks).
0043  */
0044 
0045 #ifndef STRINGIFY
0046 #  define STRINGIFY(x) STRINGIFY1(x)
0047 #  define STRINGIFY1(x) #x
0048 #endif
0049 
0050 /*
0051  * MSVC 8.0 started to mark many standard C library functions depreciated
0052  * including the *printf family and others. Tell it to shut up.
0053  * (_MSC_VER is 1200 for VC6, 1300 or 1310 for vc7.net, 1400 for 8.0)
0054  */
0055 #if defined(_MSC_VER)
0056 #   pragma warning(disable:4244)
0057 #   if _MSC_VER >= 1400
0058 #   pragma warning(disable:4267)
0059 #   pragma warning(disable:4996)
0060 #   endif
0061 #endif
0062 
0063 #ifndef JOIN
0064 #  define JOIN(a,b) JOIN1(a,b)
0065 #  define JOIN1(a,b) a##b
0066 #endif
0067 
0068 #ifndef TCL_UNUSED
0069 #   if defined(__cplusplus)
0070 #   define TCL_UNUSED(T) T
0071 #   else
0072 #   define TCL_UNUSED(T) T JOIN(dummy, __LINE__)
0073 #   endif
0074 #endif
0075 
0076 /*
0077  * Since the Tcl/Tk distribution doesn't perform any asserts,
0078  * dynamic loading can fail to find the __assert function.
0079  * As a workaround, we'll include our own.
0080  */
0081 
0082 #undef  assert
0083 #if defined(NDEBUG) && !defined(DEBUG)
0084 #define assert(EX) ((void)0)
0085 #else /* !NDEBUG || DEBUG */
0086 #define assert(EX) (void)((EX) || (Itcl_Assert(STRINGIFY(EX), __FILE__, __LINE__), 0))
0087 #endif
0088 
0089 #define ITCL_INTERP_DATA "itcl_data"
0090 #define ITCL_TK_VERSION "8.6"
0091 
0092 /*
0093  * Convenience macros for iterating through hash tables. FOREACH_HASH_DECLS
0094  * sets up the declarations needed for the main macro, FOREACH_HASH, which
0095  * does the actual iteration. FOREACH_HASH_VALUE is a restricted version that
0096  * only iterates over values.
0097  */
0098 
0099 #define FOREACH_HASH_DECLS \
0100     Tcl_HashEntry *hPtr;Tcl_HashSearch search
0101 #define FOREACH_HASH(key,val,tablePtr) \
0102     for(hPtr=Tcl_FirstHashEntry((tablePtr),&search); hPtr!=NULL ? \
0103         (*(void **)&(key)=Tcl_GetHashKey((tablePtr),hPtr),\
0104         *(void **)&(val)=Tcl_GetHashValue(hPtr),1):0; hPtr=Tcl_NextHashEntry(&search))
0105 #define FOREACH_HASH_VALUE(val,tablePtr) \
0106     for(hPtr=Tcl_FirstHashEntry((tablePtr),&search); hPtr!=NULL ? \
0107         (*(void **)&(val)=Tcl_GetHashValue(hPtr),1):0;hPtr=Tcl_NextHashEntry(&search))
0108 
0109 /*
0110  * What sort of size of things we like to allocate.
0111  */
0112 
0113 #define ALLOC_CHUNK 8
0114 
0115 #define ITCL_INT_NAMESPACE      ITCL_NAMESPACE"::internal"
0116 #define ITCL_INTDICTS_NAMESPACE     ITCL_INT_NAMESPACE"::dicts"
0117 #define ITCL_VARIABLES_NAMESPACE    ITCL_INT_NAMESPACE"::variables"
0118 #define ITCL_COMMANDS_NAMESPACE     ITCL_INT_NAMESPACE"::commands"
0119 
0120 typedef struct ItclFoundation {
0121     Itcl_Stack methodCallStack;
0122     Tcl_Command dispatchCommand;
0123 } ItclFoundation;
0124 
0125 typedef struct ItclArgList {
0126     struct ItclArgList *nextPtr;        /* pointer to next argument */
0127     Tcl_Obj *namePtr;           /* name of the argument */
0128     Tcl_Obj *defaultValuePtr;   /* default value or NULL if none */
0129 } ItclArgList;
0130 
0131 /*
0132  *  Common info for managing all known objects.
0133  *  Each interpreter has one of these data structures stored as
0134  *  clientData in the "itcl" namespace.  It is also accessible
0135  *  as associated data via the key ITCL_INTERP_DATA.
0136  */
0137 struct ItclClass;
0138 struct ItclObject;
0139 struct ItclMemberFunc;
0140 struct EnsembleInfo;
0141 struct ItclDelegatedOption;
0142 struct ItclDelegatedFunction;
0143 
0144 typedef struct ItclObjectInfo {
0145     Tcl_Interp *interp;             /* interpreter that manages this info */
0146     Tcl_HashTable objects;          /* list of all known objects key is
0147                                      * ioPtr */
0148     Tcl_HashTable objectCmds;       /* list of known objects using accessCmd */
0149     Tcl_HashTable unused5;          /* list of known objects using namePtr */
0150     Tcl_HashTable classes;          /* list of all known classes,
0151                                      * key is iclsPtr */
0152     Tcl_HashTable nameClasses;      /* maps from fullNamePtr to iclsPtr */
0153     Tcl_HashTable namespaceClasses; /* maps from nsPtr to iclsPtr */
0154     Tcl_HashTable procMethods;      /* maps from procPtr to mFunc */
0155     Tcl_HashTable instances;        /* maps from instanceNumber to ioPtr */
0156     Tcl_HashTable unused8;          /* maps from ioPtr to instanceNumber */
0157     Tcl_HashTable frameContext;     /* maps frame to context stack */
0158     Tcl_HashTable classTypes;       /* maps from class type i.e. "widget"
0159                                      * to define value i.e. ITCL_WIDGET */
0160     int protection;                 /* protection level currently in effect */
0161     int useOldResolvers;            /* whether to use the "old" style
0162                                      * resolvers or the CallFrame resolvers */
0163     Itcl_Stack clsStack;            /* stack of class definitions currently
0164                                      * being parsed */
0165     Itcl_Stack unused;              /* Removed */
0166     Itcl_Stack unused6;         /* obsolete field */
0167     struct ItclObject *currIoPtr;   /* object currently being constructed
0168                                      * set only during calling of constructors
0169                      * otherwise NULL */
0170     Tcl_ObjectMetadataType *class_meta_type;
0171                                     /* type for getting the Itcl class info
0172                                      * from a TclOO Tcl_Object */
0173     const Tcl_ObjectMetadataType *object_meta_type;
0174                                     /* type for getting the Itcl object info
0175                                      * from a TclOO Tcl_Object */
0176     Tcl_Object clazzObjectPtr;      /* the root object of Itcl */
0177     Tcl_Class clazzClassPtr;        /* the root class of Itcl */
0178     struct EnsembleInfo *ensembleInfo;
0179     struct ItclClass *currContextIclsPtr;
0180                                     /* context class for delegated option
0181                                      * handling */
0182     int currClassFlags;             /* flags for the class just in creation */
0183     int buildingWidget;             /* set if in construction of a widget */
0184     int unparsedObjc;               /* number options not parsed by
0185                                        ItclExtendedConfigure/-Cget function */
0186     Tcl_Obj **unparsedObjv;         /* options not parsed by
0187                                        ItclExtendedConfigure/-Cget function */
0188     int functionFlags;              /* used for creating of ItclMemberCode */
0189     int unused7;
0190     struct ItclDelegatedOption *currIdoPtr;
0191                                     /* the current delegated option info */
0192     int inOptionHandling;           /* used to indicate for type/widget ...
0193                                      * that there is an option processing
0194                      * and methods are allowed to be called */
0195             /* these are the Tcl_Obj Ptrs for the clazz unknown procedure */
0196         /* need to store them to be able to free them at the end */
0197     int itclWidgetInitted;          /* set to 1 if itclWidget.tcl has already
0198                                      * been called
0199                      */
0200     int itclHullCmdsInitted;        /* set to 1 if itclHullCmds.tcl has already
0201                                      * been called
0202                      */
0203     Tcl_Obj *unused2;
0204     Tcl_Obj *unused3;
0205     Tcl_Obj *unused4;
0206     Tcl_Obj *infoVarsPtr;
0207     Tcl_Obj *unused9;
0208     Tcl_Obj *infoVars4Ptr;
0209     Tcl_Obj *typeDestructorArgumentPtr;
0210     struct ItclObject *lastIoPtr;   /* last object constructed */
0211     Tcl_Command infoCmd;
0212 } ItclObjectInfo;
0213 
0214 typedef struct EnsembleInfo {
0215     Tcl_HashTable ensembles;        /* list of all known ensembles */
0216     Tcl_HashTable subEnsembles;     /* list of all known subensembles */
0217     int numEnsembles;
0218     Tcl_Namespace *ensembleNsPtr;
0219 } EnsembleInfo;
0220 /*
0221  *  Representation for each [incr Tcl] class.
0222  */
0223 #define ITCL_CLASS                    0x1
0224 #define ITCL_TYPE                     0x2
0225 #define ITCL_WIDGET                   0x4
0226 #define ITCL_WIDGETADAPTOR                0x8
0227 #define ITCL_ECLASS                  0x10
0228 #define ITCL_NWIDGET                     0x20
0229 #define ITCL_WIDGET_FRAME                0x40
0230 #define ITCL_WIDGET_LABEL_FRAME              0x80
0231 #define ITCL_WIDGET_TOPLEVEL                0x100
0232 #define ITCL_WIDGET_TTK_FRAME               0x200
0233 #define ITCL_WIDGET_TTK_LABEL_FRAME     0x400
0234 #define ITCL_WIDGET_TTK_TOPLEVEL            0x800
0235 #define ITCL_CLASS_IS_DELETED              0x1000
0236 #define ITCL_CLASS_IS_DESTROYED            0x2000
0237 #define ITCL_CLASS_NS_IS_DESTROYED         0x4000
0238 #define ITCL_CLASS_IS_RENAMED              0x8000 /* unused */
0239 #define ITCL_CLASS_IS_FREED               0x10000
0240 #define ITCL_CLASS_DERIVED_RELEASED       0x20000
0241 #define ITCL_CLASS_NS_TEARDOWN            0x40000
0242 #define ITCL_CLASS_NO_VARNS_DELETE        0x80000
0243 #define ITCL_CLASS_SHOULD_VARNS_DELETE   0x100000
0244 #define ITCL_CLASS_DESTRUCTOR_CALLED     0x400000
0245 
0246 
0247 typedef struct ItclClass {
0248     Tcl_Obj *namePtr;             /* class name */
0249     Tcl_Obj *fullNamePtr;         /* fully qualified class name */
0250     Tcl_Interp *interp;           /* interpreter that manages this info */
0251     Tcl_Namespace *nsPtr;         /* namespace representing class scope */
0252     Tcl_Command accessCmd;        /* access command for creating instances */
0253     Tcl_Command thisCmd;          /* needed for deletion of class */
0254 
0255     struct ItclObjectInfo *infoPtr;
0256                                   /* info about all known objects
0257                    * and other stuff like stacks */
0258     Itcl_List bases;              /* list of base classes */
0259     Itcl_List derived;            /* list of all derived classes */
0260     Tcl_HashTable heritage;       /* table of all base classes.  Look up
0261                                    * by pointer to class definition.  This
0262                                    * provides fast lookup for inheritance
0263                                    * tests. */
0264     Tcl_Obj *initCode;            /* initialization code for new objs */
0265     Tcl_HashTable variables;      /* definitions for all data members
0266                                      in this class.  Look up simple string
0267                                      names and get back ItclVariable* ptrs */
0268     Tcl_HashTable options;        /* definitions for all option members
0269                                      in this class.  Look up simple string
0270                                      names and get back ItclOption* ptrs */
0271     Tcl_HashTable components;     /* definitions for all component members
0272                                      in this class.  Look up simple string
0273                                      names and get back ItclComponent* ptrs */
0274     Tcl_HashTable functions;      /* definitions for all member functions
0275                                      in this class.  Look up simple string
0276                                      names and get back ItclMemberFunc* ptrs */
0277     Tcl_HashTable delegatedOptions; /* definitions for all delegated options
0278                                      in this class.  Look up simple string
0279                                      names and get back
0280                      ItclDelegatedOption * ptrs */
0281     Tcl_HashTable delegatedFunctions; /* definitions for all delegated methods
0282                                      or procs in this class.  Look up simple
0283                      string names and get back
0284                      ItclDelegatedFunction * ptrs */
0285     Tcl_HashTable methodVariables; /* definitions for all methodvariable members
0286                                      in this class.  Look up simple string
0287                                      names and get back
0288                      ItclMethodVariable* ptrs */
0289     int numInstanceVars;          /* number of instance vars in variables
0290                                      table */
0291     Tcl_HashTable classCommons;   /* used for storing variable namespace
0292                                    * string for Tcl_Resolve */
0293     Tcl_HashTable resolveVars;    /* all possible names for variables in
0294                                    * this class (e.g., x, foo::x, etc.) */
0295     Tcl_HashTable resolveCmds;    /* all possible names for functions in
0296                                    * this class (e.g., x, foo::x, etc.) */
0297     Tcl_HashTable contextCache;   /* cache for function contexts */
0298     struct ItclMemberFunc *unused2;
0299                                   /* the class constructor or NULL */
0300     struct ItclMemberFunc *unused3;
0301                                   /* the class destructor or NULL */
0302     struct ItclMemberFunc *unused1;
0303     Tcl_Resolve *resolvePtr;
0304     Tcl_Obj *widgetClassPtr;      /* class name for widget if class is a
0305                                    * ::itcl::widget */
0306     Tcl_Obj *hullTypePtr;         /* hulltype name for widget if class is a
0307                                    * ::itcl::widget */
0308     Tcl_Object oPtr;          /* TclOO class object */
0309     Tcl_Class  clsPtr;            /* TclOO class */
0310     int numCommons;               /* number of commons in this class */
0311     int numVariables;             /* number of variables in this class */
0312     int numOptions;               /* number of options in this class */
0313     int unique;                   /* unique number for #auto generation */
0314     int flags;                    /* maintains class status */
0315     int callRefCount;             /* prevent deleting of class if refcount>1 */
0316     Tcl_Obj *typeConstructorPtr;  /* initialization for types */
0317     int destructorHasBeenCalled;  /* prevent multiple invocations of destrcutor */
0318     int refCount;
0319 } ItclClass;
0320 
0321 typedef struct ItclHierIter {
0322     ItclClass *current;           /* current position in hierarchy */
0323     Itcl_Stack stack;             /* stack used for traversal */
0324 } ItclHierIter;
0325 
0326 #define ITCL_OBJECT_IS_DELETED           0x01
0327 #define ITCL_OBJECT_IS_DESTRUCTED        0x02
0328 #define ITCL_OBJECT_IS_DESTROYED         0x04
0329 #define ITCL_OBJECT_IS_RENAMED           0x08
0330 #define ITCL_OBJECT_CLASS_DESTRUCTED     0x10
0331 #define ITCL_TCLOO_OBJECT_IS_DELETED     0x20
0332 #define ITCL_OBJECT_DESTRUCT_ERROR       0x40
0333 #define ITCL_OBJECT_SHOULD_VARNS_DELETE  0x80
0334 #define ITCL_OBJECT_ROOT_METHOD          0x8000
0335 
0336 /*
0337  *  Representation for each [incr Tcl] object.
0338  */
0339 typedef struct ItclObject {
0340     ItclClass *iclsPtr;          /* most-specific class */
0341     Tcl_Command accessCmd;       /* object access command */
0342 
0343     Tcl_HashTable* constructed;  /* temp storage used during construction */
0344     Tcl_HashTable* destructed;   /* temp storage used during destruction */
0345     Tcl_HashTable objectVariables;
0346                                  /* used for storing Tcl_Var entries for
0347                   * variable resolving, key is ivPtr of
0348                   * variable, value is varPtr */
0349     Tcl_HashTable objectOptions; /* definitions for all option members
0350                                      in this object. Look up option namePtr
0351                                      names and get back ItclOption* ptrs */
0352     Tcl_HashTable objectComponents; /* definitions for all component members
0353                                      in this object. Look up component namePtr
0354                                      names and get back ItclComponent* ptrs */
0355     Tcl_HashTable objectMethodVariables;
0356                                  /* definitions for all methodvariable members
0357                                      in this object. Look up methodvariable
0358                      namePtr names and get back
0359                      ItclMethodVariable* ptrs */
0360     Tcl_HashTable objectDelegatedOptions;
0361                                   /* definitions for all delegated option
0362                      members in this object. Look up option
0363                      namePtr names and get back
0364                      ItclOption* ptrs */
0365     Tcl_HashTable objectDelegatedFunctions;
0366                                   /* definitions for all delegated function
0367                      members in this object. Look up function
0368                      namePtr names and get back
0369                      ItclMemberFunc * ptrs */
0370     Tcl_HashTable contextCache;   /* cache for function contexts */
0371     Tcl_Obj *namePtr;
0372     Tcl_Obj *origNamePtr;         /* the original name before any rename */
0373     Tcl_Obj *createNamePtr;       /* the temp name before any rename
0374                                    * mostly used for widgetadaptor
0375                    * because that hijackes the name
0376                    * often when installing the hull */
0377     Tcl_Interp *interp;
0378     ItclObjectInfo *infoPtr;
0379     Tcl_Obj *varNsNamePtr;
0380     Tcl_Object oPtr;             /* the TclOO object */
0381     Tcl_Resolve *resolvePtr;
0382     int flags;
0383     int callRefCount;             /* prevent deleting of object if refcount > 1 */
0384     Tcl_Obj *hullWindowNamePtr;   /* the window path name for the hull
0385                                    * (before renaming in installhull) */
0386     int destructorHasBeenCalled;  /* is set when the destructor is called
0387                                    * to avoid callin destructor twice */
0388     int noComponentTrace;         /* don't call component traces if
0389                                    * setting components in DelegationInstall */
0390     int hadConstructorError;      /* needed for multiple calls of CallItclObjectCmd */
0391 } ItclObject;
0392 
0393 #define ITCL_IGNORE_ERRS  0x002  /* useful for construction/destruction */
0394 
0395 typedef struct ItclResolveInfo {
0396     int flags;
0397     ItclClass *iclsPtr;
0398     ItclObject *ioPtr;
0399 } ItclResolveInfo;
0400 
0401 #define ITCL_RESOLVE_CLASS      0x01
0402 #define ITCL_RESOLVE_OBJECT     0x02
0403 
0404 /*
0405  *  Implementation for any code body in an [incr Tcl] class.
0406  */
0407 typedef struct ItclMemberCode {
0408     int flags;                  /* flags describing implementation */
0409     int argcount;               /* number of args in arglist */
0410     int maxargcount;            /* max number of args in arglist */
0411     Tcl_Obj *usagePtr;          /* usage string for error messages */
0412     Tcl_Obj *argumentPtr;       /* the function arguments */
0413     Tcl_Obj *bodyPtr;           /* the function body */
0414     ItclArgList *argListPtr;    /* the parsed arguments */
0415     union {
0416         Tcl_CmdProc *argCmd;    /* (argc,argv) C implementation */
0417         Tcl_ObjCmdProc *objCmd; /* (objc,objv) C implementation */
0418     } cfunc;
0419     ClientData clientData;      /* client data for C implementations */
0420 } ItclMemberCode;
0421 
0422 /*
0423  *  Flag bits for ItclMemberCode:
0424  */
0425 #define ITCL_IMPLEMENT_NONE    0x001  /* no implementation */
0426 #define ITCL_IMPLEMENT_TCL     0x002  /* Tcl implementation */
0427 #define ITCL_IMPLEMENT_ARGCMD  0x004  /* (argc,argv) C implementation */
0428 #define ITCL_IMPLEMENT_OBJCMD  0x008  /* (objc,objv) C implementation */
0429 #define ITCL_IMPLEMENT_C       0x00c  /* either kind of C implementation */
0430 
0431 #define Itcl_IsMemberCodeImplemented(mcode) \
0432     (((mcode)->flags & ITCL_IMPLEMENT_NONE) == 0)
0433 
0434 /*
0435  *  Flag bits for ItclMember: functions and variables
0436  */
0437 #define ITCL_COMMON            0x010  /* non-zero => is a "proc" or common
0438                                        * variable */
0439 
0440 /*
0441  *  Flag bits for ItclMember: functions
0442  */
0443 #define ITCL_CONSTRUCTOR       0x020  /* non-zero => is a constructor */
0444 #define ITCL_DESTRUCTOR        0x040  /* non-zero => is a destructor */
0445 #define ITCL_ARG_SPEC          0x080  /* non-zero => has an argument spec */
0446 #define ITCL_BODY_SPEC         0x100  /* non-zero => has an body spec */
0447 #define ITCL_BUILTIN           0x400  /* non-zero => built-in method */
0448 #define ITCL_COMPONENT         0x800  /* non-zero => component */
0449 #define ITCL_TYPE_METHOD       0x1000 /* non-zero => typemethod */
0450 #define ITCL_METHOD            0x2000 /* non-zero => method */
0451 
0452 /*
0453  *  Flag bits for ItclMember: variables
0454  */
0455 #define ITCL_THIS_VAR          0x20   /* non-zero => built-in "this" variable */
0456 #define ITCL_OPTIONS_VAR       0x40   /* non-zero => built-in "itcl_options"
0457                                        * variable */
0458 #define ITCL_TYPE_VAR          0x80   /* non-zero => built-in "type" variable */
0459                                       /* no longer used ??? */
0460 #define ITCL_SELF_VAR          0x100  /* non-zero => built-in "self" variable */
0461 #define ITCL_SELFNS_VAR        0x200  /* non-zero => built-in "selfns"
0462                                        * variable */
0463 #define ITCL_WIN_VAR           0x400  /* non-zero => built-in "win" variable */
0464 #define ITCL_COMPONENT_VAR     0x800  /* non-zero => component variable */
0465 #define ITCL_HULL_VAR          0x1000 /* non-zero => built-in "itcl_hull"
0466                                        * variable */
0467 #define ITCL_OPTION_READONLY   0x2000 /* non-zero => readonly */
0468 #define ITCL_VARIABLE          0x4000 /* non-zero => normal variable */
0469 #define ITCL_TYPE_VARIABLE     0x8000 /* non-zero => typevariable */
0470 #define ITCL_OPTION_INITTED    0x10000 /* non-zero => option has been initialized */
0471 #define ITCL_OPTION_COMP_VAR   0x20000 /* variable to collect option components of extendedclass  */
0472 
0473 /*
0474  *  Instance components.
0475  */
0476 struct ItclVariable;
0477 typedef struct ItclComponent {
0478     Tcl_Obj *namePtr;           /* member name */
0479     struct ItclVariable *ivPtr; /* variable for this component */
0480     int flags;
0481     int haveKeptOptions;
0482     Tcl_HashTable keptOptions;  /* table of options to keep */
0483 } ItclComponent;
0484 
0485 #define ITCL_COMPONENT_INHERIT  0x01
0486 #define ITCL_COMPONENT_PUBLIC   0x02
0487 
0488 typedef struct ItclDelegatedFunction {
0489     Tcl_Obj *namePtr;
0490     ItclComponent *icPtr;
0491     Tcl_Obj *asPtr;
0492     Tcl_Obj *usingPtr;
0493     Tcl_HashTable exceptions;
0494     int flags;
0495 } ItclDelegatedFunction;
0496 
0497 /*
0498  *  Representation of member functions in an [incr Tcl] class.
0499  */
0500 typedef struct ItclMemberFunc {
0501     Tcl_Obj* namePtr;           /* member name */
0502     Tcl_Obj* fullNamePtr;       /* member name with "class::" qualifier */
0503     ItclClass* iclsPtr;         /* class containing this member */
0504     int protection;             /* protection level */
0505     int flags;                  /* flags describing member (see above) */
0506     ItclObjectInfo *infoPtr;
0507     ItclMemberCode *codePtr;    /* code associated with member */
0508     Tcl_Command accessCmd;       /* Tcl command installed for this function */
0509     int argcount;                /* number of args in arglist */
0510     int maxargcount;             /* max number of args in arglist */
0511     Tcl_Obj *usagePtr;          /* usage string for error messages */
0512     Tcl_Obj *argumentPtr;       /* the function arguments */
0513     Tcl_Obj *builtinArgumentPtr; /* the function arguments for builtin functions */
0514     Tcl_Obj *origArgsPtr;       /* the argument string of the original definition */
0515     Tcl_Obj *bodyPtr;           /* the function body */
0516     ItclArgList *argListPtr;    /* the parsed arguments */
0517     ItclClass *declaringClassPtr; /* the class which declared the method/proc */
0518     ClientData tmPtr;           /* TclOO methodPtr */
0519     ItclDelegatedFunction *idmPtr;
0520                                 /* if the function is delegated != NULL */
0521 } ItclMemberFunc;
0522 
0523 /*
0524  *  Instance variables.
0525  */
0526 typedef struct ItclVariable {
0527     Tcl_Obj *namePtr;           /* member name */
0528     Tcl_Obj *fullNamePtr;       /* member name with "class::" qualifier */
0529     ItclClass *iclsPtr;         /* class containing this member */
0530     ItclObjectInfo *infoPtr;
0531     ItclMemberCode *codePtr;    /* code associated with member */
0532     Tcl_Obj *init;              /* initial value */
0533     Tcl_Obj *arrayInitPtr;      /* initial value if variable should be array */
0534     int protection;             /* protection level */
0535     int flags;                  /* flags describing member (see below) */
0536     int initted;                /* is set when first time initted, to check
0537                                  * for example itcl_hull var, which can be only
0538                  * initialized once */
0539 } ItclVariable;
0540 
0541 
0542 struct ItclOption;
0543 
0544 typedef struct ItclDelegatedOption {
0545     Tcl_Obj *namePtr;
0546     Tcl_Obj *resourceNamePtr;
0547     Tcl_Obj *classNamePtr;
0548     struct ItclOption *ioptPtr;  /* the option name or null for "*" */
0549     ItclComponent *icPtr;        /* the component where the delegation goes
0550                                   * to */
0551     Tcl_Obj *asPtr;
0552     Tcl_HashTable exceptions;    /* exceptions from delegation */
0553 } ItclDelegatedOption;
0554 
0555 /*
0556  *  Instance options.
0557  */
0558 typedef struct ItclOption {
0559                                 /* within a class hierarchy there must be only
0560                  * one option with the same name !! */
0561     Tcl_Obj *namePtr;           /* member name */
0562     Tcl_Obj *fullNamePtr;       /* member name with "class::" qualifier */
0563     Tcl_Obj *resourceNamePtr;
0564     Tcl_Obj *classNamePtr;
0565     ItclClass *iclsPtr;         /* class containing this member */
0566     int protection;             /* protection level */
0567     int flags;                  /* flags describing member (see below) */
0568     ItclMemberCode *codePtr;    /* code associated with member */
0569     Tcl_Obj *defaultValuePtr;   /* initial value */
0570     Tcl_Obj *cgetMethodPtr;
0571     Tcl_Obj *cgetMethodVarPtr;
0572     Tcl_Obj *configureMethodPtr;
0573     Tcl_Obj *configureMethodVarPtr;
0574     Tcl_Obj *validateMethodPtr;
0575     Tcl_Obj *validateMethodVarPtr;
0576     ItclDelegatedOption *idoPtr;
0577                                 /* if the option is delegated != NULL */
0578 } ItclOption;
0579 
0580 /*
0581  *  Instance methodvariables.
0582  */
0583 typedef struct ItclMethodVariable {
0584     Tcl_Obj *namePtr;           /* member name */
0585     Tcl_Obj *fullNamePtr;       /* member name with "class::" qualifier */
0586     ItclClass *iclsPtr;         /* class containing this member */
0587     int protection;             /* protection level */
0588     int flags;                  /* flags describing member (see below) */
0589     Tcl_Obj *defaultValuePtr;
0590     Tcl_Obj *callbackPtr;
0591 } ItclMethodVariable;
0592 
0593 #define VAR_TYPE_VARIABLE   1
0594 #define VAR_TYPE_COMMON     2
0595 
0596 #define CMD_TYPE_METHOD     1
0597 #define CMD_TYPE_PROC       2
0598 
0599 typedef struct ItclClassCmdInfo {
0600     int type;
0601     int protection;
0602     int cmdNum;
0603     Tcl_Namespace *nsPtr;
0604     Tcl_Namespace *declaringNsPtr;
0605 } ItclClassCmdInfo;
0606 
0607 /*
0608  *  Instance variable lookup entry.
0609  */
0610 typedef struct ItclVarLookup {
0611     ItclVariable* ivPtr;      /* variable definition */
0612     int usage;                /* number of uses for this record */
0613     int accessible;           /* non-zero => accessible from class with
0614                                * this lookup record in its resolveVars */
0615     char *leastQualName;      /* simplist name for this variable, with
0616                                * the fewest qualifiers.  This string is
0617                                * taken from the resolveVars table, so
0618                                * it shouldn't be freed. */
0619     int varNum;
0620     Tcl_Var varPtr;
0621 } ItclVarLookup;
0622 
0623 /*
0624  *  Instance command lookup entry.
0625  */
0626 typedef struct ItclCmdLookup {
0627     ItclMemberFunc* imPtr;    /* function definition */
0628     int cmdNum;
0629     ItclClassCmdInfo *classCmdInfoPtr;
0630     Tcl_Command cmdPtr;
0631 } ItclCmdLookup;
0632 
0633 typedef struct ItclCallContext {
0634     int objectFlags;
0635     Tcl_Namespace *nsPtr;
0636     ItclObject *ioPtr;
0637     ItclMemberFunc *imPtr;
0638     int refCount;
0639 } ItclCallContext;
0640 
0641 /*
0642  * The macro below is used to modify a "char" value (e.g. by casting
0643  * it to an unsigned character) so that it can be used safely with
0644  * macros such as isspace.
0645  */
0646 
0647 #define UCHAR(c) ((unsigned char) (c))
0648 /*
0649  * Macros used to cast between pointers and integers (e.g. when storing an int
0650  * in ClientData), on 64-bit architectures they avoid gcc warning about "cast
0651  * to/from pointer from/to integer of different size".
0652  */
0653 
0654 #if !defined(INT2PTR) && !defined(PTR2INT)
0655 #   if defined(HAVE_INTPTR_T) || defined(intptr_t)
0656 #       define INT2PTR(p) ((void*)(intptr_t)(p))
0657 #       define PTR2INT(p) ((int)(intptr_t)(p))
0658 #   else
0659 #       define INT2PTR(p) ((void*)(p))
0660 #       define PTR2INT(p) ((int)(p))
0661 #   endif
0662 #endif
0663 
0664 #ifdef ITCL_DEBUG
0665 MODULE_SCOPE int _itcl_debug_level;
0666 MODULE_SCOPE void ItclShowArgs(int level, const char *str, int objc,
0667     Tcl_Obj * const* objv);
0668 #else
0669 #define ItclShowArgs(a,b,c,d) do {(void)(c);(void)(d);} while(0)
0670 #endif
0671 
0672 MODULE_SCOPE Tcl_ObjCmdProc ItclCallCCommand;
0673 MODULE_SCOPE Tcl_ObjCmdProc ItclObjectUnknownCommand;
0674 MODULE_SCOPE int ItclCheckCallProc(ClientData clientData, Tcl_Interp *interp,
0675         Tcl_ObjectContext contextPtr, Tcl_CallFrame *framePtr, int *isFinished);
0676 
0677 MODULE_SCOPE void ItclPreserveClass(ItclClass *iclsPtr);
0678 MODULE_SCOPE void ItclReleaseClass(ClientData iclsPtr);
0679 
0680 MODULE_SCOPE ItclFoundation *ItclGetFoundation(Tcl_Interp *interp);
0681 MODULE_SCOPE Tcl_ObjCmdProc ItclClassCommandDispatcher;
0682 MODULE_SCOPE Tcl_Command Itcl_CmdAliasProc(Tcl_Interp *interp,
0683         Tcl_Namespace *nsPtr, const char *cmdName, ClientData clientData);
0684 MODULE_SCOPE Tcl_Var Itcl_VarAliasProc(Tcl_Interp *interp,
0685         Tcl_Namespace *nsPtr, const char *VarName, ClientData clientData);
0686 MODULE_SCOPE int ItclIsClass(Tcl_Interp *interp, Tcl_Command cmd);
0687 MODULE_SCOPE int ItclCheckCallMethod(ClientData clientData, Tcl_Interp *interp,
0688         Tcl_ObjectContext contextPtr, Tcl_CallFrame *framePtr, int *isFinished);
0689 MODULE_SCOPE int ItclAfterCallMethod(ClientData clientData, Tcl_Interp *interp,
0690         Tcl_ObjectContext contextPtr, Tcl_Namespace *nsPtr, int result);
0691 MODULE_SCOPE void ItclReportObjectUsage(Tcl_Interp *interp,
0692         ItclObject *contextIoPtr, Tcl_Namespace *callerNsPtr,
0693     Tcl_Namespace *contextNsPtr);
0694 MODULE_SCOPE int ItclMapMethodNameProc(Tcl_Interp *interp, Tcl_Object oPtr,
0695         Tcl_Class *startClsPtr, Tcl_Obj *methodObj);
0696 MODULE_SCOPE int ItclCreateArgList(Tcl_Interp *interp, const char *str,
0697         int *argcPtr, int *maxArgcPtr, Tcl_Obj **usagePtr,
0698     ItclArgList **arglistPtrPtr, ItclMemberFunc *imPtr,
0699     const char *commandName);
0700 MODULE_SCOPE int ItclObjectCmd(ClientData clientData, Tcl_Interp *interp,
0701         Tcl_Object oPtr, Tcl_Class clsPtr, int objc, Tcl_Obj *const *objv);
0702 MODULE_SCOPE int ItclCreateObject (Tcl_Interp *interp, const char* name,
0703         ItclClass *iclsPtr, int objc, Tcl_Obj *const objv[]);
0704 MODULE_SCOPE void ItclDeleteObjectVariablesNamespace(Tcl_Interp *interp,
0705         ItclObject *ioPtr);
0706 MODULE_SCOPE void ItclDeleteClassVariablesNamespace(Tcl_Interp *interp,
0707         ItclClass *iclsPtr);
0708 MODULE_SCOPE int ItclInfoInit(Tcl_Interp *interp, ItclObjectInfo *infoPtr);
0709 
0710 MODULE_SCOPE Tcl_HashEntry *ItclResolveVarEntry(
0711     ItclClass* iclsPtr, const char *varName);
0712 
0713 struct Tcl_ResolvedVarInfo;
0714 MODULE_SCOPE int Itcl_ClassCmdResolver(Tcl_Interp *interp, const char* name,
0715     Tcl_Namespace *nsPtr, int flags, Tcl_Command *rPtr);
0716 MODULE_SCOPE int Itcl_ClassVarResolver(Tcl_Interp *interp, const char* name,
0717         Tcl_Namespace *nsPtr, int flags, Tcl_Var *rPtr);
0718 MODULE_SCOPE int Itcl_ClassCompiledVarResolver(Tcl_Interp *interp,
0719         const char* name, int length, Tcl_Namespace *nsPtr,
0720         struct Tcl_ResolvedVarInfo **rPtr);
0721 MODULE_SCOPE int Itcl_ClassCmdResolver2(Tcl_Interp *interp, const char* name,
0722     Tcl_Namespace *nsPtr, int flags, Tcl_Command *rPtr);
0723 MODULE_SCOPE int Itcl_ClassVarResolver2(Tcl_Interp *interp, const char* name,
0724         Tcl_Namespace *nsPtr, int flags, Tcl_Var *rPtr);
0725 MODULE_SCOPE int Itcl_ClassCompiledVarResolver2(Tcl_Interp *interp,
0726         const char* name, int length, Tcl_Namespace *nsPtr,
0727         struct Tcl_ResolvedVarInfo **rPtr);
0728 MODULE_SCOPE int ItclSetParserResolver(Tcl_Namespace *nsPtr);
0729 MODULE_SCOPE void ItclProcErrorProc(Tcl_Interp *interp, Tcl_Obj *procNameObj);
0730 MODULE_SCOPE int Itcl_CreateOption (Tcl_Interp *interp, ItclClass *iclsPtr,
0731     ItclOption *ioptPtr);
0732 MODULE_SCOPE int ItclCreateMethodVariable(Tcl_Interp *interp,
0733     ItclVariable *ivPtr, Tcl_Obj* defaultPtr, Tcl_Obj* callbackPtr,
0734     ItclMethodVariable** imvPtrPtr);
0735 MODULE_SCOPE int DelegationInstall(Tcl_Interp *interp, ItclObject *ioPtr,
0736         ItclClass *iclsPtr);
0737 MODULE_SCOPE ItclClass *ItclNamespace2Class(Tcl_Namespace *nsPtr);
0738 MODULE_SCOPE const char* ItclGetCommonInstanceVar(Tcl_Interp *interp,
0739         const char *name, const char *name2, ItclObject *contextIoPtr,
0740     ItclClass *contextIclsPtr);
0741 MODULE_SCOPE int ItclCreateMethod(Tcl_Interp* interp, ItclClass *iclsPtr,
0742     Tcl_Obj *namePtr, const char* arglist, const char* body,
0743         ItclMemberFunc **imPtrPtr);
0744 MODULE_SCOPE int Itcl_WidgetParseInit(Tcl_Interp *interp,
0745         ItclObjectInfo *infoPtr);
0746 MODULE_SCOPE void ItclDeleteObjectMetadata(ClientData clientData);
0747 MODULE_SCOPE void ItclDeleteClassMetadata(ClientData clientData);
0748 MODULE_SCOPE void ItclDeleteArgList(ItclArgList *arglistPtr);
0749 MODULE_SCOPE int Itcl_ClassOptionCmd(ClientData clientData, Tcl_Interp *interp,
0750         int objc, Tcl_Obj *const objv[]);
0751 MODULE_SCOPE int DelegatedOptionsInstall(Tcl_Interp *interp,
0752         ItclClass *iclsPtr);
0753 MODULE_SCOPE int Itcl_HandleDelegateOptionCmd(Tcl_Interp *interp,
0754         ItclObject *ioPtr, ItclClass *iclsPtr, ItclDelegatedOption **idoPtrPtr,
0755         int objc, Tcl_Obj *const objv[]);
0756 MODULE_SCOPE int Itcl_HandleDelegateMethodCmd(Tcl_Interp *interp,
0757         ItclObject *ioPtr, ItclClass *iclsPtr,
0758     ItclDelegatedFunction **idmPtrPtr, int objc, Tcl_Obj *const objv[]);
0759 MODULE_SCOPE int DelegateFunction(Tcl_Interp *interp, ItclObject *ioPtr,
0760         ItclClass *iclsPtr, Tcl_Obj *componentNamePtr,
0761         ItclDelegatedFunction *idmPtr);
0762 MODULE_SCOPE int ItclInitObjectMethodVariables(Tcl_Interp *interp,
0763         ItclObject *ioPtr, ItclClass *iclsPtr, const char *name);
0764 MODULE_SCOPE int InitTclOOFunctionPointers(Tcl_Interp *interp);
0765 MODULE_SCOPE ItclOption* ItclNewOption(Tcl_Interp *interp, ItclObject *ioPtr,
0766         ItclClass *iclsPtr, Tcl_Obj *namePtr, const char *resourceName,
0767         const char *className, char *init, ItclMemberCode *mCodePtr);
0768 MODULE_SCOPE int ItclParseOption(ItclObjectInfo *infoPtr, Tcl_Interp *interp,
0769         int objc, Tcl_Obj *const objv[], ItclClass *iclsPtr,
0770     ItclObject *ioPtr, ItclOption **ioptPtrPtr);
0771 MODULE_SCOPE void ItclDestroyClassNamesp(ClientData cdata);
0772 MODULE_SCOPE int ExpandDelegateAs(Tcl_Interp *interp, ItclObject *ioPtr,
0773     ItclClass *iclsPtr, ItclDelegatedFunction *idmPtr,
0774     const char *funcName, Tcl_Obj *listPtr);
0775 MODULE_SCOPE int ItclCheckForInitializedComponents(Tcl_Interp *interp,
0776         ItclClass *iclsPtr, ItclObject *ioPtr);
0777 MODULE_SCOPE int ItclCreateDelegatedFunction(Tcl_Interp *interp,
0778         ItclClass *iclsPtr, Tcl_Obj *methodNamePtr, ItclComponent *icPtr,
0779     Tcl_Obj *targetPtr, Tcl_Obj *usingPtr, Tcl_Obj *exceptionsPtr,
0780     ItclDelegatedFunction **idmPtrPtr);
0781 MODULE_SCOPE void ItclDeleteDelegatedOption(char *cdata);
0782 MODULE_SCOPE void Itcl_FinishList();
0783 MODULE_SCOPE void ItclDeleteDelegatedFunction(ItclDelegatedFunction *idmPtr);
0784 MODULE_SCOPE void ItclFinishEnsemble(ItclObjectInfo *infoPtr);
0785 MODULE_SCOPE int Itcl_EnsembleDeleteCmd(ClientData clientData,
0786         Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
0787 MODULE_SCOPE int ItclAddClassesDictInfo(Tcl_Interp *interp, ItclClass *iclsPtr);
0788 MODULE_SCOPE int ItclDeleteClassesDictInfo(Tcl_Interp *interp,
0789         ItclClass *iclsPtr);
0790 MODULE_SCOPE int ItclAddObjectsDictInfo(Tcl_Interp *interp, ItclObject *ioPtr);
0791 MODULE_SCOPE int ItclDeleteObjectsDictInfo(Tcl_Interp *interp,
0792         ItclObject *ioPtr);
0793 MODULE_SCOPE int ItclAddOptionDictInfo(Tcl_Interp *interp, ItclClass *iclsPtr,
0794     ItclOption *ioptPtr);
0795 MODULE_SCOPE int ItclAddDelegatedOptionDictInfo(Tcl_Interp *interp,
0796         ItclClass *iclsPtr, ItclDelegatedOption *idoPtr);
0797 MODULE_SCOPE int ItclAddClassComponentDictInfo(Tcl_Interp *interp,
0798         ItclClass *iclsPtr, ItclComponent *icPtr);
0799 MODULE_SCOPE int ItclAddClassVariableDictInfo(Tcl_Interp *interp,
0800         ItclClass *iclsPtr, ItclVariable *ivPtr);
0801 MODULE_SCOPE int ItclAddClassFunctionDictInfo(Tcl_Interp *interp,
0802         ItclClass *iclsPtr, ItclMemberFunc *imPtr);
0803 MODULE_SCOPE int ItclAddClassDelegatedFunctionDictInfo(Tcl_Interp *interp,
0804         ItclClass *iclsPtr, ItclDelegatedFunction *idmPtr);
0805 MODULE_SCOPE int ItclClassCreateObject(ClientData clientData, Tcl_Interp *interp,
0806         int objc, Tcl_Obj *const objv[]);
0807 
0808 MODULE_SCOPE void ItclRestoreInfoVars(ClientData clientData);
0809 
0810 MODULE_SCOPE Tcl_ObjCmdProc Itcl_BiMyProcCmd;
0811 MODULE_SCOPE Tcl_ObjCmdProc Itcl_BiInstallComponentCmd;
0812 MODULE_SCOPE Tcl_ObjCmdProc Itcl_BiCallInstanceCmd;
0813 MODULE_SCOPE Tcl_ObjCmdProc Itcl_BiGetInstanceVarCmd;
0814 MODULE_SCOPE Tcl_ObjCmdProc Itcl_BiMyTypeMethodCmd;
0815 MODULE_SCOPE Tcl_ObjCmdProc Itcl_BiMyMethodCmd;
0816 MODULE_SCOPE Tcl_ObjCmdProc Itcl_BiMyTypeVarCmd;
0817 MODULE_SCOPE Tcl_ObjCmdProc Itcl_BiMyVarCmd;
0818 MODULE_SCOPE Tcl_ObjCmdProc Itcl_BiItclHullCmd;
0819 MODULE_SCOPE Tcl_ObjCmdProc Itcl_ThisCmd;
0820 MODULE_SCOPE Tcl_ObjCmdProc Itcl_ExtendedClassCmd;
0821 MODULE_SCOPE Tcl_ObjCmdProc Itcl_TypeClassCmd;
0822 MODULE_SCOPE Tcl_ObjCmdProc Itcl_AddObjectOptionCmd;
0823 MODULE_SCOPE Tcl_ObjCmdProc Itcl_AddDelegatedOptionCmd;
0824 MODULE_SCOPE Tcl_ObjCmdProc Itcl_AddDelegatedFunctionCmd;
0825 MODULE_SCOPE Tcl_ObjCmdProc Itcl_SetComponentCmd;
0826 MODULE_SCOPE Tcl_ObjCmdProc Itcl_ClassHullTypeCmd;
0827 MODULE_SCOPE Tcl_ObjCmdProc Itcl_ClassWidgetClassCmd;
0828 
0829 typedef int (ItclRootMethodProc)(ItclObject *ioPtr, Tcl_Interp *interp,
0830     int objc, Tcl_Obj *const objv[]);
0831 
0832 MODULE_SCOPE const Tcl_MethodType itclRootMethodType;
0833 MODULE_SCOPE ItclRootMethodProc ItclUnknownGuts;
0834 MODULE_SCOPE ItclRootMethodProc ItclConstructGuts;
0835 MODULE_SCOPE ItclRootMethodProc ItclInfoGuts;
0836 
0837 #include "itcl2TclOO.h"
0838 
0839 /*
0840  * Include all the private API, generated from itcl.decls.
0841  */
0842 
0843 #include "itclIntDecls.h"