c90f71dd8c
special cases and other things in wxPython, and since I plan on making several more, I've decided to put the SWIG sources in wxPython's CVS instead of relying on maintaining patches. This effectivly becomes a fork of an obsolete version of SWIG, :-( but since SWIG 1.3 still doesn't have some things I rely on in 1.1, not to mention that my custom patches would all have to be redone, I felt that this is the easier road to take. git-svn-id: https://svn.wxwidgets.org/svn/wx/wxWidgets/trunk@15307 c3d73ce0-8a6f-49c7-b76d-6d57e0e08775
1500 lines
42 KiB
C++
1500 lines
42 KiB
C++
/*******************************************************************************
|
|
* Simplified Wrapper and Interface Generator (SWIG)
|
|
*
|
|
* Author : David Beazley
|
|
*
|
|
* Department of Computer Science
|
|
* University of Chicago
|
|
* 1100 E 58th Street
|
|
* Chicago, IL 60637
|
|
* beazley@cs.uchicago.edu
|
|
*
|
|
* Please read the file LICENSE for the copyright and terms by which SWIG
|
|
* can be used and distributed.
|
|
*******************************************************************************/
|
|
|
|
/***********************************************************************
|
|
* $Header$
|
|
*
|
|
* tcl8.cxx
|
|
*
|
|
* Module for creating Tcl 8.0 native wrapper functions. Older SWIG
|
|
* modules will work with Tcl 8.0, but this one provides a significant
|
|
* boost in performance.
|
|
***********************************************************************/
|
|
|
|
#include "swig.h"
|
|
#include "tcl8.h"
|
|
#include <ctype.h>
|
|
|
|
static char *Tcl_config="swigtcl.swg";
|
|
static char *usage = "\
|
|
Tcl 8.0 Options (available with -tcl)\n\
|
|
-module name - Set name of module\n\
|
|
-prefix name - Set a prefix to be appended to all names\n\
|
|
-namespace - Build module into a Tcl 8 namespace. \n\
|
|
-noobject - Omit code for object oriented interface.\n\
|
|
-old - Use old SWIG interface (same as -noobject).\n\n";
|
|
|
|
static char *ns_name = 0;
|
|
|
|
static String mod_init;
|
|
static String mod_extern;
|
|
|
|
// ---------------------------------------------------------------------
|
|
// TCL8::parse_args(int argc, char *argv[])
|
|
//
|
|
// Parse tcl specific command line options
|
|
// ---------------------------------------------------------------------
|
|
|
|
void TCL8::parse_args(int argc, char *argv[]) {
|
|
|
|
int i = 1;
|
|
sprintf(LibDir,"%s",tcl_path);
|
|
|
|
// Look for certain command line options
|
|
|
|
for (i = 1; i < argc; i++) {
|
|
if (argv[i]) {
|
|
if (strcmp(argv[i],"-prefix") == 0) {
|
|
if (argv[i+1]) {
|
|
prefix = new char[strlen(argv[i+1])+2];
|
|
strcpy(prefix, argv[i+1]);
|
|
mark_arg(i);
|
|
mark_arg(i+1);
|
|
i++;
|
|
} else {
|
|
arg_error();
|
|
}
|
|
} else if (strcmp(argv[i],"-module") == 0) {
|
|
if (argv[i+1]) {
|
|
set_module(argv[i+1],0);
|
|
mark_arg(i);
|
|
mark_arg(i+1);
|
|
i++;
|
|
} else {
|
|
arg_error();
|
|
}
|
|
} else if (strcmp(argv[i],"-namespace") == 0) {
|
|
nspace = 1;
|
|
mark_arg(i);
|
|
} else if (strcmp(argv[i],"-old") == 0) {
|
|
shadow = 0;
|
|
mark_arg(i);
|
|
} else if (strcmp(argv[i],"-noobject") == 0) {
|
|
shadow = 0;
|
|
mark_arg(i);
|
|
} else if (strcmp(argv[i],"-help") == 0) {
|
|
fputs(usage,stderr);
|
|
}
|
|
}
|
|
}
|
|
|
|
// If a package has been specified, make sure it ends with a '_'
|
|
|
|
if (prefix) {
|
|
ns_name = copy_string(prefix);
|
|
if (prefix[strlen(prefix)] != '_') {
|
|
prefix[strlen(prefix)+1] = 0;
|
|
prefix[strlen(prefix)] = '_';
|
|
}
|
|
} else
|
|
prefix = "";
|
|
|
|
// Create a symbol SWIGTCL
|
|
|
|
add_symbol("SWIGTCL",0,0);
|
|
add_symbol("SWIGTCL8",0,0);
|
|
|
|
// Set name of typemaps
|
|
|
|
typemap_lang = "tcl8";
|
|
|
|
// Attempt to load up the C++ configuration files
|
|
|
|
get_file("delcmd8.swg",delcmd);
|
|
get_file("methodcmd8.swg",methodcmd);
|
|
get_file("objcmd8.swg",objcmd);
|
|
|
|
}
|
|
|
|
// ---------------------------------------------------------------------
|
|
// void TCL8::parse()
|
|
//
|
|
// Start parsing an interface file for Tcl.
|
|
// ---------------------------------------------------------------------
|
|
|
|
void TCL8::parse() {
|
|
|
|
fprintf(stderr,"Making wrappers for Tcl 8.x\n");
|
|
|
|
// Print out TCL specific headers
|
|
|
|
headers();
|
|
|
|
// Run the parser
|
|
|
|
yyparse();
|
|
|
|
}
|
|
|
|
// ---------------------------------------------------------------------
|
|
// TCL8::set_module(char *mod_name,char **mod_list)
|
|
//
|
|
// Sets the module name.
|
|
// Does nothing if it's already set (so it can be overridden as a command
|
|
// line option).
|
|
//
|
|
// mod_list is a NULL-terminated list of additional modules. This
|
|
// is really only useful when building static executables and other
|
|
// things.
|
|
//----------------------------------------------------------------------
|
|
|
|
void TCL8::set_module(char *mod_name, char **mod_list) {
|
|
|
|
char temp[256], *c;
|
|
int i;
|
|
|
|
if (module) return;
|
|
|
|
module = new char[strlen(mod_name)+1];
|
|
strcpy(module,mod_name);
|
|
|
|
// Fix capitalization for Tcl
|
|
|
|
c = module;
|
|
while (*c) {
|
|
*c = (char) tolower(*c);
|
|
c++;
|
|
}
|
|
|
|
// Now create an initialization function
|
|
|
|
sprintf(temp,"%s_Init", module);
|
|
init_name = new char[strlen(temp) + 1];
|
|
strcpy(init_name, temp);
|
|
*init_name = toupper(*init_name);
|
|
|
|
if (!ns_name) ns_name = copy_string(module);
|
|
|
|
// If namespaces have been specified, set the prefix to the module name
|
|
|
|
if ((nspace) && (strlen(prefix) < 1)) {
|
|
prefix = new char[strlen(module)+2];
|
|
strcpy(prefix,module);
|
|
prefix[strlen(module)] = '_';
|
|
prefix[strlen(module)+1] = 0;
|
|
}
|
|
|
|
// If additional modules have been specified, create some code for
|
|
// initializing them.
|
|
|
|
if (mod_list) {
|
|
i = 0;
|
|
while (mod_list[i]) {
|
|
c = mod_list[i];
|
|
while (*c) {
|
|
*c = (char) tolower(*c);
|
|
c++;
|
|
}
|
|
sprintf(temp,"%s_Init",mod_list[i]);
|
|
temp[0] = toupper(temp[0]);
|
|
|
|
// Dump out some initialization code
|
|
|
|
mod_init << tab4 << "if (" << temp << "(" << interp_name << ") == TCL_ERROR) {\n"
|
|
<< tab8 << "return TCL_ERROR;\n"
|
|
<< tab4 << "}\n\n";
|
|
mod_extern << "extern int " << temp << "(Tcl_Interp *);\n";
|
|
i++;
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
// ---------------------------------------------------------------------
|
|
// TCL8::set_init(char *iname)
|
|
//
|
|
// Sets the initialization function name.
|
|
// Does nothing if it's already set
|
|
//
|
|
//----------------------------------------------------------------------
|
|
|
|
void TCL8::set_init(char *iname) {
|
|
|
|
if (init_name) return;
|
|
init_name = new char[strlen(iname)+1];
|
|
strcpy(init_name, iname);
|
|
|
|
}
|
|
|
|
// ---------------------------------------------------------------------
|
|
// TCL8::headers(void)
|
|
//
|
|
// Generate the appropriate header files for TCL interface.
|
|
// ----------------------------------------------------------------------
|
|
|
|
void TCL8::headers(void)
|
|
{
|
|
|
|
emit_banner(f_header);
|
|
fprintf(f_header,"/* Implementation : TCL 8.0 */\n\n");
|
|
fprintf(f_header,"#include <tcl.h>\n");
|
|
fprintf(f_header,"#include <string.h>\n");
|
|
fprintf(f_header,"#include <stdlib.h>\n");
|
|
fprintf(f_header,"#define SWIGTCL\n");
|
|
fprintf(f_header,"#define SWIGTCL8\n");
|
|
|
|
// Include a Tcl configuration file for Unix,Mac,Wintel.
|
|
|
|
if (NoInclude) {
|
|
fprintf(f_header,"#define SWIG_NOINCLUDE\n");
|
|
}
|
|
|
|
if (insert_file("swigtcl8.swg",f_header) == -1) {
|
|
fprintf(stderr,"SWIG : Fatal error. Unable to locate 'swigtcl8.swg' in SWIG library.\n");
|
|
SWIG_exit(1);
|
|
}
|
|
}
|
|
|
|
// --------------------------------------------------------------------
|
|
// TCL8::initialize(void)
|
|
//
|
|
// Produces an initialization function. Assumes that the init function
|
|
// name has already been specified.
|
|
// ---------------------------------------------------------------------
|
|
|
|
void TCL8::initialize()
|
|
{
|
|
|
|
if ((!ns_name) && (nspace)) {
|
|
fprintf(stderr,"Tcl error. Must specify a namespace.\n");
|
|
SWIG_exit(1);
|
|
}
|
|
|
|
if (!init_name) {
|
|
init_name = "Swig_Init";
|
|
fprintf(stderr,"SWIG : *** Warning. No module name specified.\n");
|
|
}
|
|
|
|
fprintf(f_header,"#define SWIG_init %s\n", init_name);
|
|
if (!module) module = "swig";
|
|
fprintf(f_header,"#define SWIG_name \"%s\"\n", module);
|
|
if (nspace) {
|
|
fprintf(f_header,"#define SWIG_prefix \"%s::\"\n", ns_name);
|
|
fprintf(f_header,"#define SWIG_namespace \"%s\"\n\n", ns_name);
|
|
} else {
|
|
fprintf(f_header,"#define SWIG_prefix \"%s\"\n", prefix);
|
|
fprintf(f_header,"#define SWIG_namespace \"\"\n\n");
|
|
}
|
|
fprintf(f_header,"#ifdef __cplusplus\n");
|
|
fprintf(f_header,"extern \"C\" {\n");
|
|
fprintf(f_header,"#endif\n");
|
|
fprintf(f_header,"#ifdef MAC_TCL\n");
|
|
fprintf(f_header,"#pragma export on\n");
|
|
fprintf(f_header,"#endif\n");
|
|
fprintf(f_header,"SWIGEXPORT(int) %s(Tcl_Interp *);\n", init_name);
|
|
fprintf(f_header,"#ifdef MAC_TCL\n");
|
|
fprintf(f_header,"#pragma export off\n");
|
|
fprintf(f_header,"#endif\n");
|
|
fprintf(f_header,"#ifdef __cplusplus\n");
|
|
fprintf(f_header,"}\n");
|
|
fprintf(f_header,"#endif\n");
|
|
|
|
|
|
fprintf(f_init,"SWIGEXPORT(int) %s(Tcl_Interp *%s) {\n", init_name, interp_name);
|
|
if (nspace) {
|
|
fprintf(f_init,"#ifdef ITCL_NAMESPACES\n");
|
|
fprintf(f_init,"\t Itcl_Namespace spaceId;\n");
|
|
fprintf(f_init,"#endif\n");
|
|
}
|
|
|
|
fprintf(f_init,"\t if (%s == 0) \n", interp_name);
|
|
fprintf(f_init,"\t\t return TCL_ERROR;\n");
|
|
|
|
/* Set up SwigPtrType table */
|
|
|
|
fprintf(f_init,"\t SWIG_RegisterType();\n");
|
|
|
|
/* Check to see if other initializations need to be performed */
|
|
|
|
if (strlen(mod_extern.get())) {
|
|
fprintf(f_init,"%s\n",mod_init.get());
|
|
fprintf(f_header,"#ifdef __cplusplus\n");
|
|
fprintf(f_header,"extern \"C\" {\n");
|
|
fprintf(f_header,"#endif\n");
|
|
fprintf(f_header,"%s\n",mod_extern.get());
|
|
fprintf(f_header,"#ifdef __cplusplus\n");
|
|
fprintf(f_header,"}\n");
|
|
fprintf(f_header,"#endif\n");
|
|
}
|
|
|
|
|
|
/* Check to see if we're adding support for Tcl8 nspaces */
|
|
if (nspace) {
|
|
fprintf(f_init,"#if (TCL_MAJOR_VERSION >= 8)\n");
|
|
fprintf(f_init,"\t Tcl_Eval(%s,\"namespace eval %s { }\");\n", interp_name, ns_name);
|
|
fprintf(f_init,"#endif\n");
|
|
}
|
|
}
|
|
|
|
// ---------------------------------------------------------------------
|
|
// TCL8::close(void)
|
|
//
|
|
// Wrap things up. Close initialization function.
|
|
// ---------------------------------------------------------------------
|
|
|
|
void TCL8::close(void)
|
|
{
|
|
|
|
// Dump the pointer equivalency table
|
|
|
|
emit_ptr_equivalence(f_init);
|
|
|
|
// Close the init file and quit
|
|
|
|
fprintf(f_init,"%s",postinit.get());
|
|
fprintf(f_init,"\t return TCL_OK;\n");
|
|
fprintf(f_init,"}\n");
|
|
|
|
}
|
|
|
|
// ----------------------------------------------------------------------
|
|
// TCL8::get_pointer(char *iname, char *srcname, char *src, char *dest,
|
|
// DataType *t, String &f, char *ret)
|
|
//
|
|
// iname = name of function or variable
|
|
// srcname = name of source
|
|
// src = source variable in wrapper code
|
|
// dest = destination variable in wrapper code
|
|
// t = Datatype
|
|
// f = String where output is going to go
|
|
// ret = Return action
|
|
// ----------------------------------------------------------------------
|
|
|
|
void TCL8::get_pointer(char *iname, char *srcname, char *src, char *dest,
|
|
DataType *t, String &f, char *ret) {
|
|
|
|
// Pointers are read as hex-strings with encoded type information
|
|
|
|
f << tab4 << "if ((rettype = SWIG_GetPointerObj(interp," << src << ",(void **) &" << dest << ",";
|
|
|
|
if (t->type == T_VOID) f << "(char *) 0))) {\n";
|
|
else
|
|
f << "\"" << t->print_mangle() << "\"))) {\n";
|
|
|
|
// Now emit code according to the level of strictness desired
|
|
|
|
switch(TypeStrict) {
|
|
case 0: // No type checking
|
|
f << tab4 << "}\n";
|
|
break;
|
|
case 1: // Warning message only
|
|
f << tab8 << "fprintf(stderr,\"Warning : type mismatch in " << srcname
|
|
<< " of " << iname << ". Expected " << t->print_mangle()
|
|
<< ", received %s\\n\", rettype);\n"
|
|
<< tab4 << "}\n";
|
|
case 2: // Super strict mode.
|
|
f << tab8 << "Tcl_SetStringObj(tcl_result, \"Type error in " << srcname << " of " << iname
|
|
<< ". Expected " << t->print_mangle() << ", received \", -1);\n"
|
|
<< tab8 << "Tcl_AppendToObj(tcl_result, rettype, -1);\n"
|
|
<< tab8 << ret << ";\n"
|
|
<< tab4 << "}\n";
|
|
break;
|
|
default :
|
|
fprintf(stderr,"Unknown strictness level\n");
|
|
break;
|
|
}
|
|
}
|
|
|
|
|
|
// ----------------------------------------------------------------------
|
|
// TCL8::create_command(char *cname, char *iname)
|
|
//
|
|
// Creates a Tcl command from a C function.
|
|
// ----------------------------------------------------------------------
|
|
|
|
void TCL8::create_command(char *cname, char *iname) {
|
|
|
|
char *wname = name_wrapper(cname,prefix);
|
|
|
|
fprintf(f_init,"\t Tcl_CreateObjCommand(%s, SWIG_prefix \"%s\",%s, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);\n", interp_name, iname, wname);
|
|
|
|
// Add interpreter name to repeatcmd hash table. This hash is used in C++ code
|
|
// generation to try and find repeated wrapper functions.
|
|
|
|
repeatcmd.add(iname,copy_string(wname));
|
|
}
|
|
|
|
// ----------------------------------------------------------------------
|
|
// TCL8::create_function(char *name, char *iname, DataType *d, ParmList *l)
|
|
//
|
|
// Create a function declaration and register it with the interpreter.
|
|
// ----------------------------------------------------------------------
|
|
|
|
void TCL8::create_function(char *name, char *iname, DataType *d, ParmList *l)
|
|
{
|
|
Parm *p;
|
|
int pcount,i,j;
|
|
char *wname;
|
|
char *usage = 0, *tm;
|
|
char source[64];
|
|
char target[64];
|
|
char argnum[32];
|
|
WrapperFunction f;
|
|
String cleanup, outarg, build;
|
|
int numopt= 0;
|
|
int have_build = 0;
|
|
|
|
// Make a wrapper name for this function
|
|
|
|
wname = name_wrapper(iname,prefix);
|
|
|
|
// Now write the wrapper function itself....this is pretty ugly
|
|
|
|
f.def << "static int " << wname << "(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) {\n";
|
|
|
|
f.code << tab4 << "clientData = clientData; objv = objv;\n";
|
|
|
|
// Print out variables for storing arguments.
|
|
|
|
pcount = emit_args(d, l, f);
|
|
numopt = l->numopt();
|
|
|
|
// Create a local variable for holding the interpreter result value
|
|
|
|
f.add_local("Tcl_Obj *", "tcl_result");
|
|
|
|
// Extract the tcl result object
|
|
|
|
f.code << tab4 << "tcl_result = Tcl_GetObjResult(interp);\n";
|
|
|
|
// Check the number of arguments
|
|
|
|
usage = usage_func(iname,d,l); // Create a usage string
|
|
f.code << tab4 << "if ((objc < " << (pcount-numopt) +1 << ") || (objc > " << l->numarg()+1 << ")) {\n"
|
|
<< tab8 << "Tcl_SetStringObj(tcl_result,\"Wrong # args. " << usage << "\",-1);\n"
|
|
<< tab8 << "return TCL_ERROR;\n"
|
|
<< tab4 << "}\n";
|
|
|
|
// Extract parameters. This case statement should be used to extract
|
|
// Function parameters. Add more cases if you want to do more.
|
|
|
|
i = 0;
|
|
j = 0;
|
|
p = l->get_first();
|
|
while (p != 0) {
|
|
// Produce string representations of the source and target arguments
|
|
sprintf(source,"objv[%d]",j+1);
|
|
sprintf(target,"_arg%d",i);
|
|
sprintf(argnum,"%d",j+1);
|
|
|
|
// See if this argument is being ignored
|
|
|
|
if (!p->ignore) {
|
|
if (j >= (pcount-numopt))
|
|
f.code << tab4 << "if (objc >" << j+1 << ") { \n";
|
|
|
|
if ((tm = typemap_lookup("in","tcl8",p->t,p->name,source,target,&f))) {
|
|
// Yep. Use it instead of the default
|
|
f.code << tm << "\n";
|
|
f.code.replace("$argnum",argnum);
|
|
f.code.replace("$arg",source);
|
|
} else {
|
|
if (!p->t->is_pointer) {
|
|
|
|
// Extract a parameter by value.
|
|
|
|
switch(p->t->type) {
|
|
|
|
// Signed Integers
|
|
|
|
case T_BOOL:
|
|
case T_INT:
|
|
case T_SINT:
|
|
case T_SHORT:
|
|
case T_SSHORT:
|
|
case T_LONG:
|
|
case T_SLONG:
|
|
case T_SCHAR:
|
|
|
|
// Unsigned integers
|
|
|
|
case T_UINT:
|
|
case T_USHORT:
|
|
case T_ULONG:
|
|
case T_UCHAR:
|
|
f.add_local("int","tempint");
|
|
f.code << tab4 << "if (Tcl_GetIntFromObj(interp,objv[" << j+1 << "],&tempint) == TCL_ERROR) return TCL_ERROR;\n";
|
|
f.code << tab4 << "_arg" << i << " = " << p->t->print_cast() << " tempint;\n";
|
|
break;
|
|
|
|
// Floating point
|
|
|
|
case T_FLOAT:
|
|
case T_DOUBLE:
|
|
f.add_local("double","tempdouble");
|
|
f.add_local("Tcl_Obj *", "dupobj");
|
|
f.code << tab4 << "dupobj = Tcl_DuplicateObj(objv[" << j+1 << "]);\n"
|
|
<< tab4 << "if (Tcl_GetDoubleFromObj(interp,dupobj,&tempdouble) == TCL_ERROR) {\n"
|
|
<< tab8 << "Tcl_DecrRefCount(dupobj);\n"
|
|
<< tab8 << "return TCL_ERROR;\n"
|
|
<< tab4 << "}\n"
|
|
<< tab4 << "Tcl_DecrRefCount(dupobj);\n"
|
|
<< tab4 << "_arg" << i << " = " << p->t->print_cast() << " tempdouble;\n";
|
|
break;
|
|
|
|
// A single character
|
|
|
|
case T_CHAR :
|
|
f.add_local("char *","tempstr");
|
|
f.add_local("int","templength");
|
|
f.code << tab4 << "if ((tempstr = Tcl_GetStringFromObj(objv[" << j+1 << "],&templength)) == NULL) return TCL_ERROR;\n"
|
|
<< tab4 << "_arg" << i << " = *tempstr;\n";
|
|
break;
|
|
|
|
// Void.. Do nothing.
|
|
|
|
case T_VOID :
|
|
break;
|
|
|
|
// User defined. This is an error.
|
|
|
|
case T_USER:
|
|
|
|
// Unsupported data type
|
|
|
|
default :
|
|
fprintf(stderr,"%s : Line %d: Unable to use type %s as a function argument.\n",
|
|
input_file, line_number, p->t->print_type());
|
|
break;
|
|
}
|
|
} else {
|
|
|
|
// Function argument is some sort of pointer
|
|
// Look for a string. Otherwise, just pull off a pointer.
|
|
|
|
if ((p->t->type == T_CHAR) && (p->t->is_pointer == 1)) {
|
|
f.add_local("int","templength");
|
|
f.code << tab4 << "if ((_arg" << i << " = Tcl_GetStringFromObj(objv[" << j+1 << "], &templength)) == NULL) return TCL_ERROR;\n";
|
|
} else {
|
|
|
|
// Have a generic pointer type here. Read it in as
|
|
// a hex-string
|
|
char arg_temp[256];
|
|
|
|
// Try to parse pointer value directly
|
|
|
|
#ifdef OLD
|
|
f.add_local("char *", "tempstr");
|
|
f.add_local("int","templength");
|
|
f.code << tab4 << "if ((tempstr = Tcl_GetStringFromObj(objv[" << j+1 << "],&templength)) == NULL) return TCL_ERROR;\n";
|
|
get_pointer(iname,arg_temp,"tempstr",target,p->t,f.code,"return TCL_ERROR");
|
|
#endif
|
|
sprintf(arg_temp,"argument %d",j+1);
|
|
f.add_local("char *", "rettype");
|
|
get_pointer(iname,arg_temp,source,target,p->t,f.code,"return TCL_ERROR");
|
|
}
|
|
}
|
|
}
|
|
if (j >= (pcount-numopt))
|
|
f.code << tab4 << "}\n";
|
|
j++;
|
|
}
|
|
|
|
|
|
// Check to see if there is any sort of "build" typemap (highly complicated)
|
|
|
|
if ((tm = typemap_lookup("build","tcl8",p->t,p->name,source,target))) {
|
|
build << tm << "\n";
|
|
have_build = 1;
|
|
}
|
|
|
|
// Check to see if there was any sort of a constaint typemap
|
|
if ((tm = typemap_lookup("check","tcl8",p->t,p->name,source,target))) {
|
|
// Yep. Use it instead of the default
|
|
f.code << tm << "\n";
|
|
f.code.replace("$argnum",argnum);
|
|
f.code.replace("$arg",source);
|
|
}
|
|
|
|
// Check if there was any cleanup code (save it for later)
|
|
if ((tm = typemap_lookup("freearg","tcl8",p->t,p->name,target,"tcl_result"))) {
|
|
// Yep. Use it instead of the default
|
|
cleanup << tm << "\n";
|
|
cleanup.replace("$argnum",argnum);
|
|
cleanup.replace("$arg",source);
|
|
}
|
|
// Look for output arguments
|
|
if ((tm = typemap_lookup("argout","tcl8",p->t,p->name,target,"tcl_result"))) {
|
|
outarg << tm << "\n";
|
|
outarg.replace("$argnum",argnum);
|
|
outarg.replace("$arg",source);
|
|
}
|
|
i++;
|
|
p = l->get_next(); // Get next parameter and continue
|
|
}
|
|
|
|
|
|
// If there was a "build" typemap, we need to go in and perform a serious hack
|
|
|
|
if (have_build) {
|
|
char temp1[32];
|
|
char temp2[256];
|
|
l->sub_parmnames(build); // Replace all parameter names
|
|
j = 1;
|
|
for (i = 0; i < l->nparms; i++) {
|
|
p = l->get(i);
|
|
if (strlen(p->name) > 0) {
|
|
sprintf(temp1,"_in_%s", p->name);
|
|
} else {
|
|
sprintf(temp1,"_in_arg%d", i);
|
|
}
|
|
sprintf(temp2,"argv[%d]",j);
|
|
build.replaceid(temp1,temp2);
|
|
if (!p->ignore)
|
|
j++;
|
|
}
|
|
f.code << build;
|
|
}
|
|
|
|
// Now write code to make the function call
|
|
|
|
emit_func_call(name,d,l,f);
|
|
|
|
// Extract the tcl result object
|
|
|
|
f.code << tab4 << "tcl_result = Tcl_GetObjResult(interp);\n";
|
|
|
|
|
|
// Return value if necessary
|
|
|
|
if ((tm = typemap_lookup("out","tcl8",d,name,"_result","tcl_result"))) {
|
|
// Yep. Use it instead of the default
|
|
f.code << tm << "\n";
|
|
} else if ((d->type != T_VOID) || (d->is_pointer)) {
|
|
if (!d->is_pointer) {
|
|
|
|
// Function returns a "value"
|
|
|
|
switch(d->type) {
|
|
// Is an integer
|
|
case T_BOOL:
|
|
case T_INT:
|
|
case T_SINT:
|
|
case T_SHORT:
|
|
case T_SSHORT:
|
|
case T_LONG :
|
|
case T_SLONG:
|
|
case T_SCHAR:
|
|
case T_UINT:
|
|
case T_USHORT:
|
|
case T_ULONG:
|
|
case T_UCHAR:
|
|
f.code << tab4 << "Tcl_SetIntObj(tcl_result,(long) _result);\n";
|
|
break;
|
|
|
|
// Is a single character. Assume we return it as a string
|
|
case T_CHAR :
|
|
f.code << tab4 << "Tcl_SetStringObj(tcl_result,&_result,1);\n";
|
|
break;
|
|
|
|
// Floating point number
|
|
case T_DOUBLE :
|
|
case T_FLOAT :
|
|
f.code << tab4 << "Tcl_SetDoubleObj(tcl_result,(double) _result);\n";
|
|
break;
|
|
|
|
// User defined type
|
|
case T_USER :
|
|
|
|
// Okay. We're returning malloced memory at this point.
|
|
// Probably dangerous, but who said safety was a good thing?
|
|
|
|
// f.add_local("char","resultchar[256]");
|
|
d->is_pointer++;
|
|
#ifdef OLD
|
|
f.code << tab4 << "SWIG_MakePtr(resultchar, (void *) _result,\"" << d->print_mangle() << "\");\n"
|
|
<< tab4 << "Tcl_SetStringObj(tcl_result,resultchar,-1);\n";
|
|
#endif
|
|
f.code << tab4 << "SWIG_SetPointerObj(tcl_result,(void *) _result,\"" << d->print_mangle() << "\");\n";
|
|
|
|
d->is_pointer--;
|
|
break;
|
|
|
|
// Unknown type
|
|
default :
|
|
fprintf(stderr,"%s : Line %d: Unable to use return type %s in function %s.\n",
|
|
input_file, line_number, d->print_type(), name);
|
|
break;
|
|
}
|
|
} else {
|
|
|
|
// Is a pointer return type
|
|
|
|
if ((d->type == T_CHAR) && (d->is_pointer == 1)) {
|
|
// Return a character string
|
|
f.code << tab4 << "Tcl_SetStringObj(tcl_result,_result,-1);\n";
|
|
} else {
|
|
#ifdef OLD
|
|
f.add_local("char","resultchar[256]");
|
|
f.code << tab4 << "SWIG_MakePtr(resultchar, (void *) _result,\"" << d->print_mangle() << "\");\n"
|
|
<< tab4 << "Tcl_SetStringObj(tcl_result,resultchar,-1);\n";
|
|
#endif
|
|
|
|
f.code << tab4 << "SWIG_SetPointerObj(tcl_result,(void *) _result,\"" << d->print_mangle() << "\");\n";
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
// Dump output argument code
|
|
f.code << outarg;
|
|
|
|
// Dump the argument cleanup code
|
|
f.code << cleanup;
|
|
|
|
// Look for any remaining cleanup
|
|
|
|
if (NewObject) {
|
|
if ((tm = typemap_lookup("newfree","tcl8",d,iname,"_result",""))) {
|
|
f.code << tm << "\n";
|
|
}
|
|
}
|
|
|
|
if ((tm = typemap_lookup("ret","tcl8",d,name,"_result",""))) {
|
|
// Yep. Use it instead of the default
|
|
f.code << tm << "\n";
|
|
}
|
|
|
|
// Wrap things up (in a manner of speaking)
|
|
|
|
f.code << tab4 << "return TCL_OK;\n}";
|
|
|
|
// Substitute the cleanup code
|
|
f.code.replace("$cleanup",cleanup);
|
|
f.code.replace("$name",iname);
|
|
|
|
// Dump out the function
|
|
|
|
f.print(f_wrappers);
|
|
|
|
// Now register the function with Tcl
|
|
|
|
fprintf(f_init,"\t Tcl_CreateObjCommand(%s, SWIG_prefix \"%s\", %s, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);\n",interp_name, iname, wname);
|
|
|
|
// If there's a documentation entry, produce a usage string
|
|
|
|
if (doc_entry) {
|
|
|
|
static DocEntry *last_doc_entry = 0;
|
|
|
|
// Use usage as description
|
|
doc_entry->usage << usage;
|
|
|
|
// Set the cinfo field to specific a return type
|
|
|
|
if (last_doc_entry != doc_entry) {
|
|
doc_entry->cinfo << "returns " << d->print_type();
|
|
last_doc_entry = doc_entry;
|
|
}
|
|
}
|
|
}
|
|
|
|
// -----------------------------------------------------------------------
|
|
// TCL8::link_variable(char *name, char *iname, DataType *t,
|
|
// int ex)
|
|
//
|
|
// Create a TCL link to a variable.
|
|
// -----------------------------------------------------------------------
|
|
|
|
void TCL8::link_variable(char *name, char *iname, DataType *t)
|
|
{
|
|
|
|
String s;
|
|
char *tm, *tm1;
|
|
|
|
// See if there were any typemaps
|
|
|
|
tm = typemap_lookup("varin","tcl8",t,name,"","");
|
|
tm1 = typemap_lookup("varout","tcl8",t,name,"","");
|
|
if (tm || tm1) {
|
|
fprintf(stderr,"%s : Line %d. Warning. varin/varout typemap methods not supported.",
|
|
input_file, line_number);
|
|
}
|
|
|
|
// Check the datatype. Must be a valid Tcl type (there aren't many)
|
|
|
|
if (((t->type == T_INT) && (!t->is_pointer)) ||
|
|
((t->type == T_UINT) && (!t->is_pointer)) ||
|
|
((t->type == T_SINT) && (!t->is_pointer)) ||
|
|
((t->type == T_DOUBLE) && (!t->is_pointer)) ||
|
|
((t->type == T_BOOL) && (!t->is_pointer)) ||
|
|
((t->type == T_CHAR) && (t->is_pointer == 1))) {
|
|
|
|
// This is a valid TCL type.
|
|
|
|
if (t->type == T_UINT)
|
|
fprintf(stderr,"%s : Line %d : ** Warning. Linkage of unsigned type may be unsafe.\n",
|
|
input_file, line_number);
|
|
|
|
// Now add symbol to the TCL interpreter
|
|
|
|
switch(t->type) {
|
|
case T_CHAR :
|
|
if (t->arraystr) {
|
|
// Is an array. We have to do something different
|
|
fprintf(f_wrappers,"static char *tclvar%s = %s;\n",name,name);
|
|
s << "(char *) &tclvar" << name << ", TCL_LINK_STRING";
|
|
} else {
|
|
s << "(char *) &" << name << ", TCL_LINK_STRING";
|
|
}
|
|
break;
|
|
case T_BOOL:
|
|
case T_INT :
|
|
case T_UINT:
|
|
case T_SINT:
|
|
s << "(char *) &" << name << ", TCL_LINK_INT";
|
|
break;
|
|
case T_DOUBLE :
|
|
s << "(char *) &" << name << ", TCL_LINK_DOUBLE";
|
|
break;
|
|
default :
|
|
fprintf(f_init,"Fatal error. Internal error (Tcl:link_variable)\n");
|
|
break;
|
|
}
|
|
|
|
if (Status & STAT_READONLY)
|
|
s << " | TCL_LINK_READ_ONLY);\n";
|
|
else
|
|
s << ");\n";
|
|
|
|
fprintf(f_init,"\t Tcl_LinkVar(%s, SWIG_prefix \"%s\", %s",interp_name, iname, s.get());
|
|
|
|
// Make a usage string for it
|
|
|
|
if (doc_entry) {
|
|
doc_entry->usage << usage_var(iname,t);
|
|
doc_entry->cinfo = "";
|
|
doc_entry->cinfo << "Global : " << t->print_type() << " " << name;
|
|
}
|
|
} else {
|
|
|
|
// Have some sort of "other" type.
|
|
// We're going to emit some functions to set/get it's value instead
|
|
|
|
emit_set_get(name,iname, t);
|
|
if (doc_entry) {
|
|
doc_entry->cinfo = "";
|
|
doc_entry->cinfo << "Global : " << t->print_type() << " " << iname;
|
|
}
|
|
|
|
// If shadow classes are enabled and we have a user-defined type
|
|
// that we know about, create a command for it.
|
|
|
|
if (shadow) {
|
|
if ((t->type == T_USER) && (t->is_pointer < 1)) {
|
|
// See if the datatype is in our hash table
|
|
if (hash.lookup(t->name)) {
|
|
// Yep. Try to create a command for it
|
|
|
|
postinit << tab4 << "{\n"
|
|
<< tab8 << "char cmd[] = \""
|
|
<< (char *) hash.lookup(t->name) << " " << iname << " -this ["
|
|
<< iname << "_get ]\";\n"
|
|
<< tab8 << "Tcl_GlobalEval(interp,cmd);\n"
|
|
<< tab4 << "}\n";
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
// -----------------------------------------------------------------------
|
|
// TCL8::declare_const(char *name, char *iname, DataType *type, char *value)
|
|
//
|
|
// Makes a constant. Really just creates a variable and links to it.
|
|
// Tcl variable linkage allows read-only variables so we'll use that
|
|
// instead of just creating a Tcl variable.
|
|
// ------------------------------------------------------------------------
|
|
|
|
void TCL8::declare_const(char *name, char *, DataType *type, char *value) {
|
|
|
|
int OldStatus = Status; // Save old status flags
|
|
DataType *t;
|
|
char var_name[256];
|
|
char *tm;
|
|
String rvalue;
|
|
Status = STAT_READONLY; // Enable readonly mode.
|
|
|
|
// Make a static variable;
|
|
|
|
sprintf(var_name,"_wrap_const_%s",name);
|
|
|
|
// See if there's a typemap
|
|
rvalue = value;
|
|
if ((type->type == T_CHAR) && (type->is_pointer == 1)) {
|
|
rvalue << "\"";
|
|
"\"" >> rvalue;
|
|
}
|
|
if ((type->type == T_CHAR) && (type->is_pointer == 0)) {
|
|
rvalue << "'";
|
|
"'" >> rvalue;
|
|
}
|
|
if ((tm = typemap_lookup("const","tcl8",type,name,rvalue.get(),name))) {
|
|
// Yep. Use it instead of the default
|
|
fprintf(f_init,"%s\n",tm);
|
|
} else {
|
|
|
|
// Create variable and assign it a value
|
|
|
|
if (type->is_pointer == 0) {
|
|
switch(type->type) {
|
|
case T_BOOL: case T_INT: case T_SINT: case T_DOUBLE:
|
|
fprintf(f_header,"static %s %s = %s;\n", type->print_type(), var_name, value);
|
|
link_variable(var_name,name,type);
|
|
break;
|
|
case T_SHORT:
|
|
case T_LONG:
|
|
case T_SSHORT:
|
|
case T_SCHAR:
|
|
case T_SLONG:
|
|
fprintf(f_header,"static %s %s = %s;\n", type->print_type(), var_name, value);
|
|
fprintf(f_header,"static char *%s_char;\n", var_name);
|
|
if (CPlusPlus)
|
|
fprintf(f_init,"\t %s_char = new char[32];\n",var_name);
|
|
else
|
|
fprintf(f_init,"\t %s_char = (char *) malloc(32);\n",var_name);
|
|
|
|
fprintf(f_init,"\t sprintf(%s_char,\"%%ld\", (long) %s);\n", var_name, var_name);
|
|
sprintf(var_name,"%s_char",var_name);
|
|
t = new DataType(T_CHAR);
|
|
t->is_pointer = 1;
|
|
link_variable(var_name,name,t);
|
|
delete t;
|
|
break;
|
|
case T_UINT:
|
|
case T_USHORT:
|
|
case T_ULONG:
|
|
case T_UCHAR:
|
|
fprintf(f_header,"static %s %s = %s;\n", type->print_type(), var_name, value);
|
|
fprintf(f_header,"static char *%s_char;\n", var_name);
|
|
if (CPlusPlus)
|
|
fprintf(f_init,"\t %s_char = new char[32];\n",var_name);
|
|
else
|
|
fprintf(f_init,"\t %s_char = (char *) malloc(32);\n",var_name);
|
|
|
|
fprintf(f_init,"\t sprintf(%s_char,\"%%lu\", (unsigned long) %s);\n", var_name, var_name);
|
|
sprintf(var_name,"%s_char",var_name);
|
|
t = new DataType(T_CHAR);
|
|
t->is_pointer = 1;
|
|
link_variable(var_name,name,t);
|
|
delete t;
|
|
break;
|
|
case T_FLOAT:
|
|
type->type = T_DOUBLE;
|
|
strcpy(type->name,"double");
|
|
fprintf(f_header,"static %s %s = %s (%s);\n", type->print_type(), var_name, type->print_cast(), value);
|
|
link_variable(var_name,name,type);
|
|
break;
|
|
|
|
case T_CHAR:
|
|
type->is_pointer++;
|
|
fprintf(f_header,"static %s %s = \"%s\";\n", type->print_type(), var_name, value);
|
|
link_variable(var_name,name,type);
|
|
type->is_pointer--;
|
|
break;
|
|
default:
|
|
fprintf(stderr,"%s : Line %d. Unsupported constant value.\n", input_file, line_number);
|
|
break;
|
|
}
|
|
} else {
|
|
// Have some sort of pointer value here
|
|
if ((type->type == T_CHAR) && (type->is_pointer == 1)) {
|
|
// Character string
|
|
fprintf(f_header,"static %s %s = \"%s\";\n", type->print_type(), var_name, value);
|
|
link_variable(var_name,name,type);
|
|
} else {
|
|
// Something else. Some sort of pointer value
|
|
fprintf(f_header,"static %s %s = %s;\n", type->print_type(), var_name, value);
|
|
fprintf(f_header,"static char *%s_char;\n", var_name);
|
|
if (CPlusPlus)
|
|
fprintf(f_init,"\t %s_char = new char[%d];\n",var_name,(int) strlen(type->print_mangle())+ 20);
|
|
else
|
|
fprintf(f_init,"\t %s_char = (char *) malloc(%d);\n",var_name, (int) strlen(type->print_mangle())+ 20);
|
|
|
|
t = new DataType(T_CHAR);
|
|
t->is_pointer = 1;
|
|
fprintf(f_init,"\t SWIG_MakePtr(%s_char, (void *) %s,\"%s\");\n",
|
|
var_name, var_name, type->print_mangle());
|
|
sprintf(var_name,"%s_char",var_name);
|
|
link_variable(var_name,name,t);
|
|
delete t;
|
|
}
|
|
}
|
|
}
|
|
|
|
// Create a documentation entry for this
|
|
|
|
if (doc_entry) {
|
|
doc_entry->usage = ""; // Destroy any previous information from linking
|
|
doc_entry->usage << usage_const(name, type, value);
|
|
doc_entry->cinfo = "";
|
|
doc_entry->cinfo << "Constant : " << type->print_type();
|
|
}
|
|
|
|
Status = OldStatus;
|
|
}
|
|
|
|
// ----------------------------------------------------------------------
|
|
// TCL8::usage_var(char *iname, DataType *t, char **s)
|
|
//
|
|
// Produces a usage string for a tcl variable. Stores it in s
|
|
// ----------------------------------------------------------------------
|
|
|
|
char *TCL8::usage_var(char *iname, DataType *t) {
|
|
|
|
static char temp[1024];
|
|
|
|
if (!nspace) {
|
|
sprintf(temp,"$%s%s", prefix, iname);
|
|
} else {
|
|
sprintf(temp,"%s::%s", ns_name, iname);
|
|
}
|
|
if (!(((t->type == T_INT) && (!t->is_pointer)) ||
|
|
((t->type == T_UINT) && (!t->is_pointer)) ||
|
|
((t->type == T_DOUBLE) && (!t->is_pointer)) ||
|
|
((t->type == T_BOOL) && (!t->is_pointer)) ||
|
|
((t->type == T_CHAR) && (t->is_pointer)))) {
|
|
/* We emitted a pair of set/get functions instead. Doc will be generated for that */
|
|
return temp;
|
|
}
|
|
return temp;
|
|
}
|
|
|
|
|
|
|
|
// ---------------------------------------------------------------------------
|
|
// char *TCL8::usage_string(char *iname, DataType *t, ParmList *l),
|
|
//
|
|
// Generates a generic usage string for a Tcl function.
|
|
// ---------------------------------------------------------------------------
|
|
|
|
char * TCL8::usage_string(char *iname, DataType *, ParmList *l) {
|
|
|
|
static String temp;
|
|
Parm *p;
|
|
int i, numopt,pcount;
|
|
|
|
temp = "";
|
|
temp << iname << " ";
|
|
|
|
/* Now go through and print parameters */
|
|
i = 0;
|
|
pcount = l->nparms;
|
|
numopt = l->numopt();
|
|
p = l->get_first();
|
|
while (p != 0) {
|
|
|
|
// Only print an argument if not ignored
|
|
|
|
if (!typemap_check("ignore","tcl8",p->t,p->name)) {
|
|
if (i >= (pcount-numopt))
|
|
temp << "?";
|
|
|
|
/* If parameter has been named, use that. Otherwise, just print a type */
|
|
|
|
if ((p->t->type != T_VOID) || (p->t->is_pointer)) {
|
|
if (strlen(p->name) > 0) {
|
|
temp << p->name;
|
|
}
|
|
else {
|
|
temp << "{ " << p->t->print_type() << " }";
|
|
}
|
|
}
|
|
if (i >= (pcount-numopt))
|
|
temp << "?";
|
|
temp << " ";
|
|
i++;
|
|
}
|
|
p = l->get_next();
|
|
}
|
|
return temp;
|
|
}
|
|
|
|
// ---------------------------------------------------------------------------
|
|
// char *TCL8::usage_func(char *iname, DataType *t, ParmList *l),
|
|
//
|
|
// Produces a usage string for a function in Tcl
|
|
// ---------------------------------------------------------------------------
|
|
|
|
char * TCL8::usage_func(char *iname, DataType *t, ParmList *l) {
|
|
|
|
String temp;
|
|
|
|
if (nspace) {
|
|
temp << ns_name << "::" << iname;
|
|
} else {
|
|
temp << prefix << iname;
|
|
}
|
|
return usage_string(temp,t,l);
|
|
}
|
|
|
|
// -----------------------------------------------------------------
|
|
// TCL8::usage_const(char *name, DataType *type, char *value)
|
|
// char **s)
|
|
//
|
|
// Makes a usage string and returns it
|
|
// -----------------------------------------------------------------
|
|
|
|
char *TCL8::usage_const(char *name, DataType *, char *value) {
|
|
static String temp;
|
|
temp = "";
|
|
if (nspace) {
|
|
temp << ns_name << "::" << name << " = " << value;
|
|
} else {
|
|
temp << "$" << prefix << name << " = " << value;
|
|
}
|
|
return temp.get();
|
|
}
|
|
|
|
// -------------------------------------------------------------------
|
|
// TCL8::add_native(char *name, char *funcname)
|
|
//
|
|
// This adds an already written Tcl wrapper function to our
|
|
// initialization function.
|
|
// -------------------------------------------------------------------
|
|
|
|
|
|
void TCL8::add_native(char *name, char *funcname) {
|
|
|
|
fprintf(f_init,"\t Tcl_CreateCommand(%s, SWIG_prefix \"%s\", %s, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);\n",interp_name, name, funcname);
|
|
|
|
if (doc_entry) {
|
|
if (nspace)
|
|
doc_entry->usage << ns_name << "::" << name << " args";
|
|
else
|
|
doc_entry->usage << prefix << name << " args";
|
|
|
|
doc_entry->cinfo << "Native method : " << funcname;
|
|
}
|
|
|
|
}
|
|
|
|
// -------------------------------------------------------------------
|
|
// TCL8::pragma(char *lname, char *name, char *value)
|
|
//
|
|
// Handle pragmas.
|
|
// --------------------------------------------------------------------
|
|
|
|
void TCL8::pragma(char *, char *, char *) {
|
|
|
|
}
|
|
|
|
// ---------------------------------------------------------------------
|
|
// C++ Handling
|
|
//
|
|
// The following functions provide some support for C++ classes and
|
|
// C structs.
|
|
// ---------------------------------------------------------------------
|
|
|
|
void TCL8::cpp_open_class(char *classname, char *rename, char *ctype, int strip) {
|
|
|
|
this->Language::cpp_open_class(classname,rename,ctype,strip);
|
|
|
|
if (shadow) {
|
|
|
|
config = "";
|
|
cget = "";
|
|
methods = "";
|
|
options = "";
|
|
config_options = "";
|
|
methodnames = "";
|
|
|
|
have_constructor = 0;
|
|
have_destructor = 0;
|
|
have_methods = 0;
|
|
have_config = 0;
|
|
have_cget = 0;
|
|
|
|
if (rename)
|
|
class_name = copy_string(rename);
|
|
else
|
|
class_name = copy_string(classname);
|
|
|
|
base_class = (char *) 0;
|
|
if (!strip) {
|
|
class_type = new char[strlen(ctype)+2];
|
|
sprintf(class_type,"%s ", ctype);
|
|
} else
|
|
class_type = "";
|
|
|
|
real_classname = copy_string(classname);
|
|
}
|
|
}
|
|
|
|
void TCL8::cpp_close_class() {
|
|
String code,temp;
|
|
DataType *t;
|
|
|
|
this->Language::cpp_close_class();
|
|
if (shadow) {
|
|
|
|
t = new DataType;
|
|
sprintf(t->name,"%s%s", class_type, real_classname);
|
|
t->type = T_USER;
|
|
t->is_pointer = 1;
|
|
|
|
// Note : The object oriented interface is defined by three files
|
|
// delcmd8.swg - Object deletion wrapper
|
|
// methodcmd8.swg - Method invocation command
|
|
// objcmd8.swg - Command to create a new object
|
|
//
|
|
// These files are located in the SWIG library. This module
|
|
// grabs the files and performs marker replacements to
|
|
// build the wrapper function.
|
|
|
|
// Generate a Tcl function for object destruction
|
|
|
|
if (have_destructor) {
|
|
code << delcmd;
|
|
}
|
|
|
|
// Dump out method code
|
|
code << methodcmd;
|
|
|
|
// Dump out object creation command
|
|
code << objcmd;
|
|
|
|
// Now perform marker replacements
|
|
code.replace("@CLASS@",class_name);
|
|
temp = "";
|
|
temp << name_destroy(class_name);
|
|
code.replace("@DESTRUCTOR@",temp);
|
|
code.replace("@CLASSTYPE@",t->print_type());
|
|
"configure " >> methodnames;
|
|
"cget " >> methodnames;
|
|
code.replace("@METHODLIST@", methodnames);
|
|
code.replace("@CLASSMANGLE@",t->print_mangle());
|
|
code.replace("@METHODS@",methods);
|
|
code.replace("@CONFIGMETHODS@",config);
|
|
code.replace("@CGETMETHODS@",cget);
|
|
if (have_constructor) {
|
|
temp = "";
|
|
temp << name_wrapper(name_construct(class_name),prefix);
|
|
} else {
|
|
temp = "0";
|
|
}
|
|
code.replace("@TCLCONSTRUCTOR@",temp);
|
|
code.replace("@CONFIGLIST@",config_options);
|
|
code.replace("@CGETLIST@",options);
|
|
if (have_destructor) {
|
|
temp = "TclDelete";
|
|
temp << class_name;
|
|
} else {
|
|
temp = "0";
|
|
}
|
|
code.replace("@TCLDESTRUCTOR@",temp);
|
|
fprintf(f_wrappers,"%s\n", code.get());
|
|
|
|
fprintf(f_init,"\t Tcl_CreateObjCommand(interp,SWIG_prefix \"%s\",Tcl%sCmd, (ClientData) NULL, NULL);\n", class_name, class_name);
|
|
}
|
|
}
|
|
|
|
void TCL8::cpp_member_func(char *name, char *iname, DataType *t, ParmList *l) {
|
|
|
|
char *realname;
|
|
String temp;
|
|
char *rname;
|
|
|
|
this->Language::cpp_member_func(name,iname,t,l);
|
|
|
|
if (shadow) {
|
|
if (iname)
|
|
realname = iname;
|
|
else
|
|
realname = name;
|
|
|
|
// Add stubs for this member to our class handler function
|
|
|
|
if (have_methods)
|
|
methods << tab4 << "else ";
|
|
else
|
|
methods << tab4;
|
|
|
|
temp = "";
|
|
temp << name_member(realname,class_name);
|
|
rname = (char *) repeatcmd.lookup(temp);
|
|
if (!rname)
|
|
rname = name_wrapper(temp.get(),prefix);
|
|
|
|
methods << "if (strcmp(_str,\"" << realname << "\") == 0) {\n"
|
|
<< tab4 << tab4 << "cmd = " << rname << ";\n"
|
|
<< tab4 << "}";
|
|
|
|
have_methods = 1;
|
|
methodnames << realname << " ";
|
|
|
|
if (doc_entry) {
|
|
doc_entry->usage = "";
|
|
doc_entry->usage << usage_string(realname,t,l);
|
|
}
|
|
}
|
|
}
|
|
|
|
void TCL8::cpp_variable(char *name, char *iname, DataType *t) {
|
|
char *realname;
|
|
String temp;
|
|
char *rname;
|
|
|
|
this->Language::cpp_variable(name, iname, t);
|
|
|
|
if (shadow) {
|
|
if (iname)
|
|
realname = iname;
|
|
else
|
|
realname = name;
|
|
|
|
char *bc = class_name;
|
|
|
|
// Write config code
|
|
|
|
if (!(Status & STAT_READONLY)) {
|
|
if (!have_config) {
|
|
config << tab8 << tab8;
|
|
} else {
|
|
config << " else ";
|
|
}
|
|
|
|
// Try to figure out if there is already a wrapper for this
|
|
|
|
temp = "";
|
|
temp << name_set(name_member(realname,bc));
|
|
rname = (char *) repeatcmd.lookup(temp);
|
|
if (!rname)
|
|
rname = name_wrapper(temp.get(),prefix);
|
|
|
|
config << "if (strcmp(_str,\"-" << realname << "\") == 0) {\n"
|
|
<< tab8 << tab8 << tab4 << "cmd = " << rname << ";\n"
|
|
<< tab8 << tab8 << "} ";
|
|
|
|
have_config = 1;
|
|
}
|
|
|
|
// Write cget code
|
|
|
|
if (!have_cget) {
|
|
cget << tab8 << tab8;
|
|
} else {
|
|
cget << " else ";
|
|
}
|
|
|
|
|
|
// Try to figure out if there is a wrapper for this function
|
|
temp = "";
|
|
temp << name_get(name_member(realname,bc));
|
|
rname = (char *) repeatcmd.lookup(temp);
|
|
if (!rname)
|
|
rname = name_wrapper(temp.get(),prefix);
|
|
|
|
cget << "if (strcmp(_str,\"-" << realname << "\") == 0) {\n"
|
|
<< tab8 << tab8 << tab4 << "cmd = " << rname << ";\n"
|
|
<< tab8 << tab8 << "} ";
|
|
have_cget = 1;
|
|
|
|
options << "-" << realname << " ";
|
|
if (!(Status & STAT_READONLY)) {
|
|
config_options << "-" << realname << " ";
|
|
}
|
|
if (doc_entry){
|
|
doc_entry->usage = "";
|
|
doc_entry->usage << "-" << realname << "\n";
|
|
}
|
|
}
|
|
}
|
|
|
|
void TCL8::cpp_constructor(char *name, char *iname, ParmList *l) {
|
|
this->Language::cpp_constructor(name,iname,l);
|
|
|
|
if (shadow) {
|
|
if ((!have_constructor) && (doc_entry)) {
|
|
doc_entry->usage = "";
|
|
doc_entry->usage << class_name << usage_string(" name",0,l);
|
|
}
|
|
have_constructor = 1;
|
|
}
|
|
}
|
|
void TCL8::cpp_destructor(char *name, char *newname) {
|
|
this->Language::cpp_destructor(name,newname);
|
|
if (shadow) {
|
|
if (!have_destructor) {
|
|
if (doc_entry) {
|
|
doc_entry->usage = "rename obj {}";
|
|
}
|
|
}
|
|
have_destructor = 1;
|
|
}
|
|
}
|
|
|
|
void TCL8::cpp_inherit(char **baseclass, int) {
|
|
this->Language::cpp_inherit(baseclass);
|
|
}
|
|
|
|
void TCL8::cpp_declare_const(char *name, char *iname, DataType *type, char *value) {
|
|
this->Language::cpp_declare_const(name,iname,type,value);
|
|
}
|
|
|
|
// --------------------------------------------------------------------------------
|
|
// TCL8::add_typedef(DataType *t, char *name)
|
|
//
|
|
// This is called whenever a typedef is encountered. When shadow classes are
|
|
// used, this function lets us discovered hidden uses of a class. For example :
|
|
//
|
|
// struct FooBar {
|
|
// ...
|
|
// }
|
|
//
|
|
// typedef FooBar *FooBarPtr;
|
|
//
|
|
// --------------------------------------------------------------------------------
|
|
|
|
void TCL8::add_typedef(DataType *t, char *name) {
|
|
|
|
if (!shadow) return;
|
|
|
|
// First check to see if there aren't too many pointers
|
|
|
|
if (t->is_pointer > 1) return;
|
|
if (hash.lookup(name)) return; // Already added
|
|
|
|
// Now look up the datatype in our shadow class hash table
|
|
|
|
if (hash.lookup(t->name)) {
|
|
|
|
// Yep. This datatype is in the hash
|
|
// Put this types 'new' name into the hash
|
|
hash.add(name,copy_string((char *) hash.lookup(t->name)));
|
|
}
|
|
}
|
|
|
|
// -----------------------------------------------------------------------
|
|
// TCL8::cpp_class_decl(char *name, char *rename, char *type)
|
|
//
|
|
// Treatment of an empty class definition. Used to handle
|
|
// shadow classes across modules.
|
|
// -----------------------------------------------------------------------
|
|
|
|
void TCL8::cpp_class_decl(char *name, char *rename, char *type) {
|
|
char temp[256];
|
|
this->Language::cpp_class_decl(name,rename, type);
|
|
|
|
if (shadow) {
|
|
hash.add(name,copy_string(rename));
|
|
// Add full name of datatype to the hash table
|
|
if (strlen(type) > 0) {
|
|
sprintf(temp,"%s %s", type, name);
|
|
hash.add(temp,copy_string(rename));
|
|
}
|
|
}
|
|
}
|