source/include/itclInt.h

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