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

Added files

Browse source 
git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk@39 626c5289-ae23-0410-ae9c-e8d60b6d4f22
This commit is contained in:
Dave Beazley 2000-01-11 21:15:54 +00:00
commit 09bd3946db
37 changed files with 6653 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

134
SWIG/Lib/tcl/Makefile.in Normal file
View file

@ -0,0 +1,134 @@
# ---------------------------------------------------------------
# $Header$
# SWIG Tcl/Tk Makefile
#
# This file can be used to build various Tcl extensions with SWIG.
# By default this file is set up for dynamic loading, but it can
# be easily customized for static extensions by modifying various
# portions of the file.
#
# SRCS = C source files
# CXXSRCS = C++ source files
# OBJCSRCS = Objective-C source files
# OBJS = Additional .o files (compiled previously)
# INTERFACE = SWIG interface file
# TARGET = Name of target module or executable
#
# Many portions of this file were created by the SWIG configure
# script and should already reflect your machine. However, you
# may need to modify the Makefile to reflect your specific
# application.
#----------------------------------------------------------------
SRCS =
CXXSRCS =
OBJCSRCS =
OBJS =
INTERFACE =
WRAPFILE = $(INTERFACE:.i=_wrap.c)
WRAPOBJ = $(INTERFACE:.i=_wrap.o)
TARGET = module@SO@ # Use this kind of target for dynamic loading
#TARGET = my_tclsh # Use this target for static linking
prefix = @prefix@
exec_prefix = @exec_prefix@
CC = @CC@
CXX = @CXX@
OBJC = @CC@ -Wno-import # -Wno-import needed for gcc
CFLAGS =
INCLUDE =
LIBS =
# SWIG Options
# SWIG = location of the SWIG executable
# SWIGOPT = SWIG compiler options
# SWIGCC = Compiler used to compile the wrapper file
SWIG = $(exec_prefix)/bin/swig
SWIGOPT = -tcl # use -tcl8 for Tcl 8.0
SWIGCC = $(CC)
# SWIG Library files. Uncomment one of these for rebuilding tclsh or wish
#SWIGLIB = -ltclsh.i
#SWIGLIB = -lwish.i
# Rules for creating .o files from source.
COBJS = $(SRCS:.c=.o)
CXXOBJS = $(CXXSRCS:.cxx=.o)
OBJCOBJS = $(OBJCSRCS:.m=.o)
ALLOBJS = $(COBJS) $(CXXOBJS) $(OBJCOBJS) $(OBJS)
# Command that will be used to build the final extension.
BUILD = $(SWIGCC)
# Uncomment the following if you are using dynamic loading
CCSHARED = @CCSHARED@
BUILD = @LDSHARED@
# Uncomment the following if you are using dynamic loading with C++ and
# need to provide additional link libraries (this is not always required).
#DLL_LIBS = -L/usr/local/lib/gcc-lib/sparc-sun-solaris2.5.1/2.7.2 \
-L/usr/local/lib -lg++ -lstdc++ -lgcc
# X11 installation (needed to rebuild Tk extensions)
XLIB = @XLIBSW@
XINCLUDE = @XINCLUDES@
# Tcl installation (where is Tcl/Tk located)
TCL_INCLUDE = @TCLINCLUDE@
TCL_LIB = @TCLLIB@
# Build libraries (needed for static builds)
LIBM = @LIBM@
LIBC = @LIBC@
SYSLIBS = $(LIBM) $(LIBC) @LIBS@
# Build options (uncomment only one these)
BUILD_LIBS = $(LIBS) # Dynamic loading
#BUILD_LIBS = $(TCL_LIB) -ltcl $(LIBS) $(SYSLIBS) # tclsh
#BUILD_LIBS = $(TCL_LIB) -ltk -ltcl $(XLIB) $(LIBS) $(SYSLIBS) # wish
# Compilation rules for non-SWIG components
.SUFFIXES: .c .cxx .m
.c.o:
$(CC) $(CCSHARED) $(CFLAGS) $(INCLUDE) -c $<
.cxx.o:
$(CXX) $(CCSHARED) $(CXXFLAGS) $(INCLUDE) -c $<
.m.o:
$(OBJC) $(CCSHARED) $(CFLAGS) $(INCLUDE) -c $<
# ----------------------------------------------------------------------
# Rules for building the extension
# ----------------------------------------------------------------------
all: $(TARGET)
# Convert the wrapper file into an object file
$(WRAPOBJ) : $(WRAPFILE)
$(SWIGCC) -c $(CCSHARED) $(CFLAGS) $(WRAPFILE) $(INCLUDE) $(TCL_INCLUDE)
$(WRAPFILE) : $(INTERFACE)
$(SWIG) $(SWIGOPT) -o $(WRAPFILE) $(SWIGLIB) $(INTERFACE)
$(TARGET): $(WRAPOBJ) $(ALLOBJS)
$(BUILD) $(WRAPOBJ) $(ALLOBJS) $(BUILD_LIBS) -o $(TARGET)
clean:
rm -f $(COBJS) $(CXXOBJS) $(OBJCOBJS) $(WRAPOBJ) $(WRAPFILE) $(TARGET)

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

@ -0,0 +1,108 @@
// 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 Normal file
View file

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

86
SWIG/Lib/tcl/mactclinit.c Normal file
View file

@ -0,0 +1,86 @@
/*
* tclMacAppInit.c --
*
* Provides a version of the Tcl_AppInit procedure for the example shell.
*
* Copyright (c) 1993-1994 Lockheed Missle & Space Company, AI Center
* Copyright (c) 1995-1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
* SCCS: @(#) tclMacAppInit.c 1.17 97/01/21 18:13:34
*/
#include "tcl.h"
#include "tclInt.h"
#include "tclMacInt.h"
#if defined(THINK_C)
# include <console.h>
#elif defined(__MWERKS__)
# include <SIOUX.h>
short InstallConsole _ANSI_ARGS_((short fd));
#endif
/*
*----------------------------------------------------------------------
*
* MacintoshInit --
*
* This procedure calls initalization routines to set up a simple
* console on a Macintosh. This is necessary as the Mac doesn't
* have a stdout & stderr by default.
*
* Results:
* Returns TCL_OK if everything went fine. If it didn't the
* application should probably fail.
*
* Side effects:
* Inits the appropiate console package.
*
*----------------------------------------------------------------------
*/
#ifdef __cpluscplus
extern "C"
#endif
extern int
MacintoshInit()
{
#if defined(THINK_C)
/* Set options for Think C console package */
/* The console package calls the Mac init calls */
console_options.pause_atexit = 0;
console_options.title = "\pTcl Interpreter";
#elif defined(__MWERKS__)
/* Set options for CodeWarrior SIOUX package */
SIOUXSettings.autocloseonquit = true;
SIOUXSettings.showstatusline = true;
SIOUXSettings.asktosaveonclose = false;
InstallConsole(0);
SIOUXSetTitle("\pTcl Interpreter");
#elif defined(applec)
/* Init packages used by MPW SIOW package */
InitGraf((Ptr)&qd.thePort);
InitFonts();
InitWindows();
InitMenus();
TEInit();
InitDialogs(nil);
InitCursor();
#endif
TclMacSetEventProc((TclMacConvertEventPtr) SIOUXHandleOneEvent);
/* No problems with initialization */
return TCL_OK;
}

229
SWIG/Lib/tcl/mactkinit.c Normal file
View file

@ -0,0 +1,229 @@
/* This is a support file needed to build a new version of Wish
Normally, this capability is found in TkAppInit.c, but this creates
tons of namespace problems for many applications. */
#include <Gestalt.h>
#include <ToolUtils.h>
#include <Fonts.h>
#include <Dialogs.h>
#include <SegLoad.h>
#include <Traps.h>
#include "tk.h"
#include "tkInt.h"
#include "tkMacInt.h"
typedef int (*TclMacConvertEventPtr) _ANSI_ARGS_((EventRecord *eventPtr));
Tcl_Interp *gStdoutInterp = NULL;
void TclMacSetEventProc _ANSI_ARGS_((TclMacConvertEventPtr procPtr));
int TkMacConvertEvent _ANSI_ARGS_((EventRecord *eventPtr));
/*
* Prototypes for functions the ANSI library needs to link against.
*/
short InstallConsole _ANSI_ARGS_((short fd));
void RemoveConsole _ANSI_ARGS_((void));
long WriteCharsToConsole _ANSI_ARGS_((char *buff, long n));
long ReadCharsFromConsole _ANSI_ARGS_((char *buff, long n));
extern char * __ttyname _ANSI_ARGS_((long fildes));
short SIOUXHandleOneEvent _ANSI_ARGS_((EventRecord *event));
/*
* Forward declarations for procedures defined later in this file:
*/
/*
*----------------------------------------------------------------------
*
* MacintoshInit --
*
* This procedure calls Mac specific initilization calls. Most of
* these calls must be made as soon as possible in the startup
* process.
*
* Results:
* Returns TCL_OK if everything went fine. If it didn't the
* application should probably fail.
*
* Side effects:
* Inits the application.
*
*----------------------------------------------------------------------
*/
int
MacintoshInit()
{
int i;
long result, mask = 0x0700; /* mask = system 7.x */
/*
* Tk needs us to set the qd pointer it uses. This is needed
* so Tk doesn't have to assume the availablity of the qd global
* variable. Which in turn allows Tk to be used in code resources.
*/
tcl_macQdPtr = &qd;
InitGraf(&tcl_macQdPtr->thePort);
InitFonts();
InitWindows();
InitMenus();
InitDialogs((long) NULL);
InitCursor();
/*
* Make sure we are running on system 7 or higher
*/
if ((NGetTrapAddress(_Gestalt, ToolTrap) ==
NGetTrapAddress(_Unimplemented, ToolTrap))
|| (((Gestalt(gestaltSystemVersion, &result) != noErr)
|| (mask != (result & mask))))) {
panic("Tcl/Tk requires System 7 or higher.");
}
/*
* Make sure we have color quick draw
* (this means we can't run on 68000 macs)
*/
if (((Gestalt(gestaltQuickdrawVersion, &result) != noErr)
|| (result < gestalt32BitQD13))) {
panic("Tk requires Color QuickDraw.");
}
FlushEvents(everyEvent, 0);
SetEventMask(everyEvent);
/*
* Set up stack & heap sizes
*/
/* TODO: stack size
size = StackSpace();
SetAppLimit(GetAppLimit() - 8192);
*/
MaxApplZone();
for (i = 0; i < 4; i++) {
(void) MoreMasters();
}
TclMacSetEventProc(TkMacConvertEvent);
TkConsoleCreate();
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* SetupMainInterp --
*
* This procedure calls initalization routines require a Tcl
* interp as an argument. This call effectively makes the passed
* iterpreter the "main" interpreter for the application.
*
* Results:
* Returns TCL_OK if everything went fine. If it didn't the
* application should probably fail.
*
* Side effects:
* More initilization.
*
*----------------------------------------------------------------------
*/
int
SetupMainInterp(
Tcl_Interp *interp)
{
/*
* Initialize the console only if we are running as an interactive
* application.
*/
TkMacInitAppleEvents(interp);
TkMacInitMenus(interp);
if (strcmp(Tcl_GetVar(interp, "tcl_interactive", TCL_GLOBAL_ONLY), "1")
== 0) {
if (TkConsoleInit(interp) == TCL_ERROR) {
goto error;
}
}
/*
* Attach the global interpreter to tk's expected global console
*/
gStdoutInterp = interp;
return TCL_OK;
error:
panic(interp->result);
return TCL_ERROR;
}
/*
*----------------------------------------------------------------------
*
* InstallConsole, RemoveConsole, etc. --
*
* The following functions provide the UI for the console package.
* Users wishing to replace SIOUX with their own console package
* need only provide the four functions below in a library.
*
* Results:
* See SIOUX documentation for details.
*
* Side effects:
* See SIOUX documentation for details.
*
*----------------------------------------------------------------------
*/
short
InstallConsole(short fd)
{
#pragma unused (fd)
return 0;
}
void
RemoveConsole(void)
{
}
long
WriteCharsToConsole(char *buffer, long n)
{
TkConsolePrint(gStdoutInterp, TCL_STDOUT, buffer, n);
return n;
}
long
ReadCharsFromConsole(char *buffer, long n)
{
return 0;
}
extern char *
__ttyname(long fildes)
{
static char *__devicename = "null device";
if (fildes >= 0 && fildes <= 2) {
return (__devicename);
}
return (0L);
}
short
SIOUXHandleOneEvent(EventRecord *event)
{
return 0;
}

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

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

695
SWIG/Lib/tcl/ptrlang.i Normal file
View file

@ -0,0 +1,695 @@
//
// SWIG pointer conversion and utility library
//
// Dave Beazley
// April 19, 1997
//
// Tcl specific implementation. This file is included
// by the file ../pointer.i
#if defined(SWIGTCL8)
// -----------------------------------------------------------------
// Define a hack for GetPtr on Tcl 8
//
// -----------------------------------------------------------------
%{
static char *_SWIG_GetPtr(Tcl_Interp *interp, char *s, void **ptr, char *type) {
Tcl_Obj *obj;
char *c;
obj = Tcl_NewStringObj(s, strlen(s));
c = SWIG_GetPointerObj(interp, obj, ptr, type);
if (c) {
c = strstr(s,c);
}
Tcl_DecrRefCount(obj);
return c;
}
#define SWIG_GetPtr(a,b,c) _SWIG_GetPtr(interp, a,b,c)
%}
#endif
%{
#include <ctype.h>
/*------------------------------------------------------------------
ptrcast(value,type)
Constructs a new pointer value. Value may either be a string
or an integer. Type is a string corresponding to either the
C datatype or mangled datatype.
ptrcast(0,"Vector *")
or
ptrcast(0,"Vector_p")
------------------------------------------------------------------ */
static int ptrcast(Tcl_Interp *interp, char *_ptrvalue, char *type) {
char *r,*s;
void *ptr;
char *typestr,*c;
int pv;
int error = 0;
/* Produce a "mangled" version of the type string. */
typestr = (char *) malloc(strlen(type)+2);
/* Go through and munge the typestring */
r = typestr;
*(r++) = '_';
c = type;
while (*c) {
if (!isspace(*c)) {
if ((*c == '*') || (*c == '&')) {
*(r++) = 'p';
}
else *(r++) = *c;
} else {
*(r++) = '_';
}
c++;
}
*(r++) = 0;
/* Check to see what kind of object _PTRVALUE is */
if (Tcl_GetInt(interp,_ptrvalue,&pv) == TCL_OK) {
ptr = (void *) pv;
/* Received a numerical value. Make a pointer out of it */
r = (char *) malloc(strlen(typestr)+22);
if (ptr) {
SWIG_MakePtr(r, ptr, typestr);
} else {
sprintf(r,"_0%s",typestr);
}
Tcl_SetResult(interp,r,TCL_VOLATILE);
free(r);
} else {
/* Have a string. Try to get the real pointer value */
s = _ptrvalue;
r = (char *) malloc(strlen(type)+22);
/* Now extract the pointer value */
if (!SWIG_GetPtr(s,&ptr,0)) {
if (ptr) {
SWIG_MakePtr(r,ptr,typestr);
} else {
sprintf(r,"_0%s",typestr);
}
Tcl_SetResult(interp,r,TCL_VOLATILE);
} else {
error = 1;
}
free(r);
}
free(typestr);
if (error) {
Tcl_SetResult(interp,"Type error in ptrcast. Argument is not a valid pointer value.",TCL_VOLATILE);
return TCL_ERROR;
}
return TCL_OK;
}
/*------------------------------------------------------------------
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_GetPtr(s,&ptr,0)) {
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_GetPtr(s,&ptr,"_int_p")) {
type = "int";
} else if (!SWIG_GetPtr(s,&ptr,"_double_p")) {
type = "double";
} else if (!SWIG_GetPtr(s,&ptr,"_short_p")) {
type = "short";
} else if (!SWIG_GetPtr(s,&ptr,"_long_p")) {
type = "long";
} else if (!SWIG_GetPtr(s,&ptr,"_float_p")) {
type = "float";
} else if (!SWIG_GetPtr(s,&ptr,"_char_p")) {
type = "char";
} else if (!SWIG_GetPtr(s,&ptr,"_char_pp")) {
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;
char *cast;
char temp[40];
/* Check the type string against a variety of possibilities */
if (strcmp(type,"int") == 0) {
sz = sizeof(int)*numelements;
cast = "_int_p";
} else if (strcmp(type,"short") == 0) {
sz = sizeof(short)*numelements;
cast = "_short_p";
} else if (strcmp(type,"long") == 0) {
sz = sizeof(long)*numelements;
cast = "_long_p";
} else if (strcmp(type,"double") == 0) {
sz = sizeof(double)*numelements;
cast = "_double_p";
} else if (strcmp(type,"float") == 0) {
sz = sizeof(float)*numelements;
cast = "_float_p";
} else if (strcmp(type,"char") == 0) {
sz = sizeof(char)*numelements;
cast = "_char_p";
} else if (strcmp(type,"char *") == 0) {
sz = sizeof(char *)*(numelements+1);
cast = "_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 */
SWIG_MakePtr(temp,ptr,cast);
Tcl_SetResult(interp,temp,TCL_VOLATILE);
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_GetPtr(s,&ptr,0)) {
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_GetPtr(s,&ptr,"_int_p")) {
type = "int";
} else if (!SWIG_GetPtr(s,&ptr,"_double_p")) {
type = "double";
} else if (!SWIG_GetPtr(s,&ptr,"_short_p")) {
type = "short";
} else if (!SWIG_GetPtr(s,&ptr,"_long_p")) {
type = "long";
} else if (!SWIG_GetPtr(s,&ptr,"_float_p")) {
type = "float";
} else if (!SWIG_GetPtr(s,&ptr,"_char_p")) {
type = "char";
} else if (!SWIG_GetPtr(s,&ptr,"_char_pp")) {
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;
char *type;
/* Check to see what kind of object _PTRVALUE is */
s = _PTRVALUE;
/* Try to handle a few common datatypes first */
if (!SWIG_GetPtr(s,&ptr,"_int_p")) {
ptr = (void *) (((int *) ptr) + offset);
} else if (!SWIG_GetPtr(s,&ptr,"_double_p")) {
ptr = (void *) (((double *) ptr) + offset);
} else if (!SWIG_GetPtr(s,&ptr,"_short_p")) {
ptr = (void *) (((short *) ptr) + offset);
} else if (!SWIG_GetPtr(s,&ptr,"_long_p")) {
ptr = (void *) (((long *) ptr) + offset);
} else if (!SWIG_GetPtr(s,&ptr,"_float_p")) {
ptr = (void *) (((float *) ptr) + offset);
} else if (!SWIG_GetPtr(s,&ptr,"_char_p")) {
ptr = (void *) (((char *) ptr) + offset);
} else if (!SWIG_GetPtr(s,&ptr,0)) {
ptr = (void *) (((char *) ptr) + offset);
} else {
Tcl_SetResult(interp,"Type error in ptradd. Argument is not a valid pointer value.",TCL_STATIC);
return TCL_ERROR;
}
type = SWIG_GetPtr(s,&junk,"INVALID POINTER");
r = (char *) malloc(strlen(type)+20);
if (ptr) {
SWIG_MakePtr(r,ptr,type);
} else {
sprintf(r,"_0%s",type);
}
Tcl_SetResult(interp,r,TCL_VOLATILE);
free(r);
return TCL_OK;
}
/*------------------------------------------------------------------
ptrmap(type1,type2)
Allows a mapping between type1 and type2. (Like a typedef)
------------------------------------------------------------------ */
static void ptrmap(char *type1, char *type2) {
char *typestr1,*typestr2,*c,*r;
/* Produce a "mangled" version of the type string. */
typestr1 = (char *) malloc(strlen(type1)+2);
/* Go through and munge the typestring */
r = typestr1;
*(r++) = '_';
c = type1;
while (*c) {
if (!isspace(*c)) {
if ((*c == '*') || (*c == '&')) {
*(r++) = 'p';
}
else *(r++) = *c;
} else {
*(r++) = '_';
}
c++;
}
*(r++) = 0;
typestr2 = (char *) malloc(strlen(type2)+2);
/* Go through and munge the typestring */
r = typestr2;
*(r++) = '_';
c = type2;
while (*c) {
if (!isspace(*c)) {
if ((*c == '*') || (*c == '&')) {
*(r++) = 'p';
}
else *(r++) = *c;
} else {
*(r++) = '_';
}
c++;
}
*(r++) = 0;
SWIG_RegisterMapping(typestr1,typestr2,0);
SWIG_RegisterMapping(typestr2,typestr1,0);
}
/*------------------------------------------------------------------
ptrfree(ptr)
Destroys a pointer value
------------------------------------------------------------------ */
int ptrfree(Tcl_Interp *interp, char *_PTRVALUE) {
void *ptr, *junk;
char *s;
s = _PTRVALUE;
if (SWIG_GetPtr(s,&ptr,0)) {
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_GetPtr(s,&junk,"_char_pp")) {
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(tcl,out) int ptrcast,
int ptrvalue,
int ptrcreate,
int ptrset,
int ptradd,
int ptrfree
{
return $source;
}
%typemap(tcl8,out) int ptrcast,
int ptrvalue,
int ptrcreate,
int ptrset,
int ptradd,
int ptrfree
{
return $source;
}
// Ignore the Tcl_Interp * value, but set it to a value
%typemap(tcl,ignore) Tcl_Interp * {
$target = interp;
}
%typemap(tcl8,ignore) Tcl_Interp * {
$target = interp;
}
int ptrcast(Tcl_Interp *interp, char *ptr, char *type);
// Casts a pointer ptr to a new datatype given by the string type.
// type may be either the SWIG generated representation of a datatype
// or the C representation. For example :
//
// ptrcast $ptr double_p # Tcl representation
// ptrcast $ptr "double *" # C representation
//
// A new pointer value is returned. ptr may also be an integer
// value in which case the value will be used to set the pointer
// value. For example :
//
// set a [ptrcast 0 Vector_p]
//
// Will create a NULL pointer of type "Vector_p"
//
// The casting operation is sensitive to formatting. As a result,
// "double *" is different than "double*". As a result of thumb,
// there should always be exactly one space between the C datatype
// and any pointer specifiers (*).
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.
void ptrmap(char *type1, char *type2);
// This is a rarely used function that performs essentially the same
// operation as a C typedef. To manage datatypes at run-time, SWIG
// modules manage an internal symbol table of type mappings. This
// table keeps track of which types are equivalent to each other. The
// ptrmap() function provides a mechanism for scripts to add symbols
// to this table. For example :
//
// ptrmap double_p Real_p
//
// would make the types "double_p" and "Real_p" equivalent to each
// other. Pointers of either type could now be used interchangably.
//
// Normally this function is not needed, but it can be used to
// circumvent SWIG's normal type-checking behavior or to work around
// weird type-handling bugs.
// Clear the ignore typemap
%typemap(tcl,ignore) Tcl_Interp *;
%typemap(tcl8,ignore) Tcl_Interp *;

300
SWIG/Lib/tcl/swigtcl8.swg Normal file
View file

@ -0,0 +1,300 @@
/*
* $Header$
*
* swigtcl.swg
*/
#include <tcl.h>
#include <string.h>
#include <stdlib.h>
#include <stdarg.h>
#define SWIGTCL
#define SWIGTCL8
#if defined(_WIN32) || defined(__WIN32__)
# if defined(_MSC_VER)
# if defined(STATIC_LINKED)
# define SWIGEXPORT(a) a
# else
# define SWIGEXPORT(a) __declspec(dllexport) a
# endif
# else
# if defined(__BORLANDC__)
# define SWIGEXPORT(a) a _export
# else
# define SWIGEXPORT(a) a
# endif
#endif
#else
# define SWIGEXPORT(a) a
#endif
#ifdef SWIG_GLOBAL
#define SWIGSTATICRUNTIME(a) SWIGEXPORT(a)
#else
#define SWIGSTATICRUNTIME(a) static a
#endif
#ifdef __cplusplus
extern "C" {
#endif
typedef struct _swig_type_info {
char *name;
void *(*converter)(void *);
struct _swig_type_info *next;
struct _swig_type_info *prev;
} _swig_type_info;
static _swig_type_info *swig_types = 0;
/* Register type mappings with the type-checker */
SWIGSTATICRUNTIME(_swig_type_info *)
SWIG_TypeRegister(_swig_type_info *ti)
{
_swig_type_info *tc, *head, *ret, *next;
/* Check to see if this type has already been registered */
tc = swig_types;
while (tc) {
if (strcmp(tc->name, ti->name) == 0) {
/* Already exists in the table. Just add additional types to the list */
head = tc;
next = tc->next;
goto l1;
}
tc = tc->prev;
}
head = ti;
next = 0;
/* Place in list */
ti->prev = swig_types;
swig_types = ti;
/* Build linked lists */
l1:
ret = head;
tc = ti + 1;
/* Patch up the rest of the links */
while (tc->name) {
head->next = tc;
tc->prev = head;
head = tc;
tc++;
}
head->next = next;
return ret;
}
/* Check the typename */
SWIGSTATICRUNTIME(_swig_type_info *)
SWIG_TypeCheck(char *c, _swig_type_info *ty)
{
_swig_type_info *s, *temp2;
if (!ty) return 0; /* Void pointer */
s = ty->next; /* First element always just a name */
while (s) {
if (strcmp(s->name,c) == 0) {
if (s == ty->next) return s;
/* Move s to the top of the linked list */
s->prev->next = s->next;
if (s->next) {
s->next->prev = s->prev;
}
/* Insert s as second element in the list */
s->next = ty->next;
if (ty->next) ty->next->prev = s;
ty->next = s;
return s;
}
s = s->next;
}
return 0;
}
/* Convert a pointer value */
SWIGSTATICRUNTIME(int)
SWIG_ConvertPtr(Tcl_Interp *interp, Tcl_Obj *oc, void **ptr, _swig_type_info *ty)
{
unsigned long p;
register int d;
_swig_type_info *tc;
char *c = Tcl_GetStringFromObj(oc,NULL);
p = 0;
/* Pointer values must start with leading underscore */
if (*c != '_') {
*ptr = (void *) 0;
if (strcmp(c,"NULL") == 0) return TCL_OK;
}
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;
if (ty) {
tc = SWIG_TypeCheck(c,ty);
if (!tc) {
Tcl_SetResult(interp,"Type error. Expected ", TCL_STATIC);
Tcl_AppendElement(interp, ty->name);
return TCL_ERROR;
}
if (tc->converter) {
*ptr = (*tc->converter)((void *) p);
}
}
return TCL_OK;
}
/* Take a pointer and convert it to a string */
SWIGSTATICRUNTIME(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);
} else {
strcpy (c, "NULL");
}
}
/* Create a new pointer object */
SWIGSTATICRUNTIME(Tcl_Obj *)
SWIG_NewPointerObj(void *ptr, _swig_type_info *type) {
char result[256];
Tcl_Obj *robj;
SWIG_MakePtr(result,ptr,type);
robj = Tcl_NewStringObj(result,-1);
return robj;
}
/* Get arguments */
SWIGSTATICRUNTIME(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;
_swig_type_info *ty;
va_start(ap,fmt);
for (c = fmt; (*c && (*c != ':')); c++,argno++) {
if (*c == '|') {
opt = 1;
c++;
}
if (argno >= (objc-1)) {
if (!opt) {
Tcl_SetResult(interp,"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++;
}
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;
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;
break;
case 's':
if (*(c+1) == '#') {
int *vlptr = (int *) va_arg(ap, void *);
*((char **) vptr) = Tcl_GetStringFromObj(objv[argno+1], vlptr);
c++;
} else {
*((char **)vptr) = Tcl_GetStringFromObj(objv[argno+1],NULL);
}
break;
case 'c':
*((char *)vptr) = *(Tcl_GetStringFromObj(objv[argno+1],NULL));
break;
case 'p':
ty = (_swig_type_info *) va_arg(ap, void *);
if (SWIG_ConvertPtr(interp, objv[argno+1], (void **) vptr, ty) == TCL_ERROR) goto argerror;
break;
case 'o':
*((Tcl_Obj **)vptr) = objv[argno+1];
break;
default:
break;
}
}
}
if ((objc-1) > argno) {
Tcl_SetResult(interp,"Wrong # args.", TCL_STATIC);
goto argerror;
}
va_end(ap);
return TCL_OK;
argerror:
{
char temp[32];
sprintf(temp,"%d", argno);
Tcl_AppendResult(interp,strchr(fmt,':'), " argument ", temp, NULL);
va_end(ap);
return TCL_ERROR;
}
}
/* Structure for command table */
typedef struct {
const char *name;
int (*wrapper)(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []);
ClientData clientdata;
} _swig_command_info;
/* Structure for variable linking table */
typedef struct {
const char *name;
void *addr;
char * (*get)(ClientData, Tcl_Interp *, char *, char *, int);
char * (*set)(ClientData, Tcl_Interp *, char *, char *, int);
} _swig_var_info;
#ifdef __cplusplus
}
#endif

86
SWIG/Lib/tcl/tclsh.i Normal file
View file

@ -0,0 +1,86 @@
// $Header$
//
// SWIG File for building new tclsh program
// Dave Beazley
// April 25, 1996
//
#ifdef AUTODOC
%subsection "tclsh.i"
%text %{
This module provides the Tcl_AppInit() function needed to build a
new version of the tclsh executable. This file should not be used
when using dynamic loading. To make an interface file work with
both static and dynamic loading, put something like this in your
interface file :
#ifdef STATIC
%include tclsh.i
#endif
%}
#endif
%{
/* A TCL_AppInit() function that lets you build a new copy
* of tclsh.
*
* The macro SWIG_init contains the name of the initialization
* function in the wrapper file.
*/
#ifndef SWIG_RcFileName
char *SWIG_RcFileName = "~/.myapprc";
#endif
#ifdef MAC_TCL
extern int MacintoshInit _ANSI_ARGS_((void));
#endif
int Tcl_AppInit(Tcl_Interp *interp){
if (Tcl_Init(interp) == TCL_ERROR)
return TCL_ERROR;
/* Now initialize our functions */
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);
#else
tcl_RcFileName = SWIG_RcFileName;
#endif
#ifdef SWIG_RcRsrcName
Tcl_SetVar(interp,"tcl_rcRsrcName",SWIG_RcRsrcName,TCL_GLOBAL);
#endif
return TCL_OK;
}
#if TCL_MAJOR_VERSION > 7 || TCL_MAJOR_VERSION == 7 && TCL_MINOR_VERSION >= 4
int main(int argc, char **argv) {
#ifdef MAC_TCL
char *newArgv[2];
if (MacintoshInit() != TCL_OK) {
Tcl_Exit(1);
}
argc = 1;
newArgv[0] = "tclsh";
newArgv[1] = NULL;
argv = newArgv;
#endif
Tcl_Main(argc, argv, Tcl_AppInit);
return(0);
}
#else
extern int main();
#endif
%}

555
SWIG/Lib/tcl/typemaps.i Normal file
View file

@ -0,0 +1,555 @@
//
// SWIG Typemap library
// Dave Beazley
// May 4, 1997
//
// Tcl implementation
//
// This library provides standard typemaps for modifying SWIG's behavior.
// With enough entries in this file, I hope that very few people actually
// ever need to write a typemap.
#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.
int *INPUT
short *INPUT
long *INPUT
unsigned int *INPUT
unsigned short *INPUT
unsigned long *INPUT
unsigned char *INPUT
float *INPUT
double *INPUT
To use these, suppose you had a C function like this :
double fadd(double *a, double *b) {
return *a+*b;
}
You could wrap it with SWIG as follows :
%include typemaps.i
double fadd(double *INPUT, double *INPUT);
or you can use the %apply directive :
%include typemaps.i
%apply double *INPUT { double *a, double *b };
double fadd(double *a, double *b);
%}
#endif
%typemap(tcl,in) double *INPUT(double temp)
{
if (Tcl_GetDouble(interp,$source,&temp) == TCL_ERROR) {
return TCL_ERROR;
}
$target = &temp;
}
%typemap(tcl,in) float *INPUT(double dvalue, float temp)
{
if (Tcl_GetDouble(interp,$source,&dvalue) == TCL_ERROR) {
return TCL_ERROR;
}
temp = (float) dvalue;
$target = &temp;
}
%typemap(tcl,in) int *INPUT(int temp)
{
if (Tcl_GetInt(interp,$source,&temp) == TCL_ERROR) {
return TCL_ERROR;
}
$target = &temp;
}
%typemap(tcl,in) short *INPUT(int ivalue, short temp)
{
if (Tcl_GetInt(interp,$source,&ivalue) == TCL_ERROR) {
return TCL_ERROR;
}
temp = (short) ivalue;
$target = &temp;
}
%typemap(tcl,in) long *INPUT(int ivalue, long temp)
{
if (Tcl_GetInt(interp,$source,&ivalue) == TCL_ERROR) {
return TCL_ERROR;
}
temp = (long) ivalue;
$target = &temp;
}
%typemap(tcl,in) unsigned int *INPUT(int ivalue, unsigned int temp)
{
if (Tcl_GetInt(interp,$source,&ivalue) == TCL_ERROR) {
return TCL_ERROR;
}
temp = (unsigned int) ivalue;
$target = &temp;
}
%typemap(tcl,in) unsigned short *INPUT(int ivalue, unsigned short temp)
{
if (Tcl_GetInt(interp,$source,&ivalue) == TCL_ERROR) {
return TCL_ERROR;
}
temp = (unsigned short) ivalue;
$target = &temp;
}
%typemap(tcl,in) unsigned long *INPUT(int ivalue, unsigned long temp)
{
if (Tcl_GetInt(interp,$source,&ivalue) == TCL_ERROR) {
return TCL_ERROR;
}
temp = (unsigned long) ivalue;
$target = &temp;
}
%typemap(tcl,in) unsigned char *INPUT(int ivalue, unsigned char temp)
{
if (Tcl_GetInt(interp,$source,&ivalue) == TCL_ERROR) {
return TCL_ERROR;
}
temp = (unsigned char) ivalue;
$target = &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
multiple output values, they are returned in the form of a Tcl list.
int *OUTPUT
short *OUTPUT
long *OUTPUT
unsigned int *OUTPUT
unsigned short *OUTPUT
unsigned long *OUTPUT
unsigned char *OUTPUT
float *OUTPUT
double *OUTPUT
For example, suppose you were trying to wrap the modf() function in the
C math library which splits x into integral and fractional parts (and
returns the integer part in one of its parameters).K:
double modf(double x, double *ip);
You could wrap it with SWIG as follows :
%include typemaps.i
double modf(double x, double *OUTPUT);
or you can use the %apply directive :
%include typemaps.i
%apply double *OUTPUT { double *ip };
double modf(double x, double *ip);
The Tcl output of the function would be a list containing both
output values.
%}
#endif
// Force the argument to be ignored.
%typemap(tcl,ignore) 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),
float *OUTPUT(float temp),
double *OUTPUT(double temp)
{
$target = &temp;
}
%typemap(tcl,argout) int *OUTPUT,
short *OUTPUT,
long *OUTPUT
{
char dtemp[64];
sprintf(dtemp,"%ld",(long) *($source));
Tcl_AppendElement(interp,dtemp);
}
%typemap(tcl,argout) unsigned int *OUTPUT,
unsigned short *OUTPUT,
unsigned long *OUTPUT,
unsigned char *OUTPUT
{
char dtemp[64];
sprintf(dtemp,"%lu", (unsigned long) *($source));
Tcl_AppendElement(interp,dtemp);
}
%typemap(tcl,argout) float *OUTPUT,
double *OUTPUT
{
char dtemp[TCL_DOUBLE_SPACE];
Tcl_PrintDouble(interp, (double) *($source), dtemp);
Tcl_AppendElement(interp,dtemp);
}
// BOTH
// 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
For example, suppose you were trying to wrap the following function :
void neg(double *x) {
*x = -(*x);
}
You could wrap it with SWIG as follows :
%include typemaps.i
void neg(double *BOTH);
or you can use the %apply directive :
%include typemaps.i
%apply double *BOTH { double *x };
void neg(double *x);
Unlike C, this mapping does not directly modify the input value (since
this makes no sense in Tcl). Rather, the modified input value shows
up as the return value of the function. Thus, to apply this function
to a Tcl variable you might do this :
set x [neg $x]
%}
#endif
%typemap(tcl,in) int *BOTH = int *INPUT;
%typemap(tcl,in) short *BOTH = short *INPUT;
%typemap(tcl,in) long *BOTH = long *INPUT;
%typemap(tcl,in) unsigned int *BOTH = unsigned int *INPUT;
%typemap(tcl,in) unsigned short *BOTH = unsigned short *INPUT;
%typemap(tcl,in) unsigned long *BOTH = unsigned long *INPUT;
%typemap(tcl,in) unsigned char *BOTH = unsigned char *INPUT;
%typemap(tcl,in) float *BOTH = float *INPUT;
%typemap(tcl,in) double *BOTH = double *INPUT;
%typemap(tcl,argout) int *BOTH = int *OUTPUT;
%typemap(tcl,argout) short *BOTH = short *OUTPUT;
%typemap(tcl,argout) long *BOTH = long *OUTPUT;
%typemap(tcl,argout) unsigned int *BOTH = unsigned int *OUTPUT;
%typemap(tcl,argout) unsigned short *BOTH = unsigned short *OUTPUT;
%typemap(tcl,argout) unsigned long *BOTH = unsigned long *OUTPUT;
%typemap(tcl,argout) unsigned char *BOTH = unsigned char *OUTPUT;
%typemap(tcl,argout) float *BOTH = float *OUTPUT;
%typemap(tcl,argout) double *BOTH = double *OUTPUT;
// --------------------------------------------------------------------
// Special types
//
// --------------------------------------------------------------------
// 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
Passes the current Tcl_Interp value directly to a C function.
This can be used to work with existing wrapper functions or
if you just need the interp value for some reason. When used,
the 'interp' parameter becomes hidden in the Tcl interface--that
is, you don't specify it explicitly. SWIG fills in its value
automatically.
int Tcl_Result
Makes the integer return code of a function the return value
of a SWIG generated wrapper function. For example :
int foo() {
... do stuff ...
return TCL_OK;
}
could be wrapped as follows :
%include typemaps.i
%apply int Tcl_Result { int foo };
int foo();
%}
#endif
%typemap(tcl,ignore) Tcl_Interp *interp {
$target = interp;
}
// If return code is a Tcl_Result, simply pass it on
%typemap(tcl,out) int Tcl_Result {
interp->result = "";
return $source;
}
/***************************************************************************
* Tcl 8.0 typemaps
***************************************************************************/
// ------------------------------------------------------------------------
// 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.
%typemap(tcl8,in) double *INPUT(double temp)
{
if (Tcl_GetDoubleFromObj(interp,$source,&temp) == TCL_ERROR) {
return TCL_ERROR;
}
$target = &temp;
}
%typemap(tcl8,in) float *INPUT(double dvalue, float temp)
{
if (Tcl_GetDoubleFromObj(interp,$source,&dvalue) == TCL_ERROR) {
return TCL_ERROR;
}
temp = (float) dvalue;
$target = &temp;
}
%typemap(tcl8,in) int *INPUT(int temp)
{
if (Tcl_GetIntFromObj(interp,$source,&temp) == TCL_ERROR) {
return TCL_ERROR;
}
$target = &temp;
}
%typemap(tcl8,in) short *INPUT(int ivalue, short temp)
{
if (Tcl_GetIntFromObj(interp,$source,&ivalue) == TCL_ERROR) {
return TCL_ERROR;
}
temp = (short) ivalue;
$target = &temp;
}
%typemap(tcl8,in) long *INPUT(int ivalue, long temp)
{
if (Tcl_GetIntFromObj(interp,$source,&ivalue) == TCL_ERROR) {
return TCL_ERROR;
}
temp = (long) ivalue;
$target = &temp;
}
%typemap(tcl8,in) unsigned int *INPUT(int ivalue, unsigned int temp)
{
if (Tcl_GetIntFromObj(interp,$source,&ivalue) == TCL_ERROR) {
return TCL_ERROR;
}
temp = (unsigned int) ivalue;
$target = &temp;
}
%typemap(tcl8,in) unsigned short *INPUT(int ivalue, unsigned short temp)
{
if (Tcl_GetIntFromObj(interp,$source,&ivalue) == TCL_ERROR) {
return TCL_ERROR;
}
temp = (unsigned short) ivalue;
$target = &temp;
}
%typemap(tcl8,in) unsigned long *INPUT(int ivalue, unsigned long temp)
{
if (Tcl_GetIntFromObj(interp,$source,&ivalue) == TCL_ERROR) {
return TCL_ERROR;
}
temp = (unsigned long) ivalue;
$target = &temp;
}
%typemap(tcl8,in) unsigned char *INPUT(int ivalue, unsigned char temp)
{
if (Tcl_GetIntFromObj(interp,$source,&ivalue) == TCL_ERROR) {
return TCL_ERROR;
}
temp = (unsigned char) ivalue;
$target = &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.
// Force the argument to be ignored.
%typemap(tcl8,ignore) 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),
float *OUTPUT(float temp),
double *OUTPUT(double temp)
{
$target = &temp;
}
%typemap(tcl8,argout) int *OUTPUT,
short *OUTPUT,
long *OUTPUT,
unsigned int *OUTPUT,
unsigned short *OUTPUT,
unsigned long *OUTPUT,
unsigned char *OUTPUT
{
Tcl_Obj *o;
o = Tcl_NewIntObj((int) *($source));
Tcl_ListObjAppendElement(interp,Tcl_GetObjResult(interp),o);
}
%typemap(tcl8,argout) float *OUTPUT,
double *OUTPUT
{
Tcl_Obj *o;
o = Tcl_NewDoubleObj((double) *($source));
Tcl_ListObjAppendElement(interp,Tcl_GetObjResult(interp),o);
}
// BOTH
// Mappings for an argument that is both an input and output
// parameter
%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(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;
// --------------------------------------------------------------------
// Special types
//
// --------------------------------------------------------------------
// If interp * appears as a function argument, we ignore it and get
// it from the wrapper function.
%typemap(tcl8,ignore) Tcl_Interp *interp {
$target = interp;
}
// If return code is a Tcl_Result, simply pass it on
%typemap(tcl8,out) int Tcl_Result {
return $source;
}

163
SWIG/Lib/tcl/wish.i Normal file
View file

@ -0,0 +1,163 @@
//
// $Header$
//
// SWIG File for making wish
// Dave Beazley
// April 25, 1996
//
/* Revision History
* $Log$
* Revision 1.1 2000/01/11 21:15:54 beazley
* Added files
*
* Revision 1.2 1999/11/05 21:45:14 beazley
* Minor Changes
*
* Revision 1.1.1.1 1999/02/28 02:00:56 beazley
* Swig1.1
*
* Revision 1.1 1996/05/22 19:47:45 beazley
* Initial revision
*
*/
#ifdef AUTODOC
%subsection "wish.i"
%text %{
This module provides the Tk_AppInit() function needed to build a
new version of the wish executable. Like tclsh.i, this file should
not be used with dynamic loading. To make an interface file work with
both static and dynamic loading, put something like this in your
interface file :
#ifdef STATIC
%include wish.i
#endif
A startup file may be specified by defining the symbol SWIG_RcFileName
as follows (this should be included in a code-block) :
#define SWIG_RcFileName "~/.mywishrc"
%}
#endif
%{
/* Initialization code for wish */
#include <tk.h>
#ifndef SWIG_RcFileName
char *SWIG_RcFileName = "~/.wishrc";
#endif
#ifdef MAC_TCL
extern int MacintoshInit _ANSI_ARGS_((void));
extern int SetupMainInterp _ANSI_ARGS_((Tcl_Interp *interp));
#endif
/*
*----------------------------------------------------------------------
*
* Tcl_AppInit --
*
* This procedure performs application-specific initialization.
* Most applications, especially those that incorporate additional
* packages, will have their own version of this procedure.
*
* Results:
* Returns a standard Tcl completion code, and leaves an error
* message in interp->result if an error occurs.
*
* Side effects:
* Depends on the startup script.
*
*----------------------------------------------------------------------
*/
int Tcl_AppInit(Tcl_Interp *interp)
{
#ifndef MAC_TCL
Tk_Window main;
main = Tk_MainWindow(interp);
#endif
/*
* Call the init procedures for included packages. Each call should
* look like this:
*
* if (Mod_Init(interp) == TCL_ERROR) {
* return TCL_ERROR;
* }
*
* where "Mod" is the name of the module.
*/
if (Tcl_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
if (Tk_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
/*
* Call Tcl_CreateCommand for application-specific commands, if
* they weren't already created by the init procedures called above.
*/
if (SWIG_init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
#ifdef MAC_TCL
SetupMainInterp(interp);
#endif
/*
* Specify a user-specific startup file to invoke if the application
* is run interactively. Typically the startup file is "~/.apprc"
* where "app" is the name of the application. If this line is deleted
* then no user-specific startup file will be run under any conditions.
*/
#if TCL_MAJOR_VERSION >= 8 || TCL_MAJOR_VERSION == 7 && TCL_MINOR_VERSION >= 5
Tcl_SetVar(interp,"tcl_rcFileName",SWIG_RcFileName,TCL_GLOBAL_ONLY);
#else
tcl_RcFileName = SWIG_RcFileName;
#endif
/* For Macintosh might also want this */
#ifdef MAC_TCL
#ifdef SWIG_RcRsrcName
Tcl_SetVar(interp,"tcl_rcRsrcName",SWIG_RcRsrcName,TCL_GLOBAL_ONLY);
#endif
#endif
return TCL_OK;
}
#if TK_MAJOR_VERSION >= 4
int main(int argc, char **argv) {
#ifdef MAC_TCL
char *newArgv[2];
if (MacintoshInit() != TCL_OK) {
Tcl_Exit(1);
}
argc = 1;
newArgv[0] = "Wish";
newArgv[1] = NULL;
argv = newArgv;
#endif
Tk_Main(argc, argv, Tcl_AppInit);
return(0);
}
#else
extern int main();
#endif
%}