c90f71dd8c
special cases and other things in wxPython, and since I plan on making several more, I've decided to put the SWIG sources in wxPython's CVS instead of relying on maintaining patches. This effectivly becomes a fork of an obsolete version of SWIG, :-( but since SWIG 1.3 still doesn't have some things I rely on in 1.1, not to mention that my custom patches would all have to be redone, I felt that this is the easier road to take. git-svn-id: https://svn.wxwidgets.org/svn/wx/wxWidgets/trunk@15307 c3d73ce0-8a6f-49c7-b76d-6d57e0e08775
224 lines
7.2 KiB
OpenEdge ABL
224 lines
7.2 KiB
OpenEdge ABL
// consthash.i
|
|
//
|
|
// This module changes SWIG to place constant values into a Tcl
|
|
// hash table.
|
|
|
|
|
|
#ifdef AUTODOC
|
|
%subsection "Hash Constants",pre
|
|
%text %{
|
|
%include consthash.i
|
|
|
|
This module changes SWIG so that constant values are placed into a Tcl
|
|
hash table in addition to normal Tcl variables. When working with systems
|
|
involving large numbers of constants, the use of a hash table
|
|
simplifies use because it is no longer necessary to declare constants
|
|
using the 'global' statement.
|
|
|
|
This module should generally be included at the top of an interface
|
|
file before any declarations appear. Furthermore, this module changes
|
|
the default handling of basic datatypes including integers, floats,
|
|
and character strings.
|
|
|
|
When this module is used, constants are simply accessed by name
|
|
without the associated dollar sign. For example :
|
|
|
|
#define FOO 42
|
|
|
|
would be accessed as 'FOO' in Tcl, not '$FOO'.
|
|
|
|
Note : This module only affects integer, float, and character
|
|
constants. Pointer constants are not currently affected. This module
|
|
should not break existing Tcl scripts that rely on the normal SWIG
|
|
constant mechanism.
|
|
%}
|
|
#endif
|
|
|
|
%{
|
|
static Tcl_HashTable intHash, doubleHash, charHash;
|
|
static Tcl_HashEntry *entryPtr;
|
|
static int init_dummy;
|
|
%}
|
|
|
|
%init %{
|
|
Tcl_InitHashTable(&intHash, TCL_STRING_KEYS);
|
|
Tcl_InitHashTable(&doubleHash, TCL_STRING_KEYS);
|
|
Tcl_InitHashTable(&charHash, TCL_STRING_KEYS);
|
|
%}
|
|
|
|
%typemap(tcl,const) int SWIG_DEFAULT_TYPE,
|
|
unsigned int SWIG_DEFAULT_TYPE,
|
|
long SWIG_DEFAULT_TYPE,
|
|
unsigned long SWIG_DEFAULT_TYPE,
|
|
short SWIG_DEFAULT_TYPE,
|
|
unsigned short SWIG_DEFAULT_TYPE,
|
|
unsigned char SWIG_DEFAULT_TYPE,
|
|
signed char SWIG_DEFAULT_TYPE
|
|
{
|
|
static int ivalue = (int) $source;
|
|
entryPtr = Tcl_CreateHashEntry(&intHash, "$target", &init_dummy);
|
|
Tcl_SetHashValue(entryPtr, &ivalue);
|
|
Tcl_LinkVar(interp, SWIG_prefix "$target",(char *) &ivalue, TCL_LINK_INT | TCL_LINK_READ_ONLY);
|
|
}
|
|
|
|
%typemap(tcl,const) float SWIG_DEFAULT_TYPE,
|
|
double SWIG_DEFAULT_TYPE
|
|
{
|
|
static double dvalue = (double) $source;
|
|
entryPtr = Tcl_CreateHashEntry(&doubleHash, "$target", &init_dummy);
|
|
Tcl_SetHashValue(entryPtr, &dvalue);
|
|
Tcl_LinkVar(interp, SWIG_prefix "$target",(char *) &dvalue, TCL_LINK_DOUBLE | TCL_LINK_READ_ONLY);
|
|
}
|
|
|
|
%typemap(tcl,const) char *SWIG_DEFAULT_TYPE
|
|
{
|
|
static char *cvalue = $source;
|
|
entryPtr = Tcl_CreateHashEntry(&charHash, "$target", &init_dummy);
|
|
Tcl_SetHashValue(entryPtr, &cvalue);
|
|
Tcl_LinkVar(interp, SWIG_prefix "$target",(char *) &cvalue, TCL_LINK_STRING | TCL_LINK_READ_ONLY);
|
|
}
|
|
|
|
// Change input handling to look for names
|
|
|
|
%typemap(tcl,in) int SWIG_DEFAULT_TYPE,
|
|
unsigned int SWIG_DEFAULT_TYPE,
|
|
long SWIG_DEFAULT_TYPE,
|
|
unsigned long SWIG_DEFAULT_TYPE,
|
|
short SWIG_DEFAULT_TYPE,
|
|
unsigned short SWIG_DEFAULT_TYPE,
|
|
unsigned char SWIG_DEFAULT_TYPE,
|
|
signed char SWIG_DEFAULT_TYPE
|
|
{
|
|
Tcl_HashEntry *entry;
|
|
entry = Tcl_FindHashEntry(&intHash,$source);
|
|
if (entry) {
|
|
$target = ($type) (*((int *) Tcl_GetHashValue(entry)));
|
|
} else {
|
|
int temp;
|
|
if (Tcl_GetInt(interp, $source, &temp) == TCL_ERROR) return TCL_ERROR;
|
|
$target = ($type) temp;
|
|
}
|
|
}
|
|
|
|
%typemap(tcl,in) float SWIG_DEFAULT_TYPE,
|
|
double SWIG_DEFAULT_TYPE
|
|
{
|
|
Tcl_HashEntry *entry;
|
|
entry = Tcl_FindHashEntry(&doubleHash,$source);
|
|
if (entry) {
|
|
$target = ($type) (*((double *) Tcl_GetHashValue(entry)));
|
|
} else if (entry = Tcl_FindHashEntry(&intHash,$source)) {
|
|
$target = ($type) (*((int *) Tcl_GetHashValue(entry)));
|
|
} else {
|
|
double temp;
|
|
if (Tcl_GetDouble(interp,$source,&temp) == TCL_ERROR) return TCL_ERROR;
|
|
$target = ($type) temp;
|
|
}
|
|
}
|
|
|
|
%typemap(tcl,in) char *SWIG_DEFAULT_TYPE
|
|
{
|
|
Tcl_HashEntry *entry;
|
|
entry = Tcl_FindHashEntry(&charHash,$source);
|
|
if (entry) {
|
|
$target = ($type) (*((char **) Tcl_GetHashValue(entry)));
|
|
} else {
|
|
$target = $source;
|
|
}
|
|
}
|
|
|
|
// ----------------------------------------------------------------------------------
|
|
// Tcl 8 Object versions
|
|
// ----------------------------------------------------------------------------------
|
|
|
|
%typemap(tcl8,const) int SWIG_DEFAULT_TYPE,
|
|
unsigned int SWIG_DEFAULT_TYPE,
|
|
long SWIG_DEFAULT_TYPE,
|
|
unsigned long SWIG_DEFAULT_TYPE,
|
|
short SWIG_DEFAULT_TYPE,
|
|
unsigned short SWIG_DEFAULT_TYPE,
|
|
unsigned char SWIG_DEFAULT_TYPE,
|
|
signed char SWIG_DEFAULT_TYPE
|
|
{
|
|
static int ivalue = (int) $source;
|
|
entryPtr = Tcl_CreateHashEntry(&intHash, "$target", &init_dummy);
|
|
Tcl_SetHashValue(entryPtr, &ivalue);
|
|
Tcl_LinkVar(interp, SWIG_prefix "$target",(char *) &ivalue, TCL_LINK_INT | TCL_LINK_READ_ONLY);
|
|
}
|
|
|
|
%typemap(tcl8,const) float SWIG_DEFAULT_TYPE,
|
|
double SWIG_DEFAULT_TYPE
|
|
{
|
|
static double dvalue = (double) $source;
|
|
entryPtr = Tcl_CreateHashEntry(&doubleHash, "$target", &init_dummy);
|
|
Tcl_SetHashValue(entryPtr, &dvalue);
|
|
Tcl_LinkVar(interp, SWIG_prefix "$target",(char *) &dvalue, TCL_LINK_DOUBLE | TCL_LINK_READ_ONLY);
|
|
}
|
|
|
|
%typemap(tcl8,const) char *SWIG_DEFAULT_TYPE
|
|
{
|
|
static char *cvalue = $source;
|
|
entryPtr = Tcl_CreateHashEntry(&charHash, "$target", &init_dummy);
|
|
Tcl_SetHashValue(entryPtr, &cvalue);
|
|
Tcl_LinkVar(interp, SWIG_prefix "$target",(char *) &cvalue, TCL_LINK_STRING | TCL_LINK_READ_ONLY);
|
|
}
|
|
|
|
// Change input handling to look for names
|
|
|
|
%typemap(tcl8,in) int SWIG_DEFAULT_TYPE,
|
|
unsigned int SWIG_DEFAULT_TYPE,
|
|
long SWIG_DEFAULT_TYPE,
|
|
unsigned long SWIG_DEFAULT_TYPE,
|
|
short SWIG_DEFAULT_TYPE,
|
|
unsigned short SWIG_DEFAULT_TYPE,
|
|
unsigned char SWIG_DEFAULT_TYPE,
|
|
signed char SWIG_DEFAULT_TYPE
|
|
{
|
|
Tcl_HashEntry *entry;
|
|
int _len;
|
|
char *_str = Tcl_GetStringFromObj($source,&_len);
|
|
entry = Tcl_FindHashEntry(&intHash,_str);
|
|
if (entry) {
|
|
$target = ($type) (*((int *) Tcl_GetHashValue(entry)));
|
|
} else {
|
|
int temp;
|
|
if (Tcl_GetIntFromObj(interp, $source, &temp) == TCL_ERROR) return TCL_ERROR;
|
|
$target = ($type) temp;
|
|
}
|
|
}
|
|
|
|
%typemap(tcl8,in) float SWIG_DEFAULT_TYPE,
|
|
double SWIG_DEFAULT_TYPE
|
|
{
|
|
Tcl_HashEntry *entry;
|
|
int _len;
|
|
char *_str = Tcl_GetStringFromObj($source,&_len);
|
|
entry = Tcl_FindHashEntry(&doubleHash,_str);
|
|
if (entry) {
|
|
$target = ($type) (*((double *) Tcl_GetHashValue(entry)));
|
|
} else if (entry = Tcl_FindHashEntry(&intHash,_str)) {
|
|
$target = ($type) (*((int *) Tcl_GetHashValue(entry)));
|
|
} else {
|
|
double temp;
|
|
if (Tcl_GetDoubleFromObj(interp,$source,&temp) == TCL_ERROR) return TCL_ERROR;
|
|
$target = ($type) temp;
|
|
}
|
|
}
|
|
|
|
%typemap(tcl8,in) char *SWIG_DEFAULT_TYPE
|
|
{
|
|
Tcl_HashEntry *entry;
|
|
int _len;
|
|
char *_str = Tcl_GetStringFromObj($source,&_len);
|
|
entry = Tcl_FindHashEntry(&charHash,_str);
|
|
if (entry) {
|
|
$target = ($type) (*((char **) Tcl_GetHashValue(entry)));
|
|
} else {
|
|
$target = _str;
|
|
}
|
|
}
|
|
|
|
|
|
|
|
|