]>
Commit | Line | Data |
---|---|---|
c90f71dd RD |
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 |