wxPython/wxSWIG/swig_lib/tcl/consthash.i

   1 // consthash.i
   2 //
   3 // This module changes SWIG to place constant values into a Tcl
   4 // hash table.
   5
   6
   7 #ifdef AUTODOC
   8 %subsection "Hash Constants",pre
   9 %text %{
  10 %include consthash.i
  11
  12 This module changes SWIG so that constant values are placed into a Tcl
  13 hash table in addition to normal Tcl variables.  When working with systems
  14 involving large numbers of constants, the use of a hash table
  15 simplifies use because it is no longer necessary to declare constants
  16 using the 'global' statement.
  17
  18 This module should generally be included at the top of an interface
  19 file before any declarations appear.   Furthermore, this module changes
  20 the default handling of basic datatypes including integers, floats,
  21 and character strings.
  22
  23 When this module is used, constants are simply accessed by name
  24 without the associated dollar sign. For example :
  25
  26      #define FOO 42
  27
  28 would be accessed as 'FOO' in Tcl, not '$FOO'.
  29
  30 Note : This module only affects integer, float, and character
  31 constants.  Pointer constants are not currently affected.  This module
  32 should not break existing Tcl scripts that rely on the normal SWIG
  33 constant mechanism.
  34 %}
  35 #endif
  36
  37 %{
  38 static Tcl_HashTable      intHash, doubleHash, charHash;
  39 static Tcl_HashEntry      *entryPtr;
  40 static int                init_dummy;
  41 %}
  42
  43 %init %{
  44    Tcl_InitHashTable(&intHash, TCL_STRING_KEYS);
  45    Tcl_InitHashTable(&doubleHash, TCL_STRING_KEYS);
  46    Tcl_InitHashTable(&charHash, TCL_STRING_KEYS);
  47 %}
  48
  49 %typemap(tcl,const) int SWIG_DEFAULT_TYPE,
  50                     unsigned int SWIG_DEFAULT_TYPE,
  51                     long SWIG_DEFAULT_TYPE,
  52                     unsigned long SWIG_DEFAULT_TYPE,
  53                     short SWIG_DEFAULT_TYPE,
  54                     unsigned short SWIG_DEFAULT_TYPE,
  55                     unsigned char  SWIG_DEFAULT_TYPE,
  56                     signed char    SWIG_DEFAULT_TYPE
  57 {
  58   static int ivalue = (int) $source;
  59   entryPtr = Tcl_CreateHashEntry(&intHash, "$target", &init_dummy);
  60   Tcl_SetHashValue(entryPtr, &ivalue);
  61   Tcl_LinkVar(interp, SWIG_prefix "$target",(char *) &ivalue, TCL_LINK_INT | TCL_LINK_READ_ONLY);
  62 }
  63
  64 %typemap(tcl,const) float  SWIG_DEFAULT_TYPE,
  65                     double SWIG_DEFAULT_TYPE
  66 {
  67   static double dvalue = (double) $source;
  68   entryPtr = Tcl_CreateHashEntry(&doubleHash, "$target", &init_dummy);
  69   Tcl_SetHashValue(entryPtr, &dvalue);
  70   Tcl_LinkVar(interp, SWIG_prefix "$target",(char *) &dvalue, TCL_LINK_DOUBLE | TCL_LINK_READ_ONLY);
  71 }
  72
  73 %typemap(tcl,const) char  *SWIG_DEFAULT_TYPE
  74 {
  75   static char *cvalue = $source;
  76   entryPtr = Tcl_CreateHashEntry(&charHash, "$target", &init_dummy);
  77   Tcl_SetHashValue(entryPtr, &cvalue);
  78   Tcl_LinkVar(interp, SWIG_prefix "$target",(char *) &cvalue, TCL_LINK_STRING | TCL_LINK_READ_ONLY);
  79 }
  80
  81 // Change input handling to look for names
  82
  83 %typemap(tcl,in) int SWIG_DEFAULT_TYPE,
  84                  unsigned int SWIG_DEFAULT_TYPE,
  85                  long SWIG_DEFAULT_TYPE,
  86                  unsigned long SWIG_DEFAULT_TYPE,
  87                  short SWIG_DEFAULT_TYPE,
  88                  unsigned short SWIG_DEFAULT_TYPE,
  89                  unsigned char  SWIG_DEFAULT_TYPE,
  90                  signed char    SWIG_DEFAULT_TYPE
  91 {
  92    Tcl_HashEntry *entry;
  93    entry = Tcl_FindHashEntry(&intHash,$source);
  94    if (entry) {
  95      $target = ($type) (*((int *) Tcl_GetHashValue(entry)));
  96    } else {
  97      int temp;
  98      if (Tcl_GetInt(interp, $source, &temp) == TCL_ERROR) return TCL_ERROR;
  99      $target = ($type) temp;
 100    }
 101 }
 102
 103 %typemap(tcl,in) float SWIG_DEFAULT_TYPE,
 104                  double SWIG_DEFAULT_TYPE
 105 {
 106    Tcl_HashEntry *entry;
 107    entry = Tcl_FindHashEntry(&doubleHash,$source);
 108    if (entry) {
 109      $target = ($type) (*((double *) Tcl_GetHashValue(entry)));
 110    } else if (entry = Tcl_FindHashEntry(&intHash,$source)) {
 111      $target = ($type) (*((int *) Tcl_GetHashValue(entry)));
 112    } else {
 113      double temp;
 114      if (Tcl_GetDouble(interp,$source,&temp) == TCL_ERROR) return TCL_ERROR;
 115      $target = ($type) temp;
 116    }
 117 }
 118
 119 %typemap(tcl,in) char *SWIG_DEFAULT_TYPE
 120 {
 121    Tcl_HashEntry *entry;
 122    entry = Tcl_FindHashEntry(&charHash,$source);
 123    if (entry) {
 124      $target = ($type) (*((char **) Tcl_GetHashValue(entry)));
 125    } else {
 126      $target = $source;
 127    }
 128 }
 129
 130 // ----------------------------------------------------------------------------------
 131 // Tcl 8 Object versions
 132 // ----------------------------------------------------------------------------------
 133
 134 %typemap(tcl8,const) int SWIG_DEFAULT_TYPE,
 135                     unsigned int SWIG_DEFAULT_TYPE,
 136                     long SWIG_DEFAULT_TYPE,
 137                     unsigned long SWIG_DEFAULT_TYPE,
 138                     short SWIG_DEFAULT_TYPE,
 139                     unsigned short SWIG_DEFAULT_TYPE,
 140                     unsigned char  SWIG_DEFAULT_TYPE,
 141                     signed char    SWIG_DEFAULT_TYPE
 142 {
 143   static int ivalue = (int) $source;
 144   entryPtr = Tcl_CreateHashEntry(&intHash, "$target", &init_dummy);
 145   Tcl_SetHashValue(entryPtr, &ivalue);
 146   Tcl_LinkVar(interp, SWIG_prefix "$target",(char *) &ivalue, TCL_LINK_INT | TCL_LINK_READ_ONLY);
 147 }
 148
 149 %typemap(tcl8,const) float  SWIG_DEFAULT_TYPE,
 150                     double SWIG_DEFAULT_TYPE
 151 {
 152   static double dvalue = (double) $source;
 153   entryPtr = Tcl_CreateHashEntry(&doubleHash, "$target", &init_dummy);
 154   Tcl_SetHashValue(entryPtr, &dvalue);
 155   Tcl_LinkVar(interp, SWIG_prefix "$target",(char *) &dvalue, TCL_LINK_DOUBLE | TCL_LINK_READ_ONLY);
 156 }
 157
 158 %typemap(tcl8,const) char  *SWIG_DEFAULT_TYPE
 159 {
 160   static char *cvalue = $source;
 161   entryPtr = Tcl_CreateHashEntry(&charHash, "$target", &init_dummy);
 162   Tcl_SetHashValue(entryPtr, &cvalue);
 163   Tcl_LinkVar(interp, SWIG_prefix "$target",(char *) &cvalue, TCL_LINK_STRING | TCL_LINK_READ_ONLY);
 164 }
 165
 166 // Change input handling to look for names
 167
 168 %typemap(tcl8,in) int SWIG_DEFAULT_TYPE,
 169                  unsigned int SWIG_DEFAULT_TYPE,
 170                  long SWIG_DEFAULT_TYPE,
 171                  unsigned long SWIG_DEFAULT_TYPE,
 172                  short SWIG_DEFAULT_TYPE,
 173                  unsigned short SWIG_DEFAULT_TYPE,
 174                  unsigned char  SWIG_DEFAULT_TYPE,
 175                  signed char    SWIG_DEFAULT_TYPE
 176 {
 177    Tcl_HashEntry *entry;
 178    int  _len;
 179    char *_str = Tcl_GetStringFromObj($source,&_len);
 180    entry = Tcl_FindHashEntry(&intHash,_str);
 181    if (entry) {
 182      $target = ($type) (*((int *) Tcl_GetHashValue(entry)));
 183    } else {
 184      int temp;
 185      if (Tcl_GetIntFromObj(interp, $source, &temp) == TCL_ERROR) return TCL_ERROR;
 186      $target = ($type) temp;
 187    }
 188 }
 189
 190 %typemap(tcl8,in) float SWIG_DEFAULT_TYPE,
 191                  double SWIG_DEFAULT_TYPE
 192 {
 193    Tcl_HashEntry *entry;
 194    int  _len;
 195    char *_str = Tcl_GetStringFromObj($source,&_len);
 196    entry = Tcl_FindHashEntry(&doubleHash,_str);
 197    if (entry) {
 198      $target = ($type) (*((double *) Tcl_GetHashValue(entry)));
 199    } else if (entry = Tcl_FindHashEntry(&intHash,_str)) {
 200      $target = ($type) (*((int *) Tcl_GetHashValue(entry)));
 201    } else {
 202      double temp;
 203      if (Tcl_GetDoubleFromObj(interp,$source,&temp) == TCL_ERROR) return TCL_ERROR;
 204      $target = ($type) temp;
 205    }
 206 }
 207
 208 %typemap(tcl8,in) char *SWIG_DEFAULT_TYPE
 209 {
 210    Tcl_HashEntry *entry;
 211    int  _len;
 212    char *_str = Tcl_GetStringFromObj($source,&_len);
 213    entry = Tcl_FindHashEntry(&charHash,_str);
 214    if (entry) {
 215      $target = ($type) (*((char **) Tcl_GetHashValue(entry)));
 216    } else {
 217      $target = _str;
 218    }
 219 }
 220
 221
 222
 223