jyapayne/swig
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

The great merge

Browse source 
git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk@4141 626c5289-ae23-0410-ae9c-e8d60b6d4f22
This commit is contained in:
Dave Beazley 2002-11-30 22:01:28 +00:00
commit 516036631c
1508 changed files with 125983 additions and 44037 deletions
Download patch file Download diff file Expand all files Collapse all files

10
SWIG/Lib/tcl/Makefile.in
View file

@ -37,7 +37,7 @@ CC = @CC@
CXX = @CXX@
OBJC = @CC@ -Wno-import # -Wno-import needed for gcc
CFLAGS =
INCLUDE =
INCLUDES =
LIBS =
# SWIG Options
@ -100,13 +100,13 @@ BUILD_LIBS = $(LIBS) # Dynamic loading
.SUFFIXES: .c .cxx .m
.c.o:
$(CC) $(CCSHARED) $(CFLAGS) $(INCLUDE) -c $<
$(CC) $(CCSHARED) $(CFLAGS) $(INCLUDES) -c $<
.cxx.o:
$(CXX) $(CCSHARED) $(CXXFLAGS) $(INCLUDE) -c $<
$(CXX) $(CCSHARED) $(CXXFLAGS) $(INCLUDES) -c $<
.m.o:
$(OBJC) $(CCSHARED) $(CFLAGS) $(INCLUDE) -c $<
$(OBJC) $(CCSHARED) $(CFLAGS) $(INCLUDES) -c $<
# ----------------------------------------------------------------------
@ -118,7 +118,7 @@ all: $(TARGET)
# Convert the wrapper file into an object file
$(WRAPOBJ) : $(WRAPFILE)
$(SWIGCC) -c $(CCSHARED) $(CFLAGS) $(WRAPFILE) $(INCLUDE) $(TCL_INCLUDE)
$(SWIGCC) -c $(CCSHARED) $(CFLAGS) $(WRAPFILE) $(INCLUDES) $(TCL_INCLUDE)
$(WRAPFILE) : $(INTERFACE)
$(SWIG) $(SWIGOPT) -o $(WRAPFILE) $(SWIGLIB) $(INTERFACE)

108
SWIG/Lib/tcl/constarray.i
View file

@ -1,108 +0,0 @@
// constarray.i
//
// This module changes SWIG to place constant values into a Tcl array
#ifdef AUTODOC
%subsection "Array Constants",pre
%text %{
%include constarray.i
This module changes SWIG so that constant values are placed into a Tcl
array instead of global variables. The array is given the same name as
the SWIG module (specified with the %module directive).
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 through the
module name. For example :
%module example
...
#define FOO 42
would be accessed as '$example(FOO)'
Note : This module replaces the existing mechanism for creating constants.
The method used by this module is based on a set of typemaps supplied
by Tim Medley.
%}
#endif
%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;
Tcl_LinkVar(interp,SWIG_name "($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;
Tcl_LinkVar(interp, SWIG_prefix SWIG_name "($target)",(char *) &dvalue, TCL_LINK_DOUBLE | TCL_LINK_READ_ONLY);
}
%typemap(tcl,const) char *SWIG_DEFAULT_TYPE
{
static char *cvalue = $source;
Tcl_LinkVar(interp, SWIG_prefix SWIG_name "($target)",(char *) &cvalue, TCL_LINK_STRING | TCL_LINK_READ_ONLY);
}
%typemap(tcl,const) Pointer *SWIG_DEFAULT_TYPE
{
static char *pvalue;
pvalue = (char *) malloc(20+strlen("$mangle"));
SWIG_MakePtr(pvalue, (void *) ($source), "$mangle");
Tcl_LinkVar(interp, SWIG_prefix SWIG_name "($target)",(char *) &pvalue, TCL_LINK_STRING | TCL_LINK_READ_ONLY);
}
// ----------------------------------------------------------------------------------
// 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;
Tcl_LinkVar(interp, SWIG_prefix SWIG_name "($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;
Tcl_LinkVar(interp, SWIG_prefix SWIG_name "($target)",(char *) &dvalue, TCL_LINK_DOUBLE | TCL_LINK_READ_ONLY);
}
%typemap(tcl8,const) char *SWIG_DEFAULT_TYPE
{
static char *cvalue = $source;
Tcl_LinkVar(interp, SWIG_prefix SWIG_name "($target)",(char *) &cvalue, TCL_LINK_STRING | TCL_LINK_READ_ONLY);
}
%typemap(tcl8,const) Pointer *SWIG_DEFAULT_TYPE
{
static char *pvalue;
pvalue = (char *) malloc(20+strlen("$mangle"));
SWIG_MakePtr(pvalue, (void *) ($source), "$mangle");
Tcl_LinkVar(interp, SWIG_prefix SWIG_name "($target)",(char *) &pvalue, TCL_LINK_STRING | TCL_LINK_READ_ONLY);
}

223
SWIG/Lib/tcl/consthash.i
View file

@ -1,223 +0,0 @@
// 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;
}
}

290
SWIG/Lib/tcl/cstring.i Normal file
View file

@ -0,0 +1,290 @@
/*
* cstring.i
* $Header$
*
* Author(s): David Beazley (beazley@cs.uchicago.edu)
*
* This file provides typemaps and macros for dealing with various forms
* of C character string handling. The primary use of this module
* is in returning character data that has been allocated or changed in
* some way.
*/
/* %cstring_input_binary(TYPEMAP, SIZE)
*
* Macro makes a function accept binary string data along with
* a size.
*/
%define %cstring_input_binary(TYPEMAP, SIZE)
%apply (char *STRING, int LENGTH) { (TYPEMAP, SIZE) };
%enddef
/*
* %cstring_bounded_output(TYPEMAP, MAX)
*
* This macro is used to return a NULL-terminated output string of
* some maximum length. For example:
*
* %cstring_bounded_output(char *outx, 512);
* void foo(char *outx) {
* sprintf(outx,"blah blah\n");
* }
*
*/
%define %cstring_bounded_output(TYPEMAP,MAX)
%typemap(ignore) TYPEMAP(char temp[MAX+1]) {
$1 = ($1_ltype) temp;
}
%typemap(argout,fragment="t_output_helper") TYPEMAP {
Tcl_Obj *o;
$1[MAX] = 0;
o = Tcl_NewStringObj($1,-1);
Tcl_ListObjAppendElement(interp,Tcl_GetObjResult(interp), o);
}
%enddef
/*
* %cstring_chunk_output(TYPEMAP, SIZE)
*
* This macro is used to return a chunk of binary string data.
* Embedded NULLs are okay. For example:
*
* %cstring_chunk_output(char *outx, 512);
* void foo(char *outx) {
* memmove(outx, somedata, 512);
* }
*
*/
%define %cstring_chunk_output(TYPEMAP,SIZE)
%typemap(ignore) TYPEMAP(char temp[SIZE]) {
$1 = ($1_ltype) temp;
}
%typemap(argout,fragment="t_output_helper") TYPEMAP {
Tcl_Obj *o = Tcl_NewStringObj($1,SIZE);
Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp),o);
}
%enddef
/*
* %cstring_bounded_mutable(TYPEMAP, SIZE)
*
* This macro is used to wrap a string that's going to mutate.
*
* %cstring_bounded_mutable(char *in, 512);
* void foo(in *x) {
* while (*x) {
* *x = toupper(*x);
* x++;
* }
* }
*
*/
%define %cstring_bounded_mutable(TYPEMAP,MAX)
%typemap(in) TYPEMAP(char temp[MAX+1]) {
char *t = Tcl_GetStringFromObj($input,NULL);
strncpy(temp,t,MAX);
$1 = ($1_ltype) temp;
}
%typemap(argout,fragment="t_output_helper") TYPEMAP {
Tcl_Obj *o;
$1[MAX] = 0;
o = Tcl_NewStringObj($1,-1);
Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp),o);
}
%enddef
/*
* %cstring_mutable(TYPEMAP [, expansion])
*
* This macro is used to wrap a string that will mutate in place.
* It may change size up to a user-defined expansion.
*
* %cstring_mutable(char *in);
* void foo(in *x) {
* while (*x) {
* *x = toupper(*x);
* x++;
* }
* }
*
*/
%define %cstring_mutable(TYPEMAP,...)
%typemap(in) TYPEMAP {
int n;
char *t = Tcl_GetStringFromObj($input,&n);
$1 = ($1_ltype) t;
#if #__VA_ARGS__ == ""
#if __cplusplus
$1 = ($1_ltype) new char[n+1];
#else
$1 = ($1_ltype) malloc(n+1);
#endif
#else
#if __cplusplus
$1 = ($1_ltype) new char[n+1+__VA_ARGS__];
#else
$1 = ($1_ltype) malloc(n+1+__VA_ARGS__);
#endif
#endif
memmove($1,t,n);
$1[n] = 0;
}
%typemap(argout,fragment="t_output_helper") TYPEMAP {
Tcl_Obj *o;
o = Tcl_NewStringObj($1,-1);
Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), o);
#if __cplusplus
delete[] $1;
#else
free($1);
#endif
}
%enddef
/*
* %cstring_output_maxsize(TYPEMAP, SIZE)
*
* This macro returns data in a string of some user-defined size.
*
* %cstring_output_maxsize(char *outx, int max) {
* void foo(char *outx, int max) {
* sprintf(outx,"blah blah\n");
* }
*/
%define %cstring_output_maxsize(TYPEMAP, SIZE)
%typemap(in) (TYPEMAP, SIZE) {
long temp;
if (Tcl_GetLongFromObj(interp,$input,&temp) != TCL_OK) {
SWIG_fail;
}
$2 = ($2_ltype) temp;
#ifdef __cpluscplus
$1 = ($1_ltype) new char[$2+1];
#else
$1 = ($1_ltype) malloc($2+1);
#endif
}
%typemap(argout,fragment="t_output_helper") (TYPEMAP,SIZE) {
Tcl_Obj *o;
o = Tcl_NewStringObj($1,-1);
Tcl_ListObjAppendElement(interp,Tcl_GetObjResult(interp),o);
#ifdef __cplusplus
delete [] $1;
#else
free($1);
#endif
}
%enddef
/*
* %cstring_output_withsize(TYPEMAP, SIZE)
*
* This macro is used to return character data along with a size
* parameter.
*
* %cstring_output_maxsize(char *outx, int *max) {
* void foo(char *outx, int *max) {
* sprintf(outx,"blah blah\n");
* *max = strlen(outx);
* }
*/
%define %cstring_output_withsize(TYPEMAP, SIZE)
%typemap(in) (TYPEMAP, SIZE) {
long n;
if (Tcl_GetLongFromObj(interp,$input,&n) != TCL_OK) {
SWIG_fail;
}
#ifdef __cpluscplus
$1 = ($1_ltype) new char[n+1];
$2 = ($2_ltype) new $*1_ltype;
#else
$1 = ($1_ltype) malloc(n+1);
$2 = ($2_ltype) malloc(sizeof($*1_ltype));
#endif
*$2 = n;
}
%typemap(argout,fragment="t_output_helper") (TYPEMAP,SIZE) {
Tcl_Obj *o;
o = Tcl_NewStringObj($1,*$2);
Tcl_ListObjAppendElement(interp,Tcl_GetObjResult(interp), o);
#ifdef __cplusplus
delete [] $1;
delete $2;
#else
free($1);
free($2);
#endif
}
%enddef
/*
* %cstring_output_allocate(TYPEMAP, RELEASE)
*
* This macro is used to return character data that was
* allocated with new or malloc.
*
* %cstring_output_allocated(char **outx, free($1));
* void foo(char **outx) {
* *outx = (char *) malloc(512);
* sprintf(outx,"blah blah\n");
* }
*/
%define %cstring_output_allocate(TYPEMAP, RELEASE)
%typemap(ignore) TYPEMAP($*1_ltype temp = 0) {
$1 = &temp;
}
%typemap(argout,fragment="t_output_helper") TYPEMAP {
if (*$1) {
Tcl_Obj *o = Tcl_NewStringObj(*$1,-1);
RELEASE;
Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), o);
}
}
%enddef
/*
* %cstring_output_allocate_size(TYPEMAP, SIZE, RELEASE)
*
* This macro is used to return character data that was
* allocated with new or malloc.
*
* %cstring_output_allocated(char **outx, int *sz, free($1));
* void foo(char **outx, int *sz) {
* *outx = (char *) malloc(512);
* sprintf(outx,"blah blah\n");
* *sz = strlen(outx);
* }
*/
%define %cstring_output_allocate_size(TYPEMAP, SIZE, RELEASE)
%typemap(ignore) (TYPEMAP, SIZE) ($*1_ltype temp = 0, $*2_ltype tempn) {
$1 = &temp;
$2 = &tempn;
}
%typemap(argout,fragment="t_output_helper")(TYPEMAP,SIZE) {
if (*$1) {
Tcl_Obj *o = Tcl_NewStringObj(*$1,*$2);
RELEASE;
Tcl_ListObjAppendElement(interp,Tcl_GetObjResult(interp), o);
}
}
%enddef

229
SWIG/Lib/tcl/object.swg
View file

@ -1,229 +0,0 @@
/* object.swg
*
* Tcl8.x - Object oriented runtime functions
*/
typedef int (*swig_wrapper)(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []);
typedef struct swig_method {
const char *name;
swig_wrapper method;
} swig_method;
typedef struct swig_attribute {
const char *name;
swig_wrapper getmethod;
swig_wrapper setmethod;
} swig_attribute;
typedef struct swig_class {
const char *name;
swig_type_info **type;
swig_wrapper constructor;
void (*destructor)(void *);
swig_method *methods;
swig_attribute *attributes;
} swig_class;
typedef struct swig_instance {
Tcl_Obj *thisptr;
void *thisvalue;
swig_class *classptr;
int destroy;
} swig_instance;
static void SwigObjectDelete(ClientData clientData) {
swig_instance *si = (swig_instance *) clientData;
if (si->destroy) {
if (si->classptr->destructor) {
(si->classptr->destructor)(si->thisvalue);
}
}
Tcl_DecrRefCount(si->thisptr);
free(si);
}
/* Function to invoke object methods given an instance */
static int
SwigMethodCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST _objv[])
{
char *method, *attrname;
swig_instance *inst = (swig_instance *) clientData;
swig_method *meth;
swig_attribute *attr;
Tcl_Obj *oldarg;
Tcl_Obj **objv;
int rcode;
objv = (Tcl_Obj **) _objv;
if (objc < 2) {
Tcl_SetResult(interp,"wrong # args.", TCL_STATIC);
return TCL_ERROR;
}
meth = inst->classptr->methods;
method = Tcl_GetStringFromObj(objv[1],NULL);
/* Check for methods */
while (meth && meth->name) {
if (strcmp(meth->name,method) == 0) {
oldarg = objv[1];
objv[1] = inst->thisptr;
Tcl_IncrRefCount(inst->thisptr);
rcode = (*meth->method)(clientData,interp,objc,objv);
objv[1] = oldarg;
Tcl_DecrRefCount(inst->thisptr);
return rcode;
}
meth++;
}
/* Check class methods for a match */
if (strcmp(method,"cget") == 0) {
if (objc < 3) {
Tcl_SetResult(interp,"wrong # args.", TCL_STATIC);
return TCL_ERROR;
}
attrname = Tcl_GetStringFromObj(objv[2],NULL);
attr = inst->classptr->attributes;
while (attr && attr->name) {
if ((strcmp(attr->name, attrname) == 0) && (attr->getmethod)) {
oldarg = objv[1];
objv[1] = inst->thisptr;
Tcl_IncrRefCount(inst->thisptr);
rcode = (*attr->getmethod)(clientData,interp,2, objv);
objv[1] = oldarg;
Tcl_DecrRefCount(inst->thisptr);
return rcode;
}
attr++;
}
if (strcmp(attrname, "-this") == 0) {
Tcl_SetObjResult(interp, Tcl_DuplicateObj(inst->thisptr));
return TCL_OK;
}
Tcl_SetResult(interp,"Invalid attribute.", TCL_STATIC);
return TCL_ERROR;
} else if (strcmp(method, "configure") == 0) {
int i;
if (objc < 4) {
Tcl_SetResult(interp,"wrong # args.", TCL_STATIC);
return TCL_ERROR;
}
i = 2;
while (i < objc) {
attrname = Tcl_GetStringFromObj(objv[i],NULL);
attr = inst->classptr->attributes;
while (attr && attr->name) {
if ((strcmp(attr->name, attrname) == 0) && (attr->setmethod)) {
oldarg = objv[i];
objv[i] = inst->thisptr;
Tcl_IncrRefCount(inst->thisptr);
rcode = (*attr->setmethod)(clientData,interp,3, &objv[i-1]);
objv[i] = oldarg;
Tcl_DecrRefCount(inst->thisptr);
if (rcode != TCL_OK) return rcode;
i+=2;
break;
}
attr++;
}
if (inst->classptr->attributes && !(attr->name)) {
Tcl_SetResult(interp,"Invalid attribute name.", TCL_STATIC);
return TCL_ERROR;
}
}
return TCL_OK;
} else {
Tcl_SetResult(interp,"Invalid method. Must be one of: configure cget ", TCL_STATIC);
meth = inst->classptr->methods;
while (meth && meth->name) {
Tcl_AppendElement(interp, meth->name);
meth++;
}
return TCL_ERROR;
}
}
/* Function to create objects */
static int
SwigObjectCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
Tcl_Obj *newObj = 0;
void *thisvalue = 0;
swig_instance *newinst = 0;
swig_class *classptr = (swig_class *) clientData;
swig_wrapper cons = 0;
char *name = 0;
int firstarg = 0;
int thisarg = 0;
int destroy = 1;
Tcl_CmdInfo ci;
if (!classptr) {
Tcl_SetResult(interp,"swig: internal runtime error. No class object defined.", TCL_STATIC);
return TCL_ERROR;
}
cons = classptr->constructor;
if (objc > 1) {
char *s = Tcl_GetStringFromObj(objv[1],NULL);
if (strcmp(s,"-this") == 0) {
thisarg = 2;
cons = 0;
} else if (strcmp(s,"-args") == 0) {
firstarg = 1;
} else if (objc == 2) {
firstarg = 1;
name = s;
} else if (objc >= 3) {
char *s1;
name = s;
s1 = Tcl_GetStringFromObj(objv[2],NULL);
if (strcmp(s1,"-this") == 0) {
thisarg = 3;
cons = 0;
} else {
firstarg = 1;
}
}
}
if (cons) {
int result;
result = (*cons)(0, interp, objc-firstarg, &objv[firstarg]);
if (result != TCL_OK) {
return result;
}
newObj = Tcl_DuplicateObj(Tcl_GetObjResult(interp));
if (!name) name = Tcl_GetStringFromObj(newObj,NULL);
} else if (thisarg > 0) {
if (thisarg < objc) {
destroy = 0;
newObj = Tcl_DuplicateObj(objv[thisarg]);
if (!name) name = Tcl_GetStringFromObj(newObj,NULL);
} else {
Tcl_SetResult(interp,"wrong # args.", TCL_STATIC);
return TCL_ERROR;
}
} else {
Tcl_SetResult(interp,"No constructor available.", TCL_STATIC);
return TCL_ERROR;
}
if (!Tcl_GetCommandInfo(interp,name,&ci)) {
if (SWIG_ConvertPtr(interp,newObj, (void **) &thisvalue, *(classptr->type)) == TCL_ERROR) {
Tcl_DecrRefCount(newObj);
return TCL_ERROR;
}
newinst = (swig_instance *) malloc(sizeof(swig_instance));
newinst->thisptr = newObj;
Tcl_IncrRefCount(newObj);
newinst->thisvalue = thisvalue;
newinst->classptr = classptr;
newinst->destroy = destroy;
Tcl_CreateObjCommand(interp,name, SwigMethodCmd, (ClientData) newinst, SwigObjectDelete);
return TCL_OK;
} else {
Tcl_SetResult(interp,"Object name already exists!", TCL_STATIC);
return TCL_ERROR;
}
}

490
SWIG/Lib/tcl/ptrlang.i
View file

@ -1,490 +0,0 @@
//
// SWIG pointer conversion and utility library
//
// Dave Beazley
// April 19, 1997
//
// Tcl specific implementation. This file is included
// by the file ../pointer.i
%{
#include <ctype.h>
/* Types used by the library */
static swig_type_info *SWIG_POINTER_int_p = 0;
static swig_type_info *SWIG_POINTER_short_p =0;
static swig_type_info *SWIG_POINTER_long_p = 0;
static swig_type_info *SWIG_POINTER_float_p = 0;
static swig_type_info *SWIG_POINTER_double_p = 0;
static swig_type_info *SWIG_POINTER_char_p = 0;
static swig_type_info *SWIG_POINTER_char_pp = 0;
%}
%init %{
SWIG_POINTER_int_p = SWIG_TypeQuery("int *");
SWIG_POINTER_short_p = SWIG_TypeQuery("short *");
SWIG_POINTER_long_p = SWIG_TypeQuery("long *");
SWIG_POINTER_float_p = SWIG_TypeQuery("float *");
SWIG_POINTER_double_p = SWIG_TypeQuery("double *");
SWIG_POINTER_char_p = SWIG_TypeQuery("char *");
SWIG_POINTER_char_pp = SWIG_TypeQuery("char **");
%}
%{
/*------------------------------------------------------------------
ptrvalue(ptr,type = 0)
Attempts to dereference a pointer value. If type is given, it
will try to use that type. Otherwise, this function will attempt
to "guess" the proper datatype by checking against all of the
builtin C datatypes.
------------------------------------------------------------------ */
static int ptrvalue(Tcl_Interp *interp, char *ptrvalue, int index, char *type) {
void *ptr;
char *s;
int error = 0;
if (type) {
if (strlen(type) == 0) type = 0;
}
s = ptrvalue;
if (SWIG_ConvertPtrFromString(interp,s,&ptr,0) != TCL_OK) {
Tcl_SetResult(interp,"Type error in ptrvalue. Argument is not a valid pointer value.", TCL_STATIC);
return TCL_ERROR;
}
/* If no datatype was passed, try a few common datatypes first */
if (!type) {
/* No datatype was passed. Type to figure out if it's a common one */
if (SWIG_ConvertPtrFromString(interp,s,&ptr,SWIG_POINTER_int_p) == TCL_OK) {
type = "int";
} else if (SWIG_ConvertPtrFromString(interp,s,&ptr,SWIG_POINTER_double_p) == TCL_OK) {
type = "double";
} else if (SWIG_ConvertPtrFromString(interp,s,&ptr,SWIG_POINTER_short_p) == TCL_OK) {
type = "short";
} else if (SWIG_ConvertPtrFromString(interp,s,&ptr,SWIG_POINTER_long_p) == TCL_OK) {
type = "long";
} else if (SWIG_ConvertPtrFromString(interp,s,&ptr,SWIG_POINTER_float_p) == TCL_OK) {
type = "float";
} else if (SWIG_ConvertPtrFromString(interp,s,&ptr,SWIG_POINTER_char_p) == TCL_OK) {
type = "char";
} else if (SWIG_ConvertPtrFromString(interp,s,&ptr,SWIG_POINTER_char_pp) == TCL_OK) {
type = "char *";
} else {
type = "unknown";
}
}
if (!ptr) {
Tcl_SetResult(interp,"Unable to dereference NULL pointer.",TCL_STATIC);
return TCL_ERROR;
}
/* Now we have a datatype. Try to figure out what to do about it */
if (strcmp(type,"int") == 0) {
sprintf(interp->result,"%ld",(long) *(((int *) ptr) + index));
} else if (strcmp(type,"double") == 0) {
Tcl_PrintDouble(interp,(double) *(((double *) ptr)+index), interp->result);
} else if (strcmp(type,"short") == 0) {
sprintf(interp->result,"%ld",(long) *(((short *) ptr) + index));
} else if (strcmp(type,"long") == 0) {
sprintf(interp->result,"%ld",(long) *(((long *) ptr) + index));
} else if (strcmp(type,"float") == 0) {
Tcl_PrintDouble(interp,(double) *(((float *) ptr)+index), interp->result);
} else if (strcmp(type,"char") == 0) {
Tcl_SetResult(interp,((char *) ptr) + index, TCL_VOLATILE);
} else if (strcmp(type,"char *") == 0) {
char *c = *(((char **) ptr)+index);
if (c) Tcl_SetResult(interp,(char *) c, TCL_VOLATILE);
else Tcl_SetResult(interp,"NULL", TCL_VOLATILE);
} else {
Tcl_SetResult(interp,"Unable to dereference unsupported datatype.",TCL_STATIC);
return TCL_ERROR;
}
return TCL_OK;
}
/*------------------------------------------------------------------
ptrcreate(type,value = 0,numelements = 1)
Attempts to create a new object of given type. Type must be
a basic C datatype. Will not create complex objects.
------------------------------------------------------------------ */
static int ptrcreate(Tcl_Interp *interp, char *type, char *ptrvalue, int numelements) {
void *ptr;
int sz;
swig_type_info *cast = 0;
char temp[40];
/* Check the type string against a variety of possibilities */
if (strcmp(type,"int") == 0) {
sz = sizeof(int)*numelements;
cast = SWIG_POINTER_int_p;
} else if (strcmp(type,"short") == 0) {
sz = sizeof(short)*numelements;
cast = SWIG_POINTER_short_p;
} else if (strcmp(type,"long") == 0) {
sz = sizeof(long)*numelements;
cast = SWIG_POINTER_long_p;
} else if (strcmp(type,"double") == 0) {
sz = sizeof(double)*numelements;
cast = SWIG_POINTER_double_p;
} else if (strcmp(type,"float") == 0) {
sz = sizeof(float)*numelements;
cast = SWIG_POINTER_float_p;
} else if (strcmp(type,"char") == 0) {
sz = sizeof(char)*numelements;
cast = SWIG_POINTER_char_p;
} else if (strcmp(type,"char *") == 0) {
sz = sizeof(char *)*(numelements+1);
cast = SWIG_POINTER_char_pp;
} else if (strcmp(type,"void") == 0) {
sz = numelements;
} else {
Tcl_SetResult(interp,"Unable to create unknown datatype.",TCL_STATIC);
return TCL_ERROR;
}
/* Create the new object */
ptr = (void *) malloc(sz);
if (!ptr) {
Tcl_SetResult(interp,"Out of memory in ptrcreate.",TCL_STATIC);
return TCL_ERROR;
}
/* Now try to set its default value */
if (ptrvalue) {
if (strcmp(type,"int") == 0) {
int *ip,i,ivalue;
Tcl_GetInt(interp,ptrvalue,&ivalue);
ip = (int *) ptr;
for (i = 0; i < numelements; i++)
ip[i] = ivalue;
} else if (strcmp(type,"short") == 0) {
short *ip;
int i, ivalue;
Tcl_GetInt(interp,ptrvalue,&ivalue);
ip = (short *) ptr;
for (i = 0; i < numelements; i++)
ip[i] = (short) ivalue;
} else if (strcmp(type,"long") == 0) {
long *ip;
int i, ivalue;
Tcl_GetInt(interp,ptrvalue,&ivalue);
ip = (long *) ptr;
for (i = 0; i < numelements; i++)
ip[i] = (long) ivalue;
} else if (strcmp(type,"double") == 0) {
double *ip,ivalue;
int i;
Tcl_GetDouble(interp,ptrvalue,&ivalue);
ip = (double *) ptr;
for (i = 0; i < numelements; i++)
ip[i] = ivalue;
} else if (strcmp(type,"float") == 0) {
float *ip;
double ivalue;
int i;
Tcl_GetDouble(interp,ptrvalue,&ivalue);
ip = (float *) ptr;
for (i = 0; i < numelements; i++)
ip[i] = (double) ivalue;
} else if (strcmp(type,"char") == 0) {
char *ip,*ivalue;
ivalue = (char *) ptrvalue;
ip = (char *) ptr;
strncpy(ip,ivalue,numelements-1);
} else if (strcmp(type,"char *") == 0) {
char **ip, *ivalue;
int i;
ivalue = (char *) ptrvalue;
ip = (char **) ptr;
for (i = 0; i < numelements; i++) {
if (ivalue) {
ip[i] = (char *) malloc(strlen(ivalue)+1);
strcpy(ip[i],ivalue);
} else {
ip[i] = 0;
}
}
ip[numelements] = 0;
}
}
/* Create the pointer value */
Tcl_SetObjResult(interp,SWIG_NewPointerObj(ptr,cast));
return TCL_OK;
}
/*------------------------------------------------------------------
ptrset(ptr,value,index = 0,type = 0)
Attempts to set the value of a pointer variable. If type is
given, we will use that type. Otherwise, we'll guess the datatype.
------------------------------------------------------------------ */
static int ptrset(Tcl_Interp *interp, char *ptrvalue, char *value, int index, char *type) {
void *ptr;
char *s;
s = ptrvalue;
if (SWIG_ConvertPtrFromString(interp,s,&ptr,0) != TCL_OK) {
Tcl_SetResult(interp,"Type error in ptrset. Argument is not a valid pointer value.",
TCL_STATIC);
return TCL_ERROR;
}
/* If no datatype was passed, try a few common datatypes first */
if (!type) {
/* No datatype was passed. Type to figure out if it's a common one */
if (SWIG_ConvertPtrFromString(interp,s,&ptr,SWIG_POINTER_int_p) == TCL_OK) {
type = "int";
} else if (SWIG_ConvertPtrFromString(interp,s,&ptr,SWIG_POINTER_double_p) == TCL_OK) {
type = "double";
} else if (SWIG_ConvertPtrFromString(interp,s,&ptr,SWIG_POINTER_short_p) == TCL_OK) {
type = "short";
} else if (SWIG_ConvertPtrFromString(interp,s,&ptr,SWIG_POINTER_long_p) == TCL_OK) {
type = "long";
} else if (SWIG_ConvertPtrFromString(interp,s,&ptr,SWIG_POINTER_float_p) == TCL_OK) {
type = "float";
} else if (SWIG_ConvertPtrFromString(interp,s,&ptr,SWIG_POINTER_char_p) == TCL_OK) {
type = "char";
} else if (SWIG_ConvertPtrFromString(interp,s,&ptr,SWIG_POINTER_char_pp) == TCL_OK) {
type = "char *";
} else {
type = "unknown";
}
}
if (!ptr) {
Tcl_SetResult(interp,"Unable to set NULL pointer.",TCL_STATIC);
return TCL_ERROR;
}
/* Now we have a datatype. Try to figure out what to do about it */
if (strcmp(type,"int") == 0) {
int ivalue;
Tcl_GetInt(interp,value, &ivalue);
*(((int *) ptr)+index) = ivalue;
} else if (strcmp(type,"double") == 0) {
double ivalue;
Tcl_GetDouble(interp,value, &ivalue);
*(((double *) ptr)+index) = (double) ivalue;
} else if (strcmp(type,"short") == 0) {
int ivalue;
Tcl_GetInt(interp,value, &ivalue);
*(((short *) ptr)+index) = (short) ivalue;
} else if (strcmp(type,"long") == 0) {
int ivalue;
Tcl_GetInt(interp,value, &ivalue);
*(((long *) ptr)+index) = (long) ivalue;
} else if (strcmp(type,"float") == 0) {
double ivalue;
Tcl_GetDouble(interp,value, &ivalue);
*(((float *) ptr)+index) = (float) ivalue;
} else if (strcmp(type,"char") == 0) {
char *c = value;
strcpy(((char *) ptr)+index, c);
} else if (strcmp(type,"char *") == 0) {
char *c = value;
char **ca = (char **) ptr;
if (ca[index]) free(ca[index]);
if (strcmp(c,"NULL") == 0) {
ca[index] = 0;
} else {
ca[index] = (char *) malloc(strlen(c)+1);
strcpy(ca[index],c);
}
} else {
Tcl_SetResult(interp,"Unable to set unsupported datatype.",TCL_STATIC);
return TCL_ERROR;
}
return TCL_OK;
}
/*------------------------------------------------------------------
ptradd(ptr,offset)
Adds a value to an existing pointer value. Will do a type-dependent
add for basic datatypes. For other datatypes, will do a byte-add.
------------------------------------------------------------------ */
static int ptradd(Tcl_Interp *interp, char *ptrvalue, int offset) {
char *r,*s;
void *ptr,*junk;
swig_type_info *type = 0;
swig_type_info stype;
/* Check to see what kind of object ptrvalue is */
s = ptrvalue;
/* Try to handle a few common datatypes first */
if (SWIG_ConvertPtrFromString(interp,s,&ptr,SWIG_POINTER_int_p) == TCL_OK) {
ptr = (void *) (((int *) ptr) + offset);
type = SWIG_POINTER_int_p;
} else if (SWIG_ConvertPtrFromString(interp,s,&ptr,SWIG_POINTER_double_p) == TCL_OK) {
ptr = (void *) (((double *) ptr) + offset);
type = SWIG_POINTER_double_p;
} else if (SWIG_ConvertPtrFromString(interp,s,&ptr,SWIG_POINTER_short_p) == TCL_OK) {
ptr = (void *) (((short *) ptr) + offset);
type = SWIG_POINTER_short_p;
} else if (SWIG_ConvertPtrFromString(interp,s,&ptr,SWIG_POINTER_long_p) == TCL_OK) {
ptr = (void *) (((long *) ptr) + offset);
type = SWIG_POINTER_long_p;
} else if (SWIG_ConvertPtrFromString(interp,s,&ptr,SWIG_POINTER_float_p) == TCL_OK) {
ptr = (void *) (((float *) ptr) + offset);
type = SWIG_POINTER_float_p;
} else if (SWIG_ConvertPtrFromString(interp,s,&ptr,SWIG_POINTER_char_p) == TCL_OK) {
ptr = (void *) (((char *) ptr) + offset);
type = SWIG_POINTER_char_p;
} else if (SWIG_ConvertPtrFromString(interp,s,&ptr,0) == TCL_OK) {
ptr = (void *) (((char *) ptr) + offset);
stype.name = SWIG_PointerTypeFromString(s);
type = &stype;
} else {
Tcl_SetResult(interp,"Type error in ptradd. Argument is not a valid pointer value.",TCL_STATIC);
return TCL_ERROR;
}
Tcl_SetObjResult(interp,SWIG_NewPointerObj(ptr,type));
return TCL_OK;
}
/*------------------------------------------------------------------
ptrfree(ptr)
Destroys a pointer value
------------------------------------------------------------------ */
int ptrfree(Tcl_Interp *interp, char *ptrvalue) {
void *ptr, *junk;
char *s;
s = ptrvalue;
if (SWIG_ConvertPtrFromString(interp,ptrvalue,&ptr,0) != TCL_OK) {
Tcl_SetResult(interp,"Type error in ptrfree. Argument is not a valid pointer value.",TCL_STATIC);
return TCL_ERROR;
}
/* Check to see if this pointer is a char ** */
if (SWIG_ConvertPtrFromString(interp,ptrvalue,&junk,SWIG_POINTER_char_pp) == TCL_OK) {
char **c = (char **) ptr;
if (c) {
int i = 0;
while (c[i]) {
free(c[i]);
i++;
}
}
}
if (ptr)
free((char *) ptr);
return TCL_OK;
}
%}
%typemap(tcl8,out) int ptrcast,
int ptrvalue,
int ptrcreate,
int ptrset,
int ptradd,
int ptrfree
{
return $source;
}
%typemap(tcl8,ignore) Tcl_Interp * {
$target = interp;
}
int ptrvalue(Tcl_Interp *interp, char *ptr, int index = 0, char *type = 0);
// Returns the value that a pointer is pointing to (ie. dereferencing).
// The type is automatically inferred by the pointer type--thus, an
// integer pointer will return an integer, a double will return a double,
// and so on. The index and type fields are optional parameters. When
// an index is specified, this function returns the value of ptr[index].
// This allows array access. When a type is specified, it overrides
// the given pointer type. Examples :
//
// ptrvalue $a # Returns the value *a
// ptrvalue $a 10 # Returns the value a[10]
// ptrvalue $a 10 double # Returns a[10] assuming a is a double *
int ptrset(Tcl_Interp *interp, char *ptr, char *value, int index = 0, char *type = 0);
// Sets the value pointed to by a pointer. The type is automatically
// inferred from the pointer type so this function will work for
// integers, floats, doubles, etc... The index and type fields are
// optional. When an index is given, it provides array access. When
// type is specified, it overrides the given pointer type. Examples :
//
// ptrset $a 3 # Sets the value *a = 3
// ptrset $a 3 10 # Sets a[10] = 3
// ptrset $a 3 10 int # Sets a[10] = 3 assuming a is a int *
int ptrcreate(Tcl_Interp *interp, char *type, char *value = 0, int nitems = 1);
// Creates a new object and returns a pointer to it. This function
// can be used to create various kinds of objects for use in C functions.
// type specifies the basic C datatype to create and value is an
// optional parameter that can be used to set the initial value of the
// object. nitems is an optional parameter that can be used to create
// an array. This function results in a memory allocation using
// malloc(). Examples :
//
// set a [ptrcreate "double"] # Create a new double, return pointer
// set a [ptrcreate int 7] # Create an integer, set value to 7
// set a [ptrcreate int 0 1000] # Create an integer array with initial
// # values all set to zero
//
// This function only recognizes a few common C datatypes as listed below :
//
// int, short, long, float, double, char, char *, void
//
// All other datatypes will result in an error. However, other
// datatypes can be created by using the ptrcast function. For
// example:
//
// set a [ptrcast [ptrcreate int 0 100],"unsigned int *"]
int ptrfree(Tcl_Interp *interp, char *ptr);
// Destroys the memory pointed to by ptr. This function calls free()
// and should only be used with objects created by ptrcreate(). Since
// this function calls free, it may work with other objects, but this
// is generally discouraged unless you absolutely know what you're
// doing.
int ptradd(Tcl_Interp *interp, char *ptr, int offset);
// Adds a value to the current pointer value. For the C datatypes of
// int, short, long, float, double, and char, the offset value is the
// number of objects and works in exactly the same manner as in C. For
// example, the following code steps through the elements of an array
//
// set a [ptrcreate double 0 100] # Create an array double a[100]
// set b $a
// for {set i 0} {$i < 100} {incr i 1} {
// ptrset $b [expr{0.0025*$i}] # set *b = 0.0025*i
// set b [ptradd $b 1] # b++ (go to next double)
// }
//
// In this case, adding one to b goes to the next double.
//
// For all other datatypes (including all complex datatypes), the
// offset corresponds to bytes. This function does not perform any
// bounds checking and negative offsets are perfectly legal.

47
SWIG/Lib/tcl/std_string.i Normal file
View file

@ -0,0 +1,47 @@
//
// SWIG typemaps for std::string
// Luigi Ballabio and Manu ???
// Apr 26, 2002
//
// Tcl implementation
// ------------------------------------------------------------------------
// std::string is typemapped by value
// This can prevent exporting methods which return a string
// in order for the user to modify it.
// However, I think I'll wait until someone asks for it...
// ------------------------------------------------------------------------
%include exception.i
%{
#include <string>
%}
namespace std {
class string;
/* Overloading check */
%typemap(typecheck) string = char *;
%typemap(typecheck) const string & = char *;
%typemap(in) string {
$1 = std::string(Tcl_GetStringFromObj($input,NULL));
}
%typemap(in) const string & (std::string temp) {
temp = std::string(Tcl_GetStringFromObj($input,NULL));
$1 = &temp;
}
%typemap(out) string {
Tcl_SetStringObj($result,(char*)$1.c_str(),$1.length());
}
%typemap(out) const string & {
Tcl_SetStringObj($result,(char*)$1->c_str(),$1->length());
}
}

442
SWIG/Lib/tcl/std_vector.i Normal file
View file

@ -0,0 +1,442 @@
//
// SWIG typemaps for std::vector
// Luigi Ballabio and Manu ??? and Kristopher Blom
// Apr 26, 2002, updated Nov 13, 2002[blom]
//
// Tcl implementation
%include exception.i
// containers
// methods which can raise are caused to throw an IndexError
%exception std::vector::get {
try {
$action
} catch (std::out_of_range& e) {
SWIG_exception(SWIG_IndexError,const_cast<char*>(e.what()));
}
}
%exception std::vector::set {
try {
$action
} catch (std::out_of_range& e) {
SWIG_exception(SWIG_IndexError,const_cast<char*>(e.what()));
}
}
%exception std::vector::pop {
try {
$action
} catch (std::out_of_range& e) {
SWIG_exception(SWIG_IndexError,const_cast<char*>(e.what()));
}
}
// ------------------------------------------------------------------------
// std::vector
//
// The aim of all that follows would be to integrate std::vector with
// Tcl as much as possible, namely, to allow the user to pass and
// be returned Tcl lists.
// const declarations are used to guess the intent of the function being
// exported; therefore, the following rationale is applied:
//
// -- f(std::vector<T>), f(const std::vector<T>&), f(const std::vector<T>*):
// the parameter being read-only, either a Tcl list or a
// previously wrapped std::vector<T> can be passed.
// -- f(std::vector<T>&), f(std::vector<T>*):
// the parameter must be modified; therefore, only a wrapped std::vector
// can be passed.
// -- std::vector<T> f():
// the vector is returned by copy; therefore, a Tcl list of T:s
// is returned which is most easily used in other Tcl functions procs
// -- std::vector<T>& f(), std::vector<T>* f(), const std::vector<T>& f(),
// const std::vector<T>* f():
// the vector is returned by reference; therefore, a wrapped std::vector
// is returned
// ------------------------------------------------------------------------
%{
#include <vector>
#include <algorithm>
#include <stdexcept>
#include <string>
Tcl_Obj* SwigString_FromString(std::string s) {
return Tcl_NewStringObj(s.c_str(), s.length());
}
int SwigString_AsString(Tcl_Interp *interp, Tcl_Obj *o, std::string *val) {
int len;
const char* temp = Tcl_GetStringFromObj(o, &len);
if(temp == NULL)
return TCL_ERROR;
*val = temp;
}
// behaviour of this is such as the real Tcl_GetIntFromObj
template <typename Type>
int SwigInt_As(Tcl_Interp *interp, Tcl_Obj *o, Type *val) {
int temp_val, return_val;
return_val = Tcl_GetIntFromObj(interp, o, &temp_val);
*val = (Type) temp_val;
return return_val;
}
// behaviour of this is such as the real Tcl_GetDoubleFromObj
template <typename Type>
int SwigDouble_As(Tcl_Interp *interp, Tcl_Obj *o, Type *val) {
int return_val;
double temp_val;
return_val = Tcl_GetDoubleFromObj(interp, o, &temp_val);
*val = (Type) temp_val;
return return_val;
}
%}
// exported class
namespace std {
template<class T> class vector {
%typemap(in) vector<T> (std::vector<T> *v) {
Tcl_Obj **listobjv;
int nitems;
int i;
T* temp;
if (SWIG_ConvertPtr(interp, $input, (void **) &v, \
$&1_descriptor, 0) == 0){
$1 = *v;
} else {
// It isn't a vector<T> so it should be a list of T's
if(Tcl_ListObjGetElements(interp, $input, \
&nitems, &listobjv) == TCL_ERROR)
return TCL_ERROR;
$1 = std::vector<T>();
for (i = 0; i < nitems; i++) {
if ((SWIG_ConvertPtr(interp, listobjv[i],(void **) &temp,
$descriptor(T),0)) != 0) {
char message[] =
"list of type $descriptor(T) expected";
Tcl_SetResult(interp, message, TCL_VOLATILE);
return TCL_ERROR;
}
$1.push_back(*temp);
}
}
}
%typemap(in) const vector<T>* (std::vector<T> *v, std::vector<T> w),
const vector<T>& (std::vector<T> *v, std::vector<T> w) {
Tcl_Obj **listobjv;
int nitems;
int i;
T* temp;
if(SWIG_ConvertPtr(interp, $input, (void **) &v, \
$&1_descriptor, 0) == 0) {
$1 = v;
} else {
// It isn't a vector<T> so it should be a list of T's
if(Tcl_ListObjGetElements(interp, $input,
&nitems, &listobjv) == TCL_ERROR)
return TCL_ERROR;
w = std::vector<T>();
for (i = 0; i < nitems; i++) {
if ((SWIG_ConvertPtr(interp, listobjv[i],(void **) &temp,
$descriptor(T),0)) != 0) {
char message[] =
"list of type $descriptor(T) expected";
Tcl_SetResult(interp, message, TCL_VOLATILE);
return TCL_ERROR;
}
w.push_back(*temp);
}
$1 = &w;
}
}
%typemap(out) vector<T> {
for (unsigned int i=0; i<$1.size(); i++) {
T* ptr = new T((($1_type &)$1)[i]);
Tcl_ListObjAppendElement(interp, $result, \
SWIG_NewPointerObj(ptr,
$descriptor(T),
0));
}
}
%typecheck(SWIG_TYPECHECK_VECTOR) vector<T> {
Tcl_Obj **listobjv;
int nitems;
int i;
T* temp;
std::vector<T> *v;
if(SWIG_ConvertPtr(interp, $input, (void **) &v, \
$&1_descriptor, 0) == 0) {
/* wrapped vector */
$1 = 1;
} else {
// It isn't a vector<T> so it should be a list of T's
if(Tcl_ListObjGetElements(interp, $input,
&nitems, &listobjv) == TCL_ERROR)
$1 = 0;
else
if (nitems == 0)
$1 = 1;
//check the first value to see if it is of correct type
else if ((SWIG_ConvertPtr(interp, listobjv[i],
(void **) &temp,
$descriptor(T),0)) != 0)
$1 = 0;
else
$1 = 1;
}
}
%typecheck(SWIG_TYPECHECK_VECTOR) const vector<T>&,
const vector<T>* {
Tcl_Obj **listobjv;
int nitems;
int i;
T* temp;
std::vector<T> *v;
if(SWIG_ConvertPtr(interp, $input, (void **) &v, \
$1_descriptor, 0) == 0){
/* wrapped vector */
$1 = 1;
} else {
// It isn't a vector<T> so it should be a list of T's
if(Tcl_ListObjGetElements(interp, $input,
&nitems, &listobjv) == TCL_ERROR)
$1 = 0;
else
if (nitems == 0)
$1 = 1;
//check the first value to see if it is of correct type
else if ((SWIG_ConvertPtr(interp, listobjv[i],
(void **) &temp,
$descriptor(T),0)) != 0)
$1 = 0;
else
$1 = 1;
}
}
public:
vector();
vector(unsigned int size, const T& value=T());
vector(const vector<T> &);
unsigned int size() const;
bool empty() const;
void clear();
%rename(push) push_back;
void push_back(const T& x);
%extend {
T pop() {
if (self->size() == 0)
throw std::out_of_range("pop from empty vector");
T x = self->back();
self->pop_back();
return x;
}
T& get(int i) {
int size = int(self->size());
if (i<0) i += size;
if (i>=0 && i<size)
return (*self)[i];
else
throw std::out_of_range("vector index out of range");
}
void set(int i, const T& x) {
int size = int(self->size());
if (i<0) i+= size;
if (i>=0 && i<size)
(*self)[i] = x;
else
throw std::out_of_range("vector index out of range");
}
}
};
// specializations for built-ins
%define specialize_std_vector(T, CONVERT_FROM, CONVERT_TO)
template<> class vector<T> {
%typemap(in) vector<T> (std::vector<T> *v){
Tcl_Obj **listobjv;
int nitems;
int i;
T temp;
if(SWIG_ConvertPtr(interp, $input, (void **) &v, \
$&1_descriptor, 0) == 0) {
$1 = *v;
} else {
// It isn't a vector<T> so it should be a list of T's
if(Tcl_ListObjGetElements(interp, $input,
&nitems, &listobjv) == TCL_ERROR)
return TCL_ERROR;
$1 = std::vector<T>();
for (i = 0; i < nitems; i++) {
if (CONVERT_FROM(interp, listobjv[i], &temp) == TCL_ERROR)
return TCL_ERROR;
$1.push_back(temp);
}
}
}
%typemap(in) const vector<T>& (std::vector<T> *v,std::vector<T> w),
const vector<T>* (std::vector<T> *v,std::vector<T> w) {
Tcl_Obj **listobjv;
int nitems;
int i;
T temp;
if(SWIG_ConvertPtr(interp, $input, (void **) &v, \
$1_descriptor, 0) == 0) {
$1 = v;
} else {
// It isn't a vector<T> so it should be a list of T's
if(Tcl_ListObjGetElements(interp, $input,
&nitems, &listobjv) == TCL_ERROR)
return TCL_ERROR;
w = std::vector<T>();
for (i = 0; i < nitems; i++) {
if (CONVERT_FROM(interp, listobjv[i], &temp) == TCL_ERROR)
return TCL_ERROR;
w.push_back(temp);
}
$1 = &w;
}
}
%typemap(out) vector<T> {
for (unsigned int i=0; i<$1.size(); i++) {
Tcl_ListObjAppendElement(interp, $result, \
CONVERT_TO((($1_type &)$1)[i]));
}
}
%typecheck(SWIG_TYPECHECK_VECTOR) vector<T> {
Tcl_Obj **listobjv;
int nitems;
int i;
T temp;
std::vector<T> *v;
if(SWIG_ConvertPtr(interp, $input, (void **) &v, \
$&1_descriptor, 0) == 0){
/* wrapped vector */
$1 = 1;
} else {
// It isn't a vector<T> so it should be a list of T's
if(Tcl_ListObjGetElements(interp, $input,
&nitems, &listobjv) == TCL_ERROR)
$1 = 0;
else
if (nitems == 0)
$1 = 1;
//check the first value to see if it is of correct type
if (CONVERT_FROM(interp, listobjv[0], &temp) == TCL_ERROR)
$1 = 0;
else
$1 = 1;
}
}
%typecheck(SWIG_TYPECHECK_VECTOR) const vector<T>&,
const vector<T>*{
Tcl_Obj **listobjv;
int nitems;
int i;
T temp;
std::vector<T> *v;
if(SWIG_ConvertPtr(interp, $input, (void **) &v, \
$1_descriptor, 0) == 0){
/* wrapped vector */
$1 = 1;
} else {
// It isn't a vector<T> so it should be a list of T's
if(Tcl_ListObjGetElements(interp, $input,
&nitems, &listobjv) == TCL_ERROR)
$1 = 0;
else
if (nitems == 0)
$1 = 1;
//check the first value to see if it is of correct type
if (CONVERT_FROM(interp, listobjv[0], &temp) == TCL_ERROR)
$1 = 0;
else
$1 = 1;
}
}
public:
vector();
vector(unsigned int size, const T& value=T());
vector(const vector<T> &);
unsigned int size() const;
bool empty() const;
void clear();
%rename(push) push_back;
void push_back(T x);
%extend {
T pop() {
if (self->size() == 0)
throw std::out_of_range("pop from empty vector");
T x = self->back();
self->pop_back();
return x;
}
T get(int i) {
int size = int(self->size());
if (i<0) i += size;
if (i>=0 && i<size)
return (*self)[i];
else
throw std::out_of_range("vector index out of range");
}
void set(int i, T x) {
int size = int(self->size());
if (i<0) i+= size;
if (i>=0 && i<size)
(*self)[i] = x;
else
throw std::out_of_range("vector index out of range");
}
}
};
%enddef
specialize_std_vector(bool, Tcl_GetBoolFromObj, Tcl_NewBooleanObj);
specialize_std_vector(int, Tcl_GetIntFromObj,Tcl_NewIntObj);
specialize_std_vector(short, SwigInt_As<short>, Tcl_NewIntObj);
specialize_std_vector(long, SwigInt_As<long>, Tcl_NewIntObj);
specialize_std_vector(unsigned int,
SwigInt_As<unsigned int>, Tcl_NewIntObj);
specialize_std_vector(unsigned short,
SwigInt_As<unsigned short>, Tcl_NewIntObj);
specialize_std_vector(unsigned long,
SwigInt_As<unsigned long>, Tcl_NewIntObj);
specialize_std_vector(double, Tcl_GetDoubleFromObj, Tcl_NewDoubleObj);
specialize_std_vector(float, SwigDouble_As<float>, Tcl_NewDoubleObj);
specialize_std_vector(std::string,
SwigString_AsString, SwigString_FromString);
}

9
SWIG/Lib/tcl/stl.i Normal file
View file

@ -0,0 +1,9 @@
//
// SWIG typemaps for STL types
// Luigi Ballabio and Manu ???
// Apr 26, 2002
//
%include std_string.i
%include std_vector.i

706
SWIG/Lib/tcl/swigtcl8.swg
View file

@ -7,186 +7,430 @@
#include <tcl.h>
#include <stdlib.h>
#include <stdarg.h>
#include <ctype.h>
#ifdef __cplusplus
extern "C" {
#endif
/* Constant table */
#define SWIG_TCL_INT 1
#define SWIG_TCL_FLOAT 2
#define SWIG_TCL_STRING 3
#define SWIG_TCL_POINTER 4
#define SWIG_TCL_BINARY 5
/* Flags for pointer conversion */
#define SWIG_POINTER_EXCEPTION 0x1
#define SWIG_POINTER_DISOWN 0x2
/* Swig fail macro */
#define SWIG_fail goto fail
/* Constant information structure */
typedef struct swig_const_info {
int type;
char *name;
long lvalue;
double dvalue;
void *pvalue;
swig_type_info **ptype;
} swig_const_info;
typedef int (*swig_wrapper)(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []);
typedef int (*swig_wrapper_func)(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []);
typedef char *(*swig_variable_func)(ClientData, Tcl_Interp *, char *, char *, int);
typedef void (*swig_delete_func)(ClientData);
typedef struct swig_method {
const char *name;
swig_wrapper method;
} swig_method;
typedef struct swig_attribute {
const char *name;
swig_wrapper getmethod;
swig_wrapper setmethod;
} swig_attribute;
typedef struct swig_class {
const char *name;
swig_type_info **type;
swig_wrapper constructor;
void (*destructor)(void *);
swig_method *methods;
swig_attribute *attributes;
struct swig_class **bases;
} swig_class;
typedef struct swig_instance {
Tcl_Obj *thisptr;
void *thisvalue;
swig_class *classptr;
int destroy;
Tcl_Command cmdtok;
} swig_instance;
#ifdef SWIG_NOINCLUDE
SWIGEXPORT(int) SWIG_ConvertPtrFromString(Tcl_Interp *, char *, void **, swig_type_info *);
SWIGEXPORT(int) SWIG_ConvertPtr(Tcl_Interp *, Tcl_Obj *, void **, swig_type_info *);
SWIGEXPORT(void) SWIG_MakePtr(char *, void *, swig_type_info *);
SWIGEXPORT(Tcl_Obj *) SWIG_NewPointerObj(void *, swig_type_info *);
SWIGEXPORT(int) SWIG_GetArgs(Tcl_Interp *, int, Tcl_Obj *CONST [], const char *, ...);
SWIGEXPORT(char *) SWIG_PointerTypeFromString(char *c);
SWIGEXPORT(char *) SWIG_PackData(char *c, void *ptr, int sz);
SWIGEXPORT(char *) SWIG_UnpackData(char *c, void *ptr, int sz);
SWIGEXPORT(int) SWIG_ConvertPtrFromString(Tcl_Interp *, char *, void **, swig_type_info *,int flags);
SWIGEXPORT(int) SWIG_ConvertPtr(Tcl_Interp *, Tcl_Obj *, void **, swig_type_info *, int flags);
SWIGEXPORT(int) SWIG_ConvertPacked(Tcl_Interp *, Tcl_Obj *, void *, int sz, swig_type_info *, int flags);
SWIGEXPORT(void) SWIG_MakePtr(char *, void *, swig_type_info *, int flags);
SWIGEXPORT(Tcl_Obj *) SWIG_NewPointerObj(void *, swig_type_info *, int flags);
SWIGEXPORT(Tcl_Obj *) SWIG_NewPackedObj(void *, int sz, swig_type_info *, int flags);
SWIGEXPORT(int) SWIG_GetArgs(Tcl_Interp *, int, Tcl_Obj *CONST [], const char *, ...);
SWIGEXPORT(char *) SWIG_PointerTypeFromString(char *c);
SWIGEXPORT(void) SWIG_Acquire(void *ptr);
SWIGEXPORT(int) SWIG_Disown(void *ptr);
SWIGEXPORT(int) SWIG_Thisown(void *ptr);
SWIGEXPORT(void) SWIG_InstallConstants(Tcl_Interp *interp, struct swig_const_info constants[]);
SWIGEXPORT(Tcl_Obj *) SWIG_GetConstant(const char *key);
SWIGEXPORT(Tcl_Obj *) SWIG_NewInstanceObj(Tcl_Interp *interp, void *, swig_type_info *, int flags);
SWIGEXPORT(int) SWIG_ObjectConstructor(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]);
SWIGEXPORT(int) SWIG_MethodCommand(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]);
SWIGEXPORT(void) SWIG_ObjectDelete(ClientData);
#else
/* Object support */
static Tcl_HashTable swigobjectTable;
static int swigobjectTableinit = 0;
/* Acquire ownership of a pointer */
SWIGRUNTIME(void)
SWIG_Acquire(void *ptr)
{
Tcl_HashEntry *entryPtr;
int newobj;
if (!swigobjectTableinit) {
Tcl_InitHashTable(&swigobjectTable, TCL_ONE_WORD_KEYS);
swigobjectTableinit = 1;
}
entryPtr = Tcl_CreateHashEntry(&swigobjectTable, (char *) ptr, &newobj);
}
/* Disown a pointer. Returns 1 if we owned it to begin with */
SWIGRUNTIME(int)
SWIG_Disown(void *ptr)
{
Tcl_HashEntry *entryPtr;
if (!swigobjectTableinit) return 0;
entryPtr = Tcl_FindHashEntry(&swigobjectTable, (char *) ptr);
if (entryPtr) {
Tcl_DeleteHashEntry(entryPtr);
return 1;
}
return 0;
}
SWIGRUNTIME(int)
SWIG_Thisown(void *ptr) {
if (!swigobjectTableinit) return 0;
if (Tcl_FindHashEntry(&swigobjectTable, (char *) ptr)) {
return 1;
}
return 0;
}
/* Pack binary data into a string */
SWIGRUNTIME(char *)
SWIG_PackData(char *c, void *ptr, int sz) {
static char hex[17] = "0123456789abcdef";
int i;
unsigned char *u = (unsigned char *) ptr;
register unsigned char uu;
for (i = 0; i < sz; i++,u++) {
uu = *u;
*(c++) = hex[(uu & 0xf0) >> 4];
*(c++) = hex[uu & 0xf];
}
return c;
}
/* Unpack binary data from a string */
SWIGRUNTIME(char *)
SWIG_UnpackData(char *c, void *ptr, int sz) {
register unsigned char uu = 0;
register int d;
unsigned char *u = (unsigned char *) ptr;
int i;
if ((int)strlen(c) < (2*sz)) return c;
for (i = 0; i < sz; i++, u++) {
d = *(c++);
if ((d >= '0') && (d <= '9'))
uu = ((d - '0') << 4);
else if ((d >= 'a') && (d <= 'f'))
uu = ((d - ('a'-10)) << 4);
d = *(c++);
if ((d >= '0') && (d <= '9'))
uu |= (d - '0');
else if ((d >= 'a') && (d <= 'f'))
uu |= (d - ('a'-10));
*u = uu;
}
return c;
}
/* Convert a pointer value */
SWIGRUNTIME(int)
SWIG_ConvertPtrFromString(Tcl_Interp *interp, char *c, void **ptr, swig_type_info *ty)
SWIG_ConvertPtrFromString(Tcl_Interp *interp, char *c, void **ptr, swig_type_info *ty, int flags)
{
unsigned long p;
register int d;
swig_type_info *tc;
p = 0;
/* Pointer values must start with leading underscore */
if (*c != '_') {
while (*c != '_') {
*ptr = (void *) 0;
if (strcmp(c,"NULL") == 0) return TCL_OK;
Tcl_SetResult(interp,"Type error. Expected a pointer", TCL_STATIC);
/* Hmmm. It could be an object name. */
if (Tcl_VarEval(interp,c," cget -this", (char *) NULL) == TCL_OK) {
Tcl_Obj *result = Tcl_GetObjResult(interp);
c = Tcl_GetStringFromObj(result, NULL);
continue;
}
if (flags & SWIG_POINTER_EXCEPTION)
Tcl_SetResult(interp, (char *) "Type error. Expected a pointer", TCL_STATIC);
return TCL_ERROR;
}
c++;
/* Extract hex value from pointer */
while ((d = *c)) {
if ((d >= '0') && (d <= '9'))
p = (p << 4) + (d - '0');
else if ((d >= 'a') && (d <= 'f'))
p = (p << 4) + (d - ('a'-10));
else
break;
c++;
}
*ptr = (void *) p;
c = SWIG_UnpackData(c,ptr,sizeof(void *));
if (ty) {
tc = SWIG_TypeCheck(c,ty);
if (!tc) {
Tcl_SetResult(interp,"Type error. Expected ", TCL_STATIC);
Tcl_AppendElement(interp, ty->name);
if ((!tc) && (flags & SWIG_POINTER_EXCEPTION)) {
Tcl_SetResult(interp, (char *) "Type error. Expected ", TCL_STATIC);
Tcl_AppendElement(interp, (char *) ty->name);
return TCL_ERROR;
} else if (!tc) {
return TCL_ERROR;
}
*ptr = SWIG_TypeCast(tc,(void *)p);
if (flags & SWIG_POINTER_DISOWN) {
SWIG_Disown((void *) *ptr);
}
*ptr = SWIG_TypeCast(tc,(void *) *ptr);
}
return TCL_OK;
}
/* Convert a pointer value */
SWIGRUNTIME(int)
SWIG_ConvertPtr(Tcl_Interp *interp, Tcl_Obj *oc, void **ptr, swig_type_info *ty)
SWIG_ConvertPtr(Tcl_Interp *interp, Tcl_Obj *oc, void **ptr, swig_type_info *ty, int flags)
{
return SWIG_ConvertPtrFromString(interp, Tcl_GetStringFromObj(oc,NULL), ptr, ty);
return SWIG_ConvertPtrFromString(interp, Tcl_GetStringFromObj(oc,NULL), ptr, ty, flags);
}
/* Convert a pointer value */
SWIGRUNTIME(char *)
SWIG_PointerTypeFromString(char *c) {
char d;
/* Pointer values must start with leading underscore */
/* Pointer values must start with leading underscore. NULL has no type */
if (*c != '_') {
return 0;
}
c++;
/* Extract hex value from pointer */
while (d = *c) {
while ((d = *c)) {
if (!(((d >= '0') && (d <= '9')) || ((d >= 'a') && (d <= 'f')))) break;
c++;
}
return c;
}
/* Convert a packed value value */
SWIGRUNTIME(int)
SWIG_ConvertPacked(Tcl_Interp *interp, Tcl_Obj *obj, void *ptr, int sz, swig_type_info *ty, int flags) {
swig_type_info *tc;
char *c;
if (!obj) goto type_error;
c = Tcl_GetStringFromObj(obj,NULL);
/* Pointer values must start with leading underscore */
if (*c != '_') goto type_error;
c++;
c = SWIG_UnpackData(c,ptr,sz);
if (ty) {
tc = SWIG_TypeCheck(c,ty);
if (!tc) goto type_error;
}
return TCL_OK;
type_error:
if (flags) {
if (ty) {
Tcl_SetResult(interp, (char *) "Type error. Expected ", TCL_STATIC);
Tcl_AppendElement(interp, (char *) ty->name);
return TCL_ERROR;
} else {
Tcl_SetResult(interp, (char *) "Expected packed data.", TCL_STATIC);
return TCL_ERROR;
}
}
return TCL_ERROR;
}
/* Take a pointer and convert it to a string */
SWIGRUNTIME(void)
SWIG_MakePtr(char *c, void *ptr, swig_type_info *ty) {
static char hex[17] = "0123456789abcdef";
unsigned long p, s;
char result[24], *r;
r = result;
p = (unsigned long) ptr;
if (p > 0) {
while (p > 0) {
s = p & 0xf;
*(r++) = hex[s];
p = p >> 4;
}
*r = '_';
while (r >= result)
*(c++) = *(r--);
strcpy (c, ty->name);
SWIG_MakePtr(char *c, void *ptr, swig_type_info *ty, int flags) {
if (ptr) {
*(c++) = '_';
c = SWIG_PackData(c,&ptr,sizeof(void *));
strcpy(c,ty->name);
} else {
strcpy (c, "NULL");
strcpy(c,(char *)"NULL");
}
flags = 0;
}
/* Create a new pointer object */
SWIGRUNTIME(Tcl_Obj *)
SWIG_NewPointerObj(void *ptr, swig_type_info *type) {
char result[256];
SWIG_NewPointerObj(void *ptr, swig_type_info *type, int flags) {
Tcl_Obj *robj;
SWIG_MakePtr(result,ptr,type);
char result[512];
SWIG_MakePtr(result,ptr,type,flags);
robj = Tcl_NewStringObj(result,-1);
return robj;
}
SWIGRUNTIME(Tcl_Obj *)
SWIG_NewPackedObj(void *ptr, int sz, swig_type_info *type, int flags) {
char result[1024];
char *r = result;
if ((2*sz + 1 + strlen(type->name)) > 1000) return 0;
*(r++) = '_';
r = SWIG_PackData(r,ptr,sz);
strcpy(r,type->name);
flags = 0;
return Tcl_NewStringObj(result,-1);
}
static Tcl_HashTable swigconstTable;
static int swigconstTableinit = 0;
/* Install Constants */
SWIGRUNTIME(void)
SWIG_InstallConstants(Tcl_Interp *interp, swig_const_info constants[]) {
int i;
Tcl_Obj *obj;
Tcl_HashEntry *entryPtr;
int newobj;
if (!swigconstTableinit) {
Tcl_InitHashTable(&swigconstTable, TCL_STRING_KEYS);
swigconstTableinit = 1;
}
for (i = 0; constants[i].type; i++) {
switch(constants[i].type) {
case SWIG_TCL_INT:
obj = Tcl_NewIntObj(constants[i].lvalue);
break;
case SWIG_TCL_FLOAT:
obj = Tcl_NewDoubleObj(constants[i].dvalue);
break;
case SWIG_TCL_STRING:
obj = Tcl_NewStringObj((char *) constants[i].pvalue,-1);
break;
case SWIG_TCL_POINTER:
obj = SWIG_NewPointerObj(constants[i].pvalue, *(constants[i]).ptype,0);
break;
case SWIG_TCL_BINARY:
obj = SWIG_NewPackedObj(constants[i].pvalue, constants[i].lvalue, *(constants[i].ptype),0);
break;
default:
obj = 0;
break;
}
if (obj) {
Tcl_ObjSetVar2(interp,Tcl_NewStringObj(constants[i].name,-1), NULL, obj, TCL_GLOBAL_ONLY);
entryPtr = Tcl_CreateHashEntry(&swigconstTable, constants[i].name, &newobj);
Tcl_SetHashValue(entryPtr, (ClientData) obj);
}
}
}
SWIGRUNTIME(Tcl_Obj *)
SWIG_GetConstant(const char *key) {
Tcl_HashEntry *entryPtr;
if (!swigconstTableinit) return 0;
entryPtr = Tcl_FindHashEntry(&swigconstTable, key);
if (entryPtr) {
return (Tcl_Obj *) Tcl_GetHashValue(entryPtr);
}
printf("Searching %s\n", key);
return 0;
}
/* Get arguments */
SWIGRUNTIME(int)
SWIG_GetArgs(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], const char *fmt, ...)
{
int argno = 0, opt = 0, tempi;
int us = 0;
double tempd;
const char *c;
va_list ap;
void *vptr;
Tcl_Obj *obj = 0;
swig_type_info *ty;
va_start(ap,fmt);
for (c = fmt; (*c && (*c != ':')); c++,argno++) {
for (c = fmt; (*c && (*c != ':') && (*c != ';')); c++,argno++) {
if (*c == '|') {
opt = 1;
c++;
}
if (argno >= (objc-1)) {
if (!opt) {
Tcl_SetResult(interp,"Wrong # args. ", TCL_STATIC);
Tcl_SetResult(interp, (char *) "Wrong # args. ", TCL_STATIC);
goto argerror;
} else {
va_end(ap);
return TCL_OK;
}
}
vptr = va_arg(ap,void *);
if (vptr) {
us = 0;
if (*c == 'u') {
us = 1;
c++;
if (isupper(*c)) {
obj = SWIG_GetConstant(Tcl_GetStringFromObj(objv[argno+1],0));
if (!obj) obj = objv[argno+1];
} else {
obj = objv[argno+1];
}
switch(*c) {
case 'i':
case 'l':
case 'h':
case 'b':
if (Tcl_GetIntFromObj(interp,objv[argno+1],&tempi) != TCL_OK) goto argerror;
if (*c == 'i') *((int *)vptr) = tempi;
else if (*c == 'l') *((long *)vptr) = tempi;
else if (*c == 'h') *((short*)vptr) = tempi;
else if (*c == 'b') *((unsigned char *)vptr) = tempi;
case 'i': case 'I':
case 'l': case 'L':
case 'h': case 'H':
case 'b': case 'B':
if (Tcl_GetIntFromObj(interp,obj,&tempi) != TCL_OK) goto argerror;
if ((*c == 'i') || (*c == 'I')) *((int *)vptr) = tempi;
else if ((*c == 'l') || (*c == 'L')) *((long *)vptr) = tempi;
else if ((*c == 'h') || (*c == 'H')) *((short*)vptr) = tempi;
else if ((*c == 'b') || (*c == 'B')) *((unsigned char *)vptr) = tempi;
break;
case 'f':
case 'd':
if (Tcl_GetDoubleFromObj(interp,objv[argno+1],&tempd) != TCL_OK) goto argerror;
if (*c == 'f') *((float *) vptr) = tempd;
else if (*c == 'd') *((double*) vptr) = tempd;
case 'f': case 'F':
case 'd': case 'D':
if (Tcl_GetDoubleFromObj(interp,obj,&tempd) != TCL_OK) goto argerror;
if ((*c == 'f') || (*c == 'F')) *((float *) vptr) = (float)tempd;
else if ((*c == 'd') || (*c == 'D')) *((double*) vptr) = tempd;
break;
case 's':
case 's': case 'S':
if (*(c+1) == '#') {
int *vlptr = (int *) va_arg(ap, void *);
*((char **) vptr) = Tcl_GetStringFromObj(objv[argno+1], vlptr);
*((char **) vptr) = Tcl_GetStringFromObj(obj, vlptr);
c++;
} else {
*((char **)vptr) = Tcl_GetStringFromObj(objv[argno+1],NULL);
*((char **)vptr) = Tcl_GetStringFromObj(obj,NULL);
}
break;
case 'c':
*((char *)vptr) = *(Tcl_GetStringFromObj(objv[argno+1],NULL));
case 'c': case 'C':
*((char *)vptr) = *(Tcl_GetStringFromObj(obj,NULL));
break;
case 'p':
case 'p': case 'P':
ty = (swig_type_info *) va_arg(ap, void *);
if (SWIG_ConvertPtr(interp, objv[argno+1], (void **) vptr, ty) == TCL_ERROR) goto argerror;
if (SWIG_ConvertPtr(interp, obj, (void **) vptr, ty, SWIG_POINTER_EXCEPTION) == TCL_ERROR) goto argerror;
break;
case 'o':
case 'o': case 'O':
*((Tcl_Obj **)vptr) = objv[argno+1];
break;
default:
@ -194,8 +438,9 @@ SWIG_GetArgs(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], const char *fm
}
}
}
if ((objc-1) > argno) {
Tcl_SetResult(interp,"Wrong # args.", TCL_STATIC);
if ((*c != ';') && ((objc-1) > argno)) {
Tcl_SetResult(interp, (char *) "Wrong # args.", TCL_STATIC);
goto argerror;
}
va_end(ap);
@ -204,13 +449,298 @@ SWIG_GetArgs(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], const char *fm
argerror:
{
char temp[32];
sprintf(temp,"%d", argno);
Tcl_AppendResult(interp,strchr(fmt,':'), " argument ", temp, NULL);
sprintf(temp,"%d", argno+1);
c = strchr(fmt,':');
if (!c) c = strchr(fmt,';');
if (!c) c = (char *)"";
Tcl_AppendResult(interp,c," argument ", temp, NULL);
va_end(ap);
return TCL_ERROR;
}
}
SWIGRUNTIME(void)
SWIG_ObjectDelete(ClientData clientData) {
swig_instance *si = (swig_instance *) clientData;
if ((si) && (si->destroy) && (SWIG_Disown(si->thisvalue))) {
if (si->classptr->destructor) {
(si->classptr->destructor)(si->thisvalue);
}
}
Tcl_DecrRefCount(si->thisptr);
free(si);
}
/* Function to invoke object methods given an instance */
SWIGRUNTIME(int)
SWIG_MethodCommand(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST _objv[])
{
char *method, *attrname;
swig_instance *inst = (swig_instance *) clientData;
swig_method *meth;
swig_attribute *attr;
Tcl_Obj *oldarg;
Tcl_Obj **objv;
int rcode;
swig_class *cls;
swig_class *cls_stack[64];
int cls_stack_bi[64];
int cls_stack_top = 0;
int numconf = 2;
int bi;
objv = (Tcl_Obj **) _objv;
if (objc < 2) {
Tcl_SetResult(interp, (char *) "wrong # args.", TCL_STATIC);
return TCL_ERROR;
}
method = Tcl_GetStringFromObj(objv[1],NULL);
if (strcmp(method,"-acquire") == 0) {
inst->destroy = 1;
SWIG_Acquire(inst->thisvalue);
return TCL_OK;
}
if (strcmp(method,"-disown") == 0) {
if (inst->destroy) {
SWIG_Disown(inst->thisvalue);
}
inst->destroy = 0;
return TCL_OK;
}
if (strcmp(method,"-delete") == 0) {
Tcl_DeleteCommandFromToken(interp,inst->cmdtok);
return TCL_OK;
}
cls_stack[cls_stack_top] = inst->classptr;
cls_stack_bi[cls_stack_top] = -1;
cls = inst->classptr;
while (1) {
bi = cls_stack_bi[cls_stack_top];
cls = cls_stack[cls_stack_top];
if (bi != -1) {
cls = cls->bases[bi];
if (cls) {
cls_stack_bi[cls_stack_top]++;
cls_stack_top++;
cls_stack[cls_stack_top] = cls;
cls_stack_bi[cls_stack_top] = -1;
continue;
}
}
if (!cls) {
cls_stack_top--;
if (cls_stack_top < 0) break;
else continue;
}
cls_stack_bi[cls_stack_top]++;
meth = cls->methods;
/* Check for methods */
while (meth && meth->name) {
if (strcmp(meth->name,method) == 0) {
oldarg = objv[1];
objv[1] = inst->thisptr;
Tcl_IncrRefCount(inst->thisptr);
rcode = (*meth->method)(clientData,interp,objc,objv);
objv[1] = oldarg;
Tcl_DecrRefCount(inst->thisptr);
return rcode;
}
meth++;
}
/* Check class methods for a match */
if (strcmp(method,"cget") == 0) {
if (objc < 3) {
Tcl_SetResult(interp, (char *) "wrong # args.", TCL_STATIC);
return TCL_ERROR;
}
attrname = Tcl_GetStringFromObj(objv[2],NULL);
attr = cls->attributes;
while (attr && attr->name) {
if ((strcmp(attr->name, attrname) == 0) && (attr->getmethod)) {
oldarg = objv[1];
objv[1] = inst->thisptr;
Tcl_IncrRefCount(inst->thisptr);
rcode = (*attr->getmethod)(clientData,interp,2, objv);
objv[1] = oldarg;
Tcl_DecrRefCount(inst->thisptr);
return rcode;
}
attr++;
}
if (strcmp(attrname, "-this") == 0) {
Tcl_SetObjResult(interp, Tcl_DuplicateObj(inst->thisptr));
return TCL_OK;
}
if (strcmp(attrname, "-thisown") == 0) {
if (SWIG_Thisown(inst->thisvalue)) {
Tcl_SetResult(interp,(char*)"1",TCL_STATIC);
} else {
Tcl_SetResult(interp,(char*)"0",TCL_STATIC);
}
return TCL_OK;
}
} else if (strcmp(method, "configure") == 0) {
int i;
if (objc < 4) {
Tcl_SetResult(interp, (char *) "wrong # args.", TCL_STATIC);
return TCL_ERROR;
}
i = 2;
while (i < objc) {
attrname = Tcl_GetStringFromObj(objv[i],NULL);
attr = cls->attributes;
while (attr && attr->name) {
if ((strcmp(attr->name, attrname) == 0) && (attr->setmethod)) {
oldarg = objv[i];
objv[i] = inst->thisptr;
Tcl_IncrRefCount(inst->thisptr);
rcode = (*attr->setmethod)(clientData,interp,3, &objv[i-1]);
objv[i] = oldarg;
Tcl_DecrRefCount(inst->thisptr);
if (rcode != TCL_OK) return rcode;
numconf += 2;
}
attr++;
}
i+=2;
}
}
}
if (strcmp(method,"configure") == 0) {
if (numconf >= objc) {
return TCL_OK;
} else {
Tcl_SetResult(interp,(char *) "Invalid attribute name.", TCL_STATIC);
return TCL_ERROR;
}
}
if (strcmp(method,"cget") == 0) {
Tcl_SetResult(interp,(char *) "Invalid attribute name.", TCL_STATIC);
return TCL_ERROR;
}
Tcl_SetResult(interp, (char *) "Invalid method. Must be one of: configure cget -acquire -disown -delete", TCL_STATIC);
cls = inst->classptr;
bi = 0;
while (cls) {
meth = cls->methods;
while (meth && meth->name) {
char *cr = (char *) Tcl_GetStringResult(interp);
if (!strstr(strchr(cr,':'), meth->name))
Tcl_AppendElement(interp, (char *) meth->name);
meth++;
}
cls = inst->classptr->bases[bi++];
}
return TCL_ERROR;
}
/* Function to create objects */
SWIGRUNTIME(int)
SWIG_ObjectConstructor(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
Tcl_Obj *newObj = 0;
void *thisvalue = 0;
swig_instance *newinst = 0;
swig_class *classptr = (swig_class *) clientData;
swig_wrapper cons = 0;
char *name = 0;
int firstarg = 0;
int thisarg = 0;
int destroy = 1;
if (!classptr) {
Tcl_SetResult(interp, (char *) "swig: internal runtime error. No class object defined.", TCL_STATIC);
return TCL_ERROR;
}
cons = classptr->constructor;
if (objc > 1) {
char *s = Tcl_GetStringFromObj(objv[1],NULL);
if (strcmp(s,"-this") == 0) {
thisarg = 2;
cons = 0;
} else if (strcmp(s,"-args") == 0) {
firstarg = 1;
} else if (objc == 2) {
firstarg = 1;
name = s;
} else if (objc >= 3) {
char *s1;
name = s;
s1 = Tcl_GetStringFromObj(objv[2],NULL);
if (strcmp(s1,"-this") == 0) {
thisarg = 3;
cons = 0;
} else {
firstarg = 1;
}
}
}
if (cons) {
int result;
result = (*cons)(0, interp, objc-firstarg, &objv[firstarg]);
if (result != TCL_OK) {
return result;
}
newObj = Tcl_DuplicateObj(Tcl_GetObjResult(interp));
if (!name) name = Tcl_GetStringFromObj(newObj,NULL);
} else if (thisarg > 0) {
if (thisarg < objc) {
destroy = 0;
newObj = Tcl_DuplicateObj(objv[thisarg]);
if (!name) name = Tcl_GetStringFromObj(newObj,NULL);
} else {
Tcl_SetResult(interp, (char *) "wrong # args.", TCL_STATIC);
return TCL_ERROR;
}
} else {
Tcl_SetResult(interp, (char *) "No constructor available.", TCL_STATIC);
return TCL_ERROR;
}
if (SWIG_ConvertPtr(interp,newObj, (void **) &thisvalue, *(classptr->type), SWIG_POINTER_EXCEPTION) == TCL_ERROR) {
Tcl_DecrRefCount(newObj);
return TCL_ERROR;
}
newinst = (swig_instance *) malloc(sizeof(swig_instance));
newinst->thisptr = newObj;
Tcl_IncrRefCount(newObj);
newinst->thisvalue = thisvalue;
newinst->classptr = classptr;
newinst->destroy = destroy;
if (destroy) {
SWIG_Acquire(thisvalue);
}
newinst->cmdtok = Tcl_CreateObjCommand(interp,name, (swig_wrapper) SWIG_MethodCommand, (ClientData) newinst, (swig_delete_func) SWIG_ObjectDelete);
return TCL_OK;
}
/* This function takes the current result and turns it into an object command */
SWIGRUNTIME(Tcl_Obj *)
SWIG_NewInstanceObj(Tcl_Interp *interp, void *thisvalue, swig_type_info *type, int flags) {
Tcl_Obj *robj = SWIG_NewPointerObj(thisvalue, type,0);
/* Check to see if this pointer belongs to a class or not */
if ((type->clientdata) && (interp)) {
Tcl_CmdInfo ci;
char *name;
name = Tcl_GetStringFromObj(robj,NULL);
if (!Tcl_GetCommandInfo(interp,name, &ci) || (flags)) {
swig_instance *newinst = (swig_instance *) malloc(sizeof(swig_instance));
newinst->thisptr = Tcl_DuplicateObj(robj);
Tcl_IncrRefCount(newinst->thisptr);
newinst->thisvalue = thisvalue;
newinst->classptr = (swig_class *) type->clientdata;
newinst->destroy = flags;
newinst->cmdtok = Tcl_CreateObjCommand(interp, Tcl_GetStringFromObj(robj,NULL), (swig_wrapper_func) SWIG_MethodCommand, (ClientData) newinst, (swig_delete_func) SWIG_ObjectDelete);
if (flags) {
SWIG_Acquire(thisvalue);
}
}
}
return robj;
}
#endif
/* Structure for command table */
@ -228,8 +758,10 @@ typedef struct {
char * (*set)(ClientData, Tcl_Interp *, char *, char *, int);
} swig_var_info;
#ifdef __cplusplus
}
#endif

594
SWIG/Lib/tcl/tcl8.swg
View file

@ -4,5 +4,595 @@
* Tcl8 configuration module.
* ----------------------------------------------------------------------------- */
%insert(runtime) "common.swg";
%insert(runtime) "swigtcl8.swg";
%runtime "common.swg"
%runtime "swigtcl8.swg"
/* -----------------------------------------------------------------------------
* --- standard typemaps ---
* ----------------------------------------------------------------------------- */
/* Input arguments */
/* For primitive types, the Tcl module uses a special function
SWIG_GetArgs(Tcl_Interp *, int objc, Tcl_Obj *CONST objv[], const char *fmt, ...)
The fmt field contains special conversion characters i,h,l,b,f,d,c,p, and o
that are used to marshal different types. The parse codes below correspond
to these special codes */
%typemap(in,parse="i") int, unsigned int "";
%typemap(in,parse="h") short, unsigned short "";
%typemap(in,parse="l") long, unsigned long "";
%typemap(in,parse="b") signed char, unsigned char "";
%typemap(in,parse="f") float "";
%typemap(in,parse="d") double "";
%typemap(in,parse="c") char "";
%typemap(in,parse="s") char *, char [ANY] "";
/* Pointers */
%typemap(in) SWIGTYPE *, SWIGTYPE &, SWIGTYPE []
"if ((SWIG_ConvertPtr(interp, $input, (void **) &$1, $1_descriptor,SWIG_POINTER_EXCEPTION | $disown) != TCL_OK)) SWIG_fail;";
/* For bools, we first convert to an integer and then to a bool. There
is no guarantee that a bool is the same size as an int so we have to do this */
%typemap(in) bool (int tempb) "if (Tcl_GetIntFromObj(interp,$input,&tempb) == TCL_ERROR) SWIG_fail;
$1 = (bool) tempb;";
/* These will pass an integer as an unsigned long. However, the implementation is crippled due
to limited precision in Tcl */
%typemap(in) long long "$1 = (long long) strtoll(Tcl_GetStringFromObj($input,NULL),0,0);";
%typemap(in) unsigned long long "$1 = (unsigned long long) strtoull(Tcl_GetStringFromObj($input,NULL), 0, 0);";
/* Enum parsing. Note: internally SWIG converts enums to/from integers so it's okay to use
the "i" parse code here */
%typemap(in,parse="i") enum SWIGTYPE "";
/* Unknown type. We convert from a pointer */
%typemap(in) SWIGTYPE ($&1_ltype argp)
"if ((SWIG_ConvertPtr(interp, $input, (void **) &argp, $&1_descriptor,SWIG_POINTER_EXCEPTION ) != TCL_OK)) SWIG_fail;
$1 = *argp; ";
/* Special constant variations. These typemaps can be used to parse objects that are both constants
or values. A Hash table lookup will occur. */
%typemap(in,parse="I") int CONSTANT, unsigned int CONSTANT "";
%typemap(in,parse="H") short CONSTANT, unsigned short CONSTANT "";
%typemap(in,parse="L") long CONSTANT, unsigned long CONSTANT "";
%typemap(in,parse="B") signed char CONSTANT, unsigned char CONSTANT "";
%typemap(in,parse="F") float CONSTANT "";
%typemap(in,parse="D") double CONSTANT "";
%typemap(in,parse="C") char CONSTANT "";
%typemap(in,parse="S") char * CONSTANT "";
%typemap(in,parse="P") SWIGTYPE *CONSTANT, SWIGTYPE &CONSTANT, SWIGTYPE CONSTANT [] "";
%typemap(in,parse="I") enum SWIGTYPE CONSTANT "";
/* Constant references. Passed by value */
/* Const primitive references. Passed by value */
%typemap(in) const int & (int temp),
const short & (short temp),
const long & (long temp),
const unsigned int & (unsigned int temp),
const unsigned short & (unsigned short temp),
const unsigned long & (unsigned long temp),
const signed char & (signed char temp),
const unsigned char & (unsigned char temp),
const bool & (bool temp)
{
long ltemp;
if (Tcl_GetLongFromObj(interp, $input, &ltemp) != TCL_OK) {
SWIG_fail;
}
temp = ($*1_ltype) ltemp;
$1 = &temp;
}
%typemap(in) const float & (float temp),
const double & (double temp)
{
double dtemp;
if (Tcl_GetDoubleFromObj(interp, $input, &dtemp) != TCL_OK) {
SWIG_fail;
}
temp = ($*1_ltype) dtemp;
$1 = &temp;
}
%typemap(in) const long long & (long long temp)
"temp = (long long) strtoll(Tcl_GetStringFromObj($input,NULL),0,0);
$1 = &temp;";
%typemap(in) const unsigned long long & (unsigned long long temp)
"temp = (unsigned long long) strtoull(Tcl_GetStringFromObj($input,NULL),0,0);
$1 = &temp;";
%typemap(in) const char &(char temp) {
char *stemp = Tcl_GetStringFromObj($input,NULL);
temp = *stemp;
$1 = &temp;
}
/* Output values */
%typemap(out) bool, int, unsigned int, short, unsigned short, long, unsigned long, signed char, unsigned char, enum SWIGTYPE
"Tcl_SetObjResult(interp,Tcl_NewIntObj((long) $1));";
%typemap(out) long long {
char temp[256];
sprintf(temp,"%lld", $1);
Tcl_SetObjResult(interp,Tcl_NewStringObj(temp,-1));
}
%typemap(out) unsigned long long {
char temp[256];
sprintf(temp,"%llu", $1);
Tcl_SetObjResult(interp,Tcl_NewStringObj(temp,-1));
}
%typemap(out) char
"Tcl_SetObjResult(interp,Tcl_NewStringObj(&$1,1));";
%typemap(out) float, double
"Tcl_SetObjResult(interp,Tcl_NewDoubleObj((double) $1));";
%typemap(out) char *
"Tcl_SetObjResult(interp,Tcl_NewStringObj($1,-1));";
%typemap(out) SWIGTYPE *, SWIGTYPE &, SWIGTYPE []
"Tcl_SetObjResult(interp,SWIG_NewPointerObj((void *) $1, $1_descriptor,0));";
%typemap(out) SWIGTYPE *DYNAMIC, SWIGTYPE &DYNAMIC {
swig_type_info *ty = SWIG_TypeDynamicCast($1_descriptor,(void **) &$1);
Tcl_SetObjResult(interp,SWIG_NewPointerObj((void *) $1, ty,0));
}
%typemap(out) SWIGTYPE *INSTANCE, SWIGTYPE &INSTANCE, SWIGTYPE INSTANCE[]
"Tcl_SetObjResult(interp,SWIG_NewInstanceObj(interp, (void *) $1, $1_descriptor,0));";
%typemap(out) SWIGTYPE *, SWIGTYPE &, SWIGTYPE []
"Tcl_SetObjResult(interp,SWIG_NewInstanceObj(interp, (void *) $1, $1_descriptor,0));";
%typemap(out) void "";
/* Primitive types--return by value */
%typemap(out) SWIGTYPE NOINSTANCE
#ifdef __cplusplus
{
$&1_ltype resultptr;
resultptr = new $1_ltype(($1_ltype &) $1);
Tcl_SetObjResult(interp,SWIG_NewPointerObj((void*) resultptr, $&1_descriptor,0));
}
#else
{
$&1_ltype resultptr;
resultptr = ($&1_ltype) malloc(sizeof($1_type));
memmove(resultptr, &$1, sizeof($1_type));
Tcl_SetObjResult(interp,SWIG_NewPointerObj((void*) resultptr, $&1_descriptor,0));
}
#endif
/* Primitive types--return by value */
%typemap(out) SWIGTYPE INSTANCE
#ifdef __cplusplus
{
$&1_ltype resultptr;
resultptr = new $1_ltype(($1_ltype &) $1);
Tcl_SetObjResult(interp,SWIG_NewInstanceObj(interp,(void*) resultptr, $&1_descriptor,1));
}
#else
{
$&1_ltype resultptr;
resultptr = ($&1_ltype) malloc(sizeof($1_type));
memmove(resultptr, &$1, sizeof($1_type));
Tcl_SetObjResult(interp,SWIG_NewInstanceObj(interp,(void*) resultptr, $&1_descriptor,1));
}
#endif
%typemap(out) SWIGTYPE = SWIGTYPE INSTANCE;
/* Special typemap for character array returns */
%typemap(out) char [ANY] "Tcl_SetObjResult(interp,Tcl_NewStringObj($1,-1));"
/* Primitive references */
%typemap(out) const int &, const unsigned int &,
const short &, const unsigned short &,
const long &, const unsigned long &,
const signed char &, const unsigned char &,
const bool &
"Tcl_SetObjResult(interp,Tcl_NewIntObj((long) *($1)));";
%typemap(out) const float &, const double &
"Tcl_SetObjResult(interp,Tcl_NewDoubleObj((double) *($1)));";
%typemap(out) const long long & {
char temp[256];
sprintf(temp,"%lld", *($1));
Tcl_SetObjResult(interp,Tcl_NewStringObj(temp,-1));
}
%typemap(out) const unsigned long long &
{
char temp[256];
sprintf(temp,"%llu", *($1));
Tcl_SetObjResult(interp,Tcl_NewStringObj(temp,-1));
}
%typemap(out) const char &
"Tcl_SetObjResult(interp,Tcl_NewStringObj($1,1));";
/* --- Variable output --- */
%typemap(varout) int, unsigned int, short, unsigned short, long, unsigned long, signed char, unsigned char, bool, enum SWIGTYPE
"$result = Tcl_NewIntObj((long) $1);";
%typemap(varout) long long {
char temp[256];
sprintf(temp,"%lld", $1);
$result = Tcl_NewStringObj(temp,-1);
}
%typemap(varout) unsigned long long {
char temp[256];
sprintf(temp,"%llu", $1);
$result = Tcl_NewStringObj(temp,-1);
}
%typemap(varout) double,float "$result = Tcl_NewDoubleObj((double) $1);";
%typemap(varout) char * "$result = Tcl_NewStringObj((char*) $1,-1);";
%typemap(varout) char [ANY] "$result = Tcl_NewStringObj((char *) $1,-1);";
%typemap(varout) char "$result = Tcl_NewStringObj(&$1,1);";
%typemap(varout) SWIGTYPE *, SWIGTYPE &, SWIGTYPE [] "$result = SWIG_NewPointerObj((void *) $1, $1_descriptor,0);";
%typemap(varout) SWIGTYPE *INSTANCE, SWIGTYPE &INSTANCE, SWIGTYPE INSTANCE[]
"$result = SWIG_NewInstanceObj(interp, (void *) $1, $1_descriptor,0);";
%typemap(varout) SWIGTYPE "$result = SWIG_NewPointerObj((void *) &$1, $&1_descriptor,0);";
%typemap(varout) SWIGTYPE INSTANCE "$result = SWIG_NewInstanceObj(interp, (void *) &$1, $&1_descriptor,0);";
%typemap(varout) SWIGTYPE "$result = SWIG_NewInstanceObj(interp, (void *) &$1, $&1_descriptor,0);";
/* -- Variable input --- */
%typemap(varin) int, unsigned int, short, unsigned short, long, unsigned long, signed char, unsigned char, bool, enum SWIGTYPE
{
long temp;
if (Tcl_GetLongFromObj(interp, $input, &temp) != TCL_OK) {
return (char*) "Type error. expected an integer";
}
$1 = ($1_type) temp;
}
%typemap(varin) long long "$1 = (long long) strtoll(Tcl_GetStringFromObj($input,NULL),0,0);";
%typemap(varin) unsigned long long "$1 = (unsigned long long) strtoull(Tcl_GetStringFromObj($input,NULL),0,0);";
%typemap(varin) double, float {
double temp;
if (Tcl_GetDoubleFromObj(interp, $input, &temp) != TCL_OK) {
return (char*) "Type error. expected a double.";
}
$1 = ($1_type) temp;
}
%typemap(varin) char *
#ifdef __cplusplus
{
char *temp = Tcl_GetStringFromObj($input,NULL);
if ($1) delete [] $1;
$1 = ($1_type) new char[strlen(temp)+1];
strcpy((char *) $1,temp);
}
#else
{
char *temp = Tcl_GetStringFromObj($input,NULL);
if ($1) free((char*)$1);
$1 = ($1_type) malloc(strlen(temp)+1);
strcpy((char *) $1,temp);
}
#endif
%typemap(varin,warning="451:Setting const char * variable may leak memory") const char *
#ifdef __cplusplus
{
char *temp = Tcl_GetStringFromObj($input,NULL);
$1 = ($1_type) new char[strlen(temp)+1];
strcpy((char *) $1,temp);
}
#else
{
char *temp = Tcl_GetStringFromObj($input,NULL);
$1 = ($1_type) malloc(strlen(temp)+1);
strcpy((char *) $1,temp);
}
#endif
%typemap(varin) char [ANY] {
char *temp = Tcl_GetStringFromObj($input,NULL);
strncpy((char*)$1,temp,$1_dim0);
}
%typemap(varin) char
{
char *temp = Tcl_GetStringFromObj($input,NULL);
$1 = *temp;
}
%typemap(varin) SWIGTYPE * {
void *temp;
if (SWIG_ConvertPtr(interp,$input,&temp,$1_descriptor, SWIG_POINTER_EXCEPTION | SWIG_POINTER_DISOWN) != TCL_OK) {
return (char*)"Type error. Expected $1_ltype";
}
$1 = ($1_type) temp;
}
%typemap(varin) void * {
void *temp;
if (SWIG_ConvertPtr(interp,$input,&temp,0, SWIG_POINTER_EXCEPTION | SWIG_POINTER_DISOWN) != TCL_OK) {
return (char*)"Type error. Expected $1_ltype";
}
$1 = ($1_type) temp;
}
%typemap(varin) SWIGTYPE & {
void *temp;
if (SWIG_ConvertPtr(interp,$input,&temp,$1_descriptor, SWIG_POINTER_EXCEPTION) != TCL_OK) {
return (char*)"Type error. Expected $1_ltype";
}
$1 = *(($&1_type) temp);
}
%typemap(varin) SWIGTYPE {
void *temp;
if (SWIG_ConvertPtr(interp,$input,&temp,$&1_descriptor, SWIG_POINTER_EXCEPTION) != TCL_OK) {
return (char*)"Type error. Expected $&1_ltype";
}
$1 = *(($&1_type) temp);
}
%typemap(varin) SWIGTYPE [] {
void *temp;
if (SWIG_ConvertPtr(interp,$input,&temp,$1_descriptor, SWIG_POINTER_EXCEPTION) != TCL_OK) {
return (char *)"Type error. Expected $1_ltype";
}
memmove((void *) $1,temp,$1_size*sizeof($1_basetype));
}
/* --- Constants --- */
%typemap(consttab) int, unsigned int, short, unsigned short, long, unsigned long, unsigned char, signed char, bool, enum SWIGTYPE
{ SWIG_TCL_INT, (char *)"$symname", (long) $value, 0, 0, 0}
%typemap(consttab) float, double
{ SWIG_TCL_FLOAT, (char*)"$symname", 0, (double) $value, 0, 0}
%typemap(consttab) char, char *
{ SWIG_TCL_STRING, (char*)"$symname", 0, 0, (void *)"$value", 0}
%typemap(consttab) long long, unsigned long long
{ SWIG_TCL_STRING, (char *) "$symname", 0, 0, (void *)"$value", 0}
%typemap(consttab) SWIGTYPE *, SWIGTYPE &, SWIGTYPE []
{ SWIG_TCL_POINTER, (char*)"$symname", 0, 0, (void *)$value, &$1_descriptor}
%typemap(consttab) SWIGTYPE (CLASS::*)
{ SWIG_TCL_BINARY, (char *)"$symname", sizeof($type), 0, (void *)&$value, &$1_descriptor}
/* ------------------------------------------------------------
* String & length
* ------------------------------------------------------------ */
%typemap(in) (char *STRING, int LENGTH) {
int temp;
$1 = ($1_ltype) Tcl_GetStringFromObj($input,&temp);
$2 = ($2_ltype) temp;
}
/* ------------------------------------------------------------
* ANSI C typemaps
* ------------------------------------------------------------ */
%typemap(in) size_t (int temp) "if (Tcl_GetIntFromObj(interp,$input,&temp) == TCL_ERROR) return TCL_ERROR;
$1 = (size_t) temp;";
%typemap(out) size_t = long;
%typemap(varin) size_t = long;
%typemap(varout) size_t = long;
%typemap(consttab) size_t = long;
/* ------------------------------------------------------------
* Typechecking rules
* ------------------------------------------------------------ */
%typecheck(SWIG_TYPECHECK_INTEGER)
int, short, long,
unsigned int, unsigned short, unsigned long,
signed char, unsigned char,
long long, unsigned long long,
const int &, const short &, const long &,
const unsigned int &, const unsigned short &, const unsigned long &,
const long long &, const unsigned long long &,
enum SWIGTYPE,
bool, const bool &
{
long tmp;
if (Tcl_GetLongFromObj(NULL,$input,&tmp) == TCL_ERROR) $1 = 0;
else $1 = 1;
}
%typecheck(SWIG_TYPECHECK_DOUBLE)
float, double,
const float &, const double &
{
double tmp;
if (Tcl_GetDoubleFromObj(NULL,$input,&tmp) == TCL_ERROR) $1 = 0;
else $1 = 1;
}
%typecheck(SWIG_TYPECHECK_CHAR) char {
char *tmp;
int len;
tmp = Tcl_GetStringFromObj($input,&len);
(len == 1) ? 1 : 0;
}
%typecheck(SWIG_TYPECHECK_STRING) char * {
$1 = 1;
}
%typecheck(SWIG_TYPECHECK_POINTER) SWIGTYPE *, SWIGTYPE &, SWIGTYPE [] {
void *ptr;
if (SWIG_ConvertPtr(interp, $input, (void **) &ptr, $1_descriptor, 0) == TCL_ERROR) {
$1 = 0;
} else {
$1 = 1;
}
}
%typecheck(SWIG_TYPECHECK_POINTER) SWIGTYPE {
void *ptr;
if (SWIG_ConvertPtr(interp, $input, (void **) &ptr, $&1_descriptor, 0) == TCL_ERROR) {
$1 = 0;
} else {
$1 = 1;
}
}
%typecheck(SWIG_TYPECHECK_VOIDPTR) void * {
void *ptr;
if (SWIG_ConvertPtr(interp, $input, (void **) &ptr, 0, 0) == TCL_ERROR) {
$1 = 0;
} else {
$1 = 1;
}
}
/* ------------------------------------------------------------
* Exception handling
* ------------------------------------------------------------ */
%typemap(throws) int,
long,
short,
unsigned int,
unsigned long,
unsigned short {
Tcl_SetObjResult(interp, Tcl_NewIntObj((long) $1));
SWIG_fail;
}
%typemap(throws) SWIGTYPE CLASS {
$&1_ltype temp = new $1_ltype($1);
Tcl_SetObjResult(interp, SWIG_NewInstanceObj(interp, (void *) temp, $&1_descriptor, 1));
SWIG_fail;
}
%typemap(throws) SWIGTYPE {
Tcl_SetObjResult(interp, Tcl_NewStringObj((char*) "$1_type", -1));
SWIG_fail;
}
%typemap(throws) char * {
Tcl_SetObjResult(interp, Tcl_NewStringObj((char*) $1, -1));
SWIG_fail;
}
// Some special reserved words in classes
%namewarn("314:cget is a reserved method name") *::cget;
%namewarn("314:configure is a reserved method name") *::configure;
/* C++ overloaded operators.
These declarations define how SWIG is going to rename C++
overloaded operators in Tcl. Since Tcl allows identifiers
to be essentially any valid string, we'll just use the
normal operator names */
#ifdef __cplusplus
%rename("+") *::operator+;
//%rename("u+") *::operator+(); // Unary +
//%rename("u+") *::operator+() const; // Unary +
%rename("-") *::operator-;
//%rename("u-") *::operator-(); // Unary -
//%rename("u-") *::operator-() const; // Unary -
%rename("*") *::operator*;
%rename("/") *::operator/;
%rename("<<") *::operator<<;
%rename(">>") *::operator>>;
%rename("&") *::operator&;
%rename("|") *::operator|;
%rename("^") *::operator^;
%rename("%") *::operator%;
%rename("=") *::operator=;
#endif
/* This initialization code exports the module initialization function */
%header %{
#ifdef __cplusplus
extern "C" {
#endif
#ifdef MAC_TCL
#pragma export on
#endif
SWIGEXPORT(int) SWIG_init(Tcl_Interp *);
#ifdef MAC_TCL
#pragma export off
#endif
#ifdef __cplusplus
}
#endif
%}
/* Start the initialization function */
%init %{
SWIGEXPORT(int) SWIG_init(Tcl_Interp *interp) {
int i;
static int _init = 0;
if (interp == 0) return TCL_ERROR;
#ifdef USE_TCL_STUBS
if (Tcl_InitStubs(interp, (char*)"8.1", 0) == NULL) {
return TCL_ERROR;
}
#endif
Tcl_PkgProvide(interp, (char*)SWIG_name, (char*)SWIG_version);
#ifdef SWIG_namespace
Tcl_Eval(interp, "namespace eval " SWIG_namespace " { }");
#endif
if (!_init) {
for (i = 0; swig_types_initial[i]; i++) {
swig_types[i] = SWIG_TypeRegister(swig_types_initial[i]);
}
_init = 1;
}
for (i = 0; swig_commands[i].name; i++) {
Tcl_CreateObjCommand(interp, (char *) swig_commands[i].name, (swig_wrapper_func) swig_commands[i].wrapper, swig_commands[i].clientdata, NULL);
}
for (i = 0; swig_variables[i].name; i++) {
Tcl_SetVar(interp, (char *) swig_variables[i].name, (char *) "", TCL_GLOBAL_ONLY);
Tcl_TraceVar(interp, (char *) swig_variables[i].name, TCL_TRACE_READS | TCL_GLOBAL_ONLY, (Tcl_VarTraceProc *) swig_variables[i].get, (ClientData) swig_variables[i].addr);
Tcl_TraceVar(interp, (char *) swig_variables[i].name, TCL_TRACE_WRITES | TCL_GLOBAL_ONLY, (Tcl_VarTraceProc *) swig_variables[i].set, (ClientData) swig_variables[i].addr);
}
SWIG_InstallConstants(interp, swig_constants);
%}
/* Note: the initialization function is closed after all code is generated */

4
SWIG/Lib/tcl/tclsh.i
View file

@ -48,12 +48,12 @@ int Tcl_AppInit(Tcl_Interp *interp){
if (SWIG_init(interp) == TCL_ERROR)
return TCL_ERROR;
#if TCL_MAJOR_VERSION > 7 || TCL_MAJOR_VERSION == 7 && TCL_MINOR_VERSION >= 5
Tcl_SetVar(interp,"tcl_rcFileName",SWIG_RcFileName,TCL_GLOBAL_ONLY);
Tcl_SetVar(interp, (char *) "tcl_rcFileName",SWIG_RcFileName,TCL_GLOBAL_ONLY);
#else
tcl_RcFileName = SWIG_RcFileName;
#endif
#ifdef SWIG_RcRsrcName
Tcl_SetVar(interp,"tcl_rcRsrcName",SWIG_RcRsrcName,TCL_GLOBAL);
Tcl_SetVar(interp, (char *) "tcl_rcRsrcName",SWIG_RcRsrcName,TCL_GLOBAL);
#endif
return TCL_OK;

340
SWIG/Lib/tcl/typemaps.i
View file

@ -8,35 +8,19 @@
*
* ----------------------------------------------------------------------------- */
#ifdef AUTODOC
%section "Typemap Library (Tcl)",info,after,pre,nosort,skip=1,chop_left=3,chop_right=0,chop_top=0,chop_bottom=0
%text %{
%include typemaps.i
/*
The SWIG typemap library provides a language independent mechanism for
supporting output arguments, input values, and other C function
calling mechanisms. The primary use of the library is to provide a
better interface to certain C function--especially those involving
pointers.
%}
#endif
// ------------------------------------------------------------------------
// Pointer handling
//
// These mappings provide support for input/output arguments and common
// uses for C/C++ pointers.
// ------------------------------------------------------------------------
*/
// INPUT typemaps.
// These remap a C pointer to be an "INPUT" value which is passed by value
// instead of reference.
#ifdef AUTODOC
%subsection "Input Methods"
%text %{
/*
The following methods can be applied to turn a pointer into a simple
"input" value. That is, instead of passing a pointer to an object,
you would use a real value instead.
@ -68,97 +52,116 @@ or you can use the %apply directive :
%apply double *INPUT { double *a, double *b };
double fadd(double *a, double *b);
%}
#endif
*/
%typemap(tcl8,in) double *INPUT(double temp)
%typemap(in) double *INPUT(double temp), double &INPUT(double temp)
{
if (Tcl_GetDoubleFromObj(interp,$source,&temp) == TCL_ERROR) {
return TCL_ERROR;
if (Tcl_GetDoubleFromObj(interp,$input,&temp) == TCL_ERROR) {
SWIG_fail;
}
$target = &temp;
$1 = &temp;
}
%typemap(tcl8,in) float *INPUT(double dvalue, float temp)
%typemap(in) float *INPUT(double dvalue, float temp), float &INPUT(double dvalue, float temp)
{
if (Tcl_GetDoubleFromObj(interp,$source,&dvalue) == TCL_ERROR) {
return TCL_ERROR;
if (Tcl_GetDoubleFromObj(interp,$input,&dvalue) == TCL_ERROR) {
SWIG_fail;
}
temp = (float) dvalue;
$target = &temp;
$1 = &temp;
}
%typemap(tcl8,in) int *INPUT(int temp)
%typemap(in) int *INPUT(int temp), int &INPUT(int temp)
{
if (Tcl_GetIntFromObj(interp,$source,&temp) == TCL_ERROR) {
return TCL_ERROR;
if (Tcl_GetIntFromObj(interp,$input,&temp) == TCL_ERROR) {
SWIG_fail;
}
$target = &temp;
$1 = &temp;
}
%typemap(tcl8,in) short *INPUT(int ivalue, short temp)
%typemap(in) short *INPUT(int ivalue, short temp), short &INPUT(int ivalue, short temp)
{
if (Tcl_GetIntFromObj(interp,$source,&ivalue) == TCL_ERROR) {
return TCL_ERROR;
if (Tcl_GetIntFromObj(interp,$input,&ivalue) == TCL_ERROR) {
SWIG_fail;
}
temp = (short) ivalue;
$target = &temp;
$1 = &temp;
}
%typemap(tcl8,in) long *INPUT(int ivalue, long temp)
%typemap(in) long *INPUT(int ivalue, long temp), long &INPUT(int ivalue, long temp)
{
if (Tcl_GetIntFromObj(interp,$source,&ivalue) == TCL_ERROR) {
return TCL_ERROR;
if (Tcl_GetIntFromObj(interp,$input,&ivalue) == TCL_ERROR) {
SWIG_fail;
}
temp = (long) ivalue;
$target = &temp;
$1 = &temp;
}
%typemap(tcl8,in) unsigned int *INPUT(int ivalue, unsigned int temp)
%typemap(in) unsigned int *INPUT(int ivalue, unsigned int temp),
unsigned int &INPUT(int ivalue, unsigned int temp)
{
if (Tcl_GetIntFromObj(interp,$source,&ivalue) == TCL_ERROR) {
return TCL_ERROR;
if (Tcl_GetIntFromObj(interp,$input,&ivalue) == TCL_ERROR) {
SWIG_fail;
}
temp = (unsigned int) ivalue;
$target = &temp;
$1 = &temp;
}
%typemap(tcl8,in) unsigned short *INPUT(int ivalue, unsigned short temp)
%typemap(in) unsigned short *INPUT(int ivalue, unsigned short temp),
unsigned short &INPUT(int ivalue, unsigned short temp)
{
if (Tcl_GetIntFromObj(interp,$source,&ivalue) == TCL_ERROR) {
return TCL_ERROR;
if (Tcl_GetIntFromObj(interp,$input,&ivalue) == TCL_ERROR) {
SWIG_fail;
}
temp = (unsigned short) ivalue;
$target = &temp;
$1 = &temp;
}
%typemap(tcl8,in) unsigned long *INPUT(int ivalue, unsigned long temp)
%typemap(in) unsigned long *INPUT(int ivalue, unsigned long temp),
unsigned long &INPUT(int ivalue, unsigned long temp)
{
if (Tcl_GetIntFromObj(interp,$source,&ivalue) == TCL_ERROR) {
return TCL_ERROR;
if (Tcl_GetIntFromObj(interp,$input,&ivalue) == TCL_ERROR) {
SWIG_fail;
}
temp = (unsigned long) ivalue;
$target = &temp;
$1 = &temp;
}
%typemap(tcl8,in) unsigned char *INPUT(int ivalue, unsigned char temp)
%typemap(in) unsigned char *INPUT(int ivalue, unsigned char temp),
unsigned char &INPUT(int ivalue, unsigned char temp)
{
if (Tcl_GetIntFromObj(interp,$source,&ivalue) == TCL_ERROR) {
return TCL_ERROR;
if (Tcl_GetIntFromObj(interp,$input,&ivalue) == TCL_ERROR) {
SWIG_fail;
}
temp = (unsigned char) ivalue;
$target = &temp;
$1 = &temp;
}
%typemap(in) signed char *INPUT(int ivalue, signed char temp),
signed char &INPUT(int ivalue, signed char temp)
{
if (Tcl_GetIntFromObj(interp,$input,&ivalue) == TCL_ERROR) {
SWIG_fail;
}
temp = (signed char) ivalue;
$1 = &temp;
}
%typemap(in) bool *INPUT(int ivalue, bool temp),
bool &INPUT(int ivalue, bool temp)
{
if (Tcl_GetIntFromObj(interp,$input,&ivalue) == TCL_ERROR) {
SWIG_fail;
}
temp = (bool) ivalue;
$1 = &temp;
}
// OUTPUT typemaps. These typemaps are used for parameters that
// are output only. The output value is appended to the result as
// a list element.
#ifdef AUTODOC
%subsection "Output Methods"
%text %{
/*
The following methods can be applied to turn a pointer into an "output"
value. When calling a function, no input value would be given for
a parameter, but an output value would be returned. In the case of
@ -194,67 +197,74 @@ or you can use the %apply directive :
The Tcl output of the function would be a list containing both
output values.
%}
*/
#endif
%typemap(tcl8,ignore) int *OUTPUT(int temp),
%typemap(in,numinputs=0) int *OUTPUT(int temp),
short *OUTPUT(short temp),
long *OUTPUT(long temp),
unsigned int *OUTPUT(unsigned int temp),
unsigned short *OUTPUT(unsigned short temp),
unsigned long *OUTPUT(unsigned long temp),
unsigned char *OUTPUT(unsigned char temp),
signed char *OUTPUT(signed char temp),
bool *OUTPUT(bool temp),
float *OUTPUT(float temp),
double *OUTPUT(double temp)
{
$target = &temp;
}
double *OUTPUT(double temp),
int &OUTPUT(int temp),
short &OUTPUT(short temp),
long &OUTPUT(long temp),
unsigned int &OUTPUT(unsigned int temp),
unsigned short &OUTPUT(unsigned short temp),
unsigned long &OUTPUT(unsigned long temp),
signed char &OUTPUT(signed char temp),
bool &OUTPUT(bool temp),
unsigned char &OUTPUT(unsigned char temp),
float &OUTPUT(float temp),
double &OUTPUT(double temp)
"$1 = &temp;";
%typemap(tcl8,argout) int *OUTPUT,
short *OUTPUT,
long *OUTPUT,
unsigned int *OUTPUT,
unsigned short *OUTPUT,
unsigned long *OUTPUT,
unsigned char *OUTPUT
%typemap(argout) int *OUTPUT, int &OUTPUT,
short *OUTPUT, short &OUTPUT,
long *OUTPUT, long &OUTPUT,
unsigned int *OUTPUT, unsigned int &OUTPUT,
unsigned short *OUTPUT, unsigned short &OUTPUT,
unsigned long *OUTPUT, unsigned long &OUTPUT,
unsigned char *OUTPUT, unsigned char &OUTPUT,
signed char *OUTPUT, signed char &OUTPUT,
bool *OUTPUT, bool &OUTPUT
{
Tcl_Obj *o;
o = Tcl_NewIntObj((int) *($source));
o = Tcl_NewIntObj((int) *($1));
Tcl_ListObjAppendElement(interp,Tcl_GetObjResult(interp),o);
}
%typemap(tcl8,argout) float *OUTPUT,
double *OUTPUT
%typemap(argout) float *OUTPUT, float &OUTPUT,
double *OUTPUT, double &OUTPUT
{
Tcl_Obj *o;
o = Tcl_NewDoubleObj((double) *($source));
o = Tcl_NewDoubleObj((double) *($1));
Tcl_ListObjAppendElement(interp,Tcl_GetObjResult(interp),o);
}
// BOTH
// INOUT
// Mappings for an argument that is both an input and output
// parameter
#ifdef AUTODOC
%subsection "Input/Output Methods"
%text %{
/*
The following methods can be applied to make a function parameter both
an input and output value. This combines the behavior of both the
"INPUT" and "OUTPUT" methods described earlier. Output values are
returned in the form of a Tcl list.
int *BOTH
short *BOTH
long *BOTH
unsigned int *BOTH
unsigned short *BOTH
unsigned long *BOTH
unsigned char *BOTH
float *BOTH
double *BOTH
int *INOUT
short *INOUT
long *INOUT
unsigned int *INOUT
unsigned short *INOUT
unsigned long *INOUT
unsigned char *INOUT
float *INOUT
double *INOUT
For example, suppose you were trying to wrap the following function :
@ -265,12 +275,12 @@ For example, suppose you were trying to wrap the following function :
You could wrap it with SWIG as follows :
%include typemaps.i
void neg(double *BOTH);
void neg(double *INOUT);
or you can use the %apply directive :
%include typemaps.i
%apply double *BOTH { double *x };
%apply double *INOUT { double *x };
void neg(double *x);
Unlike C, this mapping does not directly modify the input value (since
@ -280,30 +290,56 @@ to a Tcl variable you might do this :
set x [neg $x]
%}
#endif
*/
%typemap(tcl8,in) int *BOTH = int *INPUT;
%typemap(tcl8,in) short *BOTH = short *INPUT;
%typemap(tcl8,in) long *BOTH = long *INPUT;
%typemap(tcl8,in) unsigned int *BOTH = unsigned int *INPUT;
%typemap(tcl8,in) unsigned short *BOTH = unsigned short *INPUT;
%typemap(tcl8,in) unsigned long *BOTH = unsigned long *INPUT;
%typemap(tcl8,in) unsigned char *BOTH = unsigned char *INPUT;
%typemap(tcl8,in) float *BOTH = float *INPUT;
%typemap(tcl8,in) double *BOTH = double *INPUT;
%typemap(in) int *INOUT = int *INPUT;
%typemap(in) short *INOUT = short *INPUT;
%typemap(in) long *INOUT = long *INPUT;
%typemap(in) unsigned int *INOUT = unsigned int *INPUT;
%typemap(in) unsigned short *INOUT = unsigned short *INPUT;
%typemap(in) unsigned long *INOUT = unsigned long *INPUT;
%typemap(in) unsigned char *INOUT = unsigned char *INPUT;
%typemap(in) signed char *INOUT = signed char *INPUT;
%typemap(in) bool *INOUT = bool *INPUT;
%typemap(in) float *INOUT = float *INPUT;
%typemap(in) double *INOUT = double *INPUT;
%typemap(tcl8,argout) int *BOTH = int *OUTPUT;
%typemap(tcl8,argout) short *BOTH = short *OUTPUT;
%typemap(tcl8,argout) long *BOTH = long *OUTPUT;
%typemap(tcl8,argout) unsigned int *BOTH = unsigned int *OUTPUT;
%typemap(tcl8,argout) unsigned short *BOTH = unsigned short *OUTPUT;
%typemap(tcl8,argout) unsigned long *BOTH = unsigned long *OUTPUT;
%typemap(tcl8,argout) unsigned char *BOTH = unsigned char *OUTPUT;
%typemap(tcl8,argout) float *BOTH = float *OUTPUT;
%typemap(tcl8,argout) double *BOTH = double *OUTPUT;
%typemap(in) int &INOUT = int &INPUT;
%typemap(in) short &INOUT = short &INPUT;
%typemap(in) long &INOUT = long &INPUT;
%typemap(in) unsigned int &INOUT = unsigned int &INPUT;
%typemap(in) unsigned short &INOUT = unsigned short &INPUT;
%typemap(in) unsigned long &INOUT = unsigned long &INPUT;
%typemap(in) unsigned char &INOUT = unsigned char &INPUT;
%typemap(in) signed char &INOUT = signed char &INPUT;
%typemap(in) bool &INOUT = bool &INPUT;
%typemap(in) float &INOUT = float &INPUT;
%typemap(in) double &INOUT = double &INPUT;
%typemap(argout) int *INOUT = int *OUTPUT;
%typemap(argout) short *INOUT = short *OUTPUT;
%typemap(argout) long *INOUT = long *OUTPUT;
%typemap(argout) unsigned int *INOUT = unsigned int *OUTPUT;
%typemap(argout) unsigned short *INOUT = unsigned short *OUTPUT;
%typemap(argout) unsigned long *INOUT = unsigned long *OUTPUT;
%typemap(argout) unsigned char *INOUT = unsigned char *OUTPUT;
%typemap(argout) signed char *INOUT = signed char *OUTPUT;
%typemap(argout) bool *INOUT = bool *OUTPUT;
%typemap(argout) float *INOUT = float *OUTPUT;
%typemap(argout) double *INOUT = double *OUTPUT;
%typemap(argout) int &INOUT = int &OUTPUT;
%typemap(argout) short &INOUT = short &OUTPUT;
%typemap(argout) long &INOUT = long &OUTPUT;
%typemap(argout) unsigned int &INOUT = unsigned int &OUTPUT;
%typemap(argout) unsigned short &INOUT = unsigned short &OUTPUT;
%typemap(argout) unsigned long &INOUT = unsigned long &OUTPUT;
%typemap(argout) unsigned char &INOUT = unsigned char &OUTPUT;
%typemap(argout) signed char &INOUT = signed char &OUTPUT;
%typemap(argout) bool &INOUT = bool &OUTPUT;
%typemap(argout) float &INOUT = float &OUTPUT;
%typemap(argout) double &INOUT = double &OUTPUT;
// --------------------------------------------------------------------
// Special types
@ -312,10 +348,7 @@ to a Tcl variable you might do this :
// If interp * appears as a function argument, we ignore it and get
// it from the wrapper function.
#ifdef AUTODOC
%subsection "Special Methods"
%text %{
/*
The typemaps.i library also provides the following mappings :
Tcl_Interp *interp
@ -343,20 +376,67 @@ int Tcl_Result
%apply int Tcl_Result { int foo };
int foo();
%}
*/
#endif
%typemap(tcl8,ignore) Tcl_Interp *interp {
$target = interp;
%typemap(in,numinputs=0) Tcl_Interp *interp {
$1 = interp;
}
// If return code is a Tcl_Result, simply pass it on
%typemap(tcl8,out) int Tcl_Result {
return $source;
%typemap(out) int Tcl_Result {
return $1;
}
/* Overloading information */
%typemap(typecheck) double *INPUT = double;
%typemap(typecheck) bool *INPUT = bool;
%typemap(typecheck) signed char *INPUT = signed char;
%typemap(typecheck) unsigned char *INPUT = unsigned char;
%typemap(typecheck) unsigned long *INPUT = unsigned long;
%typemap(typecheck) unsigned short *INPUT = unsigned short;
%typemap(typecheck) unsigned int *INPUT = unsigned int;
%typemap(typecheck) long *INPUT = long;
%typemap(typecheck) short *INPUT = short;
%typemap(typecheck) int *INPUT = int;
%typemap(typecheck) float *INPUT = float;
%typemap(typecheck) double &INPUT = double;
%typemap(typecheck) bool &INPUT = bool;
%typemap(typecheck) signed char &INPUT = signed char;
%typemap(typecheck) unsigned char &INPUT = unsigned char;
%typemap(typecheck) unsigned long &INPUT = unsigned long;
%typemap(typecheck) unsigned short &INPUT = unsigned short;
%typemap(typecheck) unsigned int &INPUT = unsigned int;
%typemap(typecheck) long &INPUT = long;
%typemap(typecheck) short &INPUT = short;
%typemap(typecheck) int &INPUT = int;
%typemap(typecheck) float &INPUT = float;
%typemap(typecheck) double *INOUT = double;
%typemap(typecheck) bool *INOUT = bool;
%typemap(typecheck) signed char *INOUT = signed char;
%typemap(typecheck) unsigned char *INOUT = unsigned char;
%typemap(typecheck) unsigned long *INOUT = unsigned long;
%typemap(typecheck) unsigned short *INOUT = unsigned short;
%typemap(typecheck) unsigned int *INOUT = unsigned int;
%typemap(typecheck) long *INOUT = long;
%typemap(typecheck) short *INOUT = short;
%typemap(typecheck) int *INOUT = int;
%typemap(typecheck) float *INOUT = float;
%typemap(typecheck) double &INOUT = double;
%typemap(typecheck) bool &INOUT = bool;
%typemap(typecheck) signed char &INOUT = signed char;
%typemap(typecheck) unsigned char &INOUT = unsigned char;
%typemap(typecheck) unsigned long &INOUT = unsigned long;
%typemap(typecheck) unsigned short &INOUT = unsigned short;
%typemap(typecheck) unsigned int &INOUT = unsigned int;
%typemap(typecheck) long &INOUT = long;
%typemap(typecheck) short &INOUT = short;
%typemap(typecheck) int &INOUT = int;
%typemap(typecheck) float &INOUT = float;

10
SWIG/Lib/tcl/wish.i
View file

@ -7,6 +7,12 @@
//
/* Revision History
* $Log$
* Revision 1.2 2002/11/30 22:01:08 beazley
* The great merge
*
* Revision 1.1.2.1 2001/06/20 11:47:29 mkoeppe
* Portability fixes
*
* Revision 1.1 2000/01/11 21:15:54 beazley
* Added files
*
@ -122,7 +128,7 @@ int Tcl_AppInit(Tcl_Interp *interp)
*/
#if TCL_MAJOR_VERSION >= 8 || TCL_MAJOR_VERSION == 7 && TCL_MINOR_VERSION >= 5
Tcl_SetVar(interp,"tcl_rcFileName",SWIG_RcFileName,TCL_GLOBAL_ONLY);
Tcl_SetVar(interp, (char *) "tcl_rcFileName",SWIG_RcFileName,TCL_GLOBAL_ONLY);
#else
tcl_RcFileName = SWIG_RcFileName;
#endif
@ -131,7 +137,7 @@ int Tcl_AppInit(Tcl_Interp *interp)
#ifdef MAC_TCL
#ifdef SWIG_RcRsrcName
Tcl_SetVar(interp,"tcl_rcRsrcName",SWIG_RcRsrcName,TCL_GLOBAL_ONLY);
Tcl_SetVar(interp, (char *) "tcl_rcRsrcName",SWIG_RcRsrcName,TCL_GLOBAL_ONLY);
#endif
#endif
return TCL_OK;