wxPython/wxSWIG/Modules/tcl8.cxx

   1 /*******************************************************************************
   2  * Simplified Wrapper and Interface Generator  (SWIG)
   3  *
   4  * Author : David Beazley
   5  *
   6  * Department of Computer Science
   7  * University of Chicago
   8  * 1100 E 58th Street
   9  * Chicago, IL  60637
  10  * beazley@cs.uchicago.edu
  11  *
  12  * Please read the file LICENSE for the copyright and terms by which SWIG
  13  * can be used and distributed.
  14  *******************************************************************************/
  15
  16 /***********************************************************************
  17  * $Header$
  18  *
  19  * tcl8.cxx
  20  *
  21  * Module for creating Tcl 8.0 native wrapper functions.  Older SWIG
  22  * modules will work with Tcl 8.0, but this one provides a significant
  23  * boost in performance.
  24  ***********************************************************************/
  25
  26 #include "swig.h"
  27 #include "tcl8.h"
  28 #include <ctype.h>
  29
  30 static char *Tcl_config="swigtcl.swg";
  31 static char *usage = "\
  32 Tcl 8.0 Options (available with -tcl)\n\
  33      -module name    - Set name of module\n\
  34      -prefix name    - Set a prefix to be appended to all names\n\
  35      -namespace      - Build module into a Tcl 8 namespace. \n\
  36      -noobject       - Omit code for object oriented interface.\n\
  37      -old            - Use old SWIG interface (same as -noobject).\n\n";
  38
  39 static char *ns_name = 0;
  40
  41 static String mod_init;
  42 static String mod_extern;
  43
  44 // ---------------------------------------------------------------------
  45 // TCL8::parse_args(int argc, char *argv[])
  46 //
  47 // Parse tcl specific command line options
  48 // ---------------------------------------------------------------------
  49
  50 void TCL8::parse_args(int argc, char *argv[]) {
  51
  52   int i = 1;
  53   sprintf(LibDir,"%s",tcl_path);
  54
  55   // Look for certain command line options
  56
  57   for (i = 1; i < argc; i++) {
  58       if (argv[i]) {
  59           if (strcmp(argv[i],"-prefix") == 0) {
  60             if (argv[i+1]) {
  61               prefix = new char[strlen(argv[i+1])+2];
  62               strcpy(prefix, argv[i+1]);
  63               mark_arg(i);
  64               mark_arg(i+1);
  65               i++;
  66             } else {
  67               arg_error();
  68             }
  69           } else if (strcmp(argv[i],"-module") == 0) {
  70             if (argv[i+1]) {
  71               set_module(argv[i+1],0);
  72               mark_arg(i);
  73               mark_arg(i+1);
  74               i++;
  75             } else {
  76               arg_error();
  77             }
  78           } else if (strcmp(argv[i],"-namespace") == 0) {
  79             nspace = 1;
  80             mark_arg(i);
  81           } else if (strcmp(argv[i],"-old") == 0) {
  82             shadow = 0;
  83             mark_arg(i);
  84           } else if (strcmp(argv[i],"-noobject") == 0) {
  85             shadow = 0;
  86             mark_arg(i);
  87           } else if (strcmp(argv[i],"-help") == 0) {
  88             fputs(usage,stderr);
  89           }
  90       }
  91   }
  92
  93   // If a package has been specified, make sure it ends with a '_'
  94
  95   if (prefix) {
  96     ns_name = copy_string(prefix);
  97     if (prefix[strlen(prefix)] != '_') {
  98       prefix[strlen(prefix)+1] = 0;
  99       prefix[strlen(prefix)] = '_';
 100     }
 101   } else
 102     prefix = "";
 103
 104   // Create a symbol SWIGTCL
 105
 106   add_symbol("SWIGTCL",0,0);
 107   add_symbol("SWIGTCL8",0,0);
 108
 109   // Set name of typemaps
 110
 111   typemap_lang = "tcl8";
 112
 113   // Attempt to load up the C++ configuration files
 114
 115   get_file("delcmd8.swg",delcmd);
 116   get_file("methodcmd8.swg",methodcmd);
 117   get_file("objcmd8.swg",objcmd);
 118
 119 }
 120
 121 // ---------------------------------------------------------------------
 122 // void TCL8::parse()
 123 //
 124 // Start parsing an interface file for Tcl.
 125 // ---------------------------------------------------------------------
 126
 127 void TCL8::parse() {
 128
 129   fprintf(stderr,"Making wrappers for Tcl 8.x\n");
 130
 131   // Print out TCL specific headers
 132
 133   headers();
 134
 135   // Run the parser
 136
 137   yyparse();
 138
 139 }
 140
 141 // ---------------------------------------------------------------------
 142 // TCL8::set_module(char *mod_name,char **mod_list)
 143 //
 144 // Sets the module name.
 145 // Does nothing if it's already set (so it can be overridden as a command
 146 // line option).
 147 //
 148 // mod_list is a NULL-terminated list of additional modules.  This
 149 // is really only useful when building static executables and other
 150 // things.
 151 //----------------------------------------------------------------------
 152
 153 void TCL8::set_module(char *mod_name, char **mod_list) {
 154
 155   char temp[256], *c;
 156   int  i;
 157
 158   if (module) return;
 159
 160   module = new char[strlen(mod_name)+1];
 161   strcpy(module,mod_name);
 162
 163   // Fix capitalization for Tcl
 164
 165   c = module;
 166   while (*c) {
 167     *c = (char) tolower(*c);
 168     c++;
 169   }
 170
 171   // Now create an initialization function
 172
 173   sprintf(temp,"%s_Init", module);
 174   init_name = new char[strlen(temp) + 1];
 175   strcpy(init_name, temp);
 176   *init_name = toupper(*init_name);
 177
 178   if (!ns_name) ns_name = copy_string(module);
 179
 180   // If namespaces have been specified, set the prefix to the module name
 181
 182   if ((nspace) && (strlen(prefix) < 1)) {
 183     prefix = new char[strlen(module)+2];
 184     strcpy(prefix,module);
 185     prefix[strlen(module)] = '_';
 186     prefix[strlen(module)+1] = 0;
 187   }
 188
 189   // If additional modules have been specified, create some code for
 190   // initializing them.
 191
 192   if (mod_list) {
 193     i = 0;
 194     while (mod_list[i]) {
 195       c = mod_list[i];
 196       while (*c) {
 197         *c = (char) tolower(*c);
 198         c++;
 199       }
 200       sprintf(temp,"%s_Init",mod_list[i]);
 201       temp[0] = toupper(temp[0]);
 202
 203       // Dump out some initialization code
 204
 205       mod_init << tab4 << "if (" << temp << "(" << interp_name << ") == TCL_ERROR) {\n"
 206                << tab8 << "return TCL_ERROR;\n"
 207                << tab4 << "}\n\n";
 208       mod_extern << "extern int " << temp << "(Tcl_Interp *);\n";
 209       i++;
 210     }
 211   }
 212 }
 213
 214
 215 // ---------------------------------------------------------------------
 216 // TCL8::set_init(char *iname)
 217 //
 218 // Sets the initialization function name.
 219 // Does nothing if it's already set
 220 //
 221 //----------------------------------------------------------------------
 222
 223 void TCL8::set_init(char *iname) {
 224
 225   if (init_name) return;
 226   init_name = new char[strlen(iname)+1];
 227   strcpy(init_name, iname);
 228
 229 }
 230
 231 // ---------------------------------------------------------------------
 232 // TCL8::headers(void)
 233 //
 234 // Generate the appropriate header files for TCL interface.
 235 // ----------------------------------------------------------------------
 236
 237 void TCL8::headers(void)
 238 {
 239
 240   emit_banner(f_header);
 241   fprintf(f_header,"/* Implementation : TCL 8.0 */\n\n");
 242   fprintf(f_header,"#include <tcl.h>\n");
 243   fprintf(f_header,"#include <string.h>\n");
 244   fprintf(f_header,"#include <stdlib.h>\n");
 245   fprintf(f_header,"#define SWIGTCL\n");
 246   fprintf(f_header,"#define SWIGTCL8\n");
 247
 248   // Include a Tcl configuration file for Unix,Mac,Wintel.
 249
 250   if (NoInclude) {
 251     fprintf(f_header,"#define SWIG_NOINCLUDE\n");
 252   }
 253
 254   if (insert_file("swigtcl8.swg",f_header) == -1) {
 255     fprintf(stderr,"SWIG : Fatal error. Unable to locate 'swigtcl8.swg' in SWIG library.\n");
 256     SWIG_exit(1);
 257   }
 258 }
 259
 260 // --------------------------------------------------------------------
 261 // TCL8::initialize(void)
 262 //
 263 // Produces an initialization function.   Assumes that the init function
 264 // name has already been specified.
 265 // ---------------------------------------------------------------------
 266
 267 void TCL8::initialize()
 268 {
 269
 270   if ((!ns_name) && (nspace)) {
 271     fprintf(stderr,"Tcl error.   Must specify a namespace.\n");
 272     SWIG_exit(1);
 273   }
 274
 275   if (!init_name) {
 276     init_name = "Swig_Init";
 277     fprintf(stderr,"SWIG : *** Warning. No module name specified.\n");
 278   }
 279
 280   fprintf(f_header,"#define SWIG_init    %s\n", init_name);
 281   if (!module) module = "swig";
 282   fprintf(f_header,"#define SWIG_name    \"%s\"\n", module);
 283   if (nspace) {
 284     fprintf(f_header,"#define SWIG_prefix  \"%s::\"\n", ns_name);
 285     fprintf(f_header,"#define SWIG_namespace \"%s\"\n\n", ns_name);
 286   } else {
 287     fprintf(f_header,"#define SWIG_prefix  \"%s\"\n", prefix);
 288     fprintf(f_header,"#define SWIG_namespace \"\"\n\n");
 289   }
 290   fprintf(f_header,"#ifdef __cplusplus\n");
 291   fprintf(f_header,"extern \"C\" {\n");
 292   fprintf(f_header,"#endif\n");
 293   fprintf(f_header,"#ifdef MAC_TCL\n");
 294   fprintf(f_header,"#pragma export on\n");
 295   fprintf(f_header,"#endif\n");
 296   fprintf(f_header,"SWIGEXPORT(int) %s(Tcl_Interp *);\n", init_name);
 297   fprintf(f_header,"#ifdef MAC_TCL\n");
 298   fprintf(f_header,"#pragma export off\n");
 299   fprintf(f_header,"#endif\n");
 300   fprintf(f_header,"#ifdef __cplusplus\n");
 301   fprintf(f_header,"}\n");
 302   fprintf(f_header,"#endif\n");
 303
 304
 305   fprintf(f_init,"SWIGEXPORT(int) %s(Tcl_Interp *%s) {\n", init_name, interp_name);
 306   if (nspace) {
 307     fprintf(f_init,"#ifdef ITCL_NAMESPACES\n");
 308     fprintf(f_init,"\t Itcl_Namespace spaceId;\n");
 309     fprintf(f_init,"#endif\n");
 310   }
 311
 312   fprintf(f_init,"\t if (%s == 0) \n", interp_name);
 313   fprintf(f_init,"\t\t return TCL_ERROR;\n");
 314
 315   /* Set up SwigPtrType table */
 316
 317   fprintf(f_init,"\t SWIG_RegisterType();\n");
 318
 319   /* Check to see if other initializations need to be performed */
 320
 321   if (strlen(mod_extern.get())) {
 322     fprintf(f_init,"%s\n",mod_init.get());
 323     fprintf(f_header,"#ifdef __cplusplus\n");
 324     fprintf(f_header,"extern \"C\" {\n");
 325     fprintf(f_header,"#endif\n");
 326     fprintf(f_header,"%s\n",mod_extern.get());
 327     fprintf(f_header,"#ifdef __cplusplus\n");
 328     fprintf(f_header,"}\n");
 329     fprintf(f_header,"#endif\n");
 330   }
 331
 332
 333   /* Check to see if we're adding support for Tcl8 nspaces */
 334   if (nspace) {
 335     fprintf(f_init,"#if (TCL_MAJOR_VERSION >= 8)\n");
 336     fprintf(f_init,"\t Tcl_Eval(%s,\"namespace eval %s { }\");\n", interp_name, ns_name);
 337     fprintf(f_init,"#endif\n");
 338   }
 339 }
 340
 341 // ---------------------------------------------------------------------
 342 // TCL8::close(void)
 343 //
 344 // Wrap things up.  Close initialization function.
 345 // ---------------------------------------------------------------------
 346
 347 void TCL8::close(void)
 348 {
 349
 350   // Dump the pointer equivalency table
 351
 352   emit_ptr_equivalence(f_init);
 353
 354   // Close the init file and quit
 355
 356   fprintf(f_init,"%s",postinit.get());
 357   fprintf(f_init,"\t return TCL_OK;\n");
 358   fprintf(f_init,"}\n");
 359
 360 }
 361
 362 // ----------------------------------------------------------------------
 363 // TCL8::get_pointer(char *iname, char *srcname, char *src, char *dest,
 364 //                  DataType *t, String &f, char *ret)
 365 //
 366 // iname     = name of function or variable
 367 // srcname   = name of source
 368 // src       = source variable in wrapper code
 369 // dest      = destination variable in wrapper code
 370 // t         = Datatype
 371 // f         = String where output is going to go
 372 // ret       = Return action
 373 // ----------------------------------------------------------------------
 374
 375 void TCL8::get_pointer(char *iname, char *srcname, char *src, char *dest,
 376                       DataType *t, String &f, char *ret) {
 377
 378   // Pointers are read as hex-strings with encoded type information
 379
 380   f << tab4 << "if ((rettype = SWIG_GetPointerObj(interp," << src << ",(void **) &" << dest << ",";
 381
 382   if (t->type == T_VOID) f << "(char *) 0))) {\n";
 383   else
 384     f << "\"" << t->print_mangle() << "\"))) {\n";
 385
 386   // Now emit code according to the level of strictness desired
 387
 388   switch(TypeStrict) {
 389   case 0: // No type checking
 390     f << tab4 << "}\n";
 391     break;
 392   case 1: // Warning message only
 393     f << tab8 << "fprintf(stderr,\"Warning : type mismatch in " << srcname
 394       << " of " << iname << ". Expected " << t->print_mangle()
 395       << ", received %s\\n\", rettype);\n"
 396       << tab4 << "}\n";
 397   case 2: // Super strict mode.
 398     f << tab8 << "Tcl_SetStringObj(tcl_result, \"Type error in " << srcname << " of " << iname
 399       << ". Expected " << t->print_mangle() << ", received \", -1);\n"
 400       << tab8 << "Tcl_AppendToObj(tcl_result, rettype, -1);\n"
 401       << tab8 << ret << ";\n"
 402       << tab4 << "}\n";
 403     break;
 404   default :
 405     fprintf(stderr,"Unknown strictness level\n");
 406     break;
 407   }
 408 }
 409
 410
 411 // ----------------------------------------------------------------------
 412 // TCL8::create_command(char *cname, char *iname)
 413 //
 414 // Creates a Tcl command from a C function.
 415 // ----------------------------------------------------------------------
 416
 417 void TCL8::create_command(char *cname, char *iname) {
 418
 419   char *wname = name_wrapper(cname,prefix);
 420
 421   fprintf(f_init,"\t Tcl_CreateObjCommand(%s, SWIG_prefix \"%s\",%s, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);\n", interp_name, iname, wname);
 422
 423   // Add interpreter name to repeatcmd hash table.  This hash is used in C++ code
 424   // generation to try and find repeated wrapper functions.
 425
 426   repeatcmd.add(iname,copy_string(wname));
 427 }
 428
 429 // ----------------------------------------------------------------------
 430 // TCL8::create_function(char *name, char *iname, DataType *d, ParmList *l)
 431 //
 432 // Create a function declaration and register it with the interpreter.
 433 // ----------------------------------------------------------------------
 434
 435 void TCL8::create_function(char *name, char *iname, DataType *d, ParmList *l)
 436 {
 437   Parm            *p;
 438   int              pcount,i,j;
 439   char            *wname;
 440   char            *usage = 0, *tm;
 441   char             source[64];
 442   char             target[64];
 443   char             argnum[32];
 444   WrapperFunction  f;
 445   String           cleanup, outarg, build;
 446   int              numopt= 0;
 447   int              have_build = 0;
 448
 449   // Make a wrapper name for this function
 450
 451   wname = name_wrapper(iname,prefix);
 452
 453   // Now write the wrapper function itself....this is pretty ugly
 454
 455   f.def << "static int " << wname << "(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) {\n";
 456
 457   f.code << tab4 << "clientData = clientData; objv = objv;\n";
 458
 459   // Print out variables for storing arguments.
 460
 461   pcount = emit_args(d, l, f);
 462   numopt = l->numopt();
 463
 464   // Create a local variable for holding the interpreter result value
 465
 466   f.add_local("Tcl_Obj *", "tcl_result");
 467
 468   // Extract the tcl result object
 469
 470   f.code << tab4 << "tcl_result = Tcl_GetObjResult(interp);\n";
 471
 472   // Check the number of arguments
 473
 474   usage = usage_func(iname,d,l);       // Create a usage string
 475   f.code << tab4 << "if ((objc < " << (pcount-numopt) +1 << ") || (objc > " << l->numarg()+1 << ")) {\n"
 476          << tab8 << "Tcl_SetStringObj(tcl_result,\"Wrong # args. " << usage << "\",-1);\n"
 477          << tab8 << "return TCL_ERROR;\n"
 478          << tab4 << "}\n";
 479
 480   // Extract parameters.    This case statement should be used to extract
 481   // Function parameters.   Add more cases if you want to do more.
 482
 483   i = 0;
 484   j = 0;
 485   p = l->get_first();
 486   while (p != 0) {
 487     // Produce string representations of the source and target arguments
 488     sprintf(source,"objv[%d]",j+1);
 489     sprintf(target,"_arg%d",i);
 490     sprintf(argnum,"%d",j+1);
 491
 492     // See if this argument is being ignored
 493
 494     if (!p->ignore) {
 495       if (j >= (pcount-numopt))
 496         f.code << tab4 << "if (objc >" << j+1 << ") { \n";
 497
 498       if ((tm = typemap_lookup("in","tcl8",p->t,p->name,source,target,&f))) {
 499         // Yep.  Use it instead of the default
 500         f.code << tm << "\n";
 501         f.code.replace("$argnum",argnum);
 502         f.code.replace("$arg",source);
 503       } else {
 504         if (!p->t->is_pointer) {
 505
 506           // Extract a parameter by value.
 507
 508           switch(p->t->type) {
 509
 510             // Signed Integers
 511
 512           case T_BOOL:
 513           case T_INT:
 514           case T_SINT:
 515           case T_SHORT:
 516           case T_SSHORT:
 517           case T_LONG:
 518           case T_SLONG:
 519           case T_SCHAR:
 520
 521             // Unsigned integers
 522
 523           case T_UINT:
 524           case T_USHORT:
 525           case T_ULONG:
 526           case T_UCHAR:
 527             f.add_local("int","tempint");
 528             f.code << tab4 << "if (Tcl_GetIntFromObj(interp,objv[" << j+1 << "],&tempint) == TCL_ERROR) return TCL_ERROR;\n";
 529             f.code << tab4 << "_arg" << i << " = " << p->t->print_cast() << " tempint;\n";
 530           break;
 531
 532           // Floating point
 533
 534           case T_FLOAT:
 535           case T_DOUBLE:
 536             f.add_local("double","tempdouble");
 537             f.add_local("Tcl_Obj *", "dupobj");
 538             f.code << tab4 << "dupobj = Tcl_DuplicateObj(objv[" << j+1 << "]);\n"
 539                    << tab4 << "if (Tcl_GetDoubleFromObj(interp,dupobj,&tempdouble) == TCL_ERROR) {\n"
 540                    << tab8 << "Tcl_DecrRefCount(dupobj);\n"
 541                    << tab8 << "return TCL_ERROR;\n"
 542                    << tab4 << "}\n"
 543                    << tab4 << "Tcl_DecrRefCount(dupobj);\n"
 544                    << tab4 << "_arg" << i << " = " << p->t->print_cast() << " tempdouble;\n";
 545             break;
 546
 547             // A single character
 548
 549           case T_CHAR :
 550             f.add_local("char *","tempstr");
 551             f.add_local("int","templength");
 552             f.code << tab4 << "if ((tempstr = Tcl_GetStringFromObj(objv[" << j+1 << "],&templength)) == NULL) return TCL_ERROR;\n"
 553                    << tab4 << "_arg" << i << " = *tempstr;\n";
 554             break;
 555
 556             // Void.. Do nothing.
 557
 558           case T_VOID :
 559             break;
 560
 561             // User defined.   This is an error.
 562
 563           case T_USER:
 564
 565             // Unsupported data type
 566
 567           default :
 568             fprintf(stderr,"%s : Line %d: Unable to use type %s as a function argument.\n",
 569                     input_file, line_number, p->t->print_type());
 570             break;
 571           }
 572         } else {
 573
 574           // Function argument is some sort of pointer
 575           // Look for a string.   Otherwise, just pull off a pointer.
 576
 577           if ((p->t->type == T_CHAR) && (p->t->is_pointer == 1)) {
 578             f.add_local("int","templength");
 579             f.code << tab4 << "if ((_arg" << i << " = Tcl_GetStringFromObj(objv[" << j+1 << "], &templength)) == NULL) return TCL_ERROR;\n";
 580           } else {
 581
 582             // Have a generic pointer type here.    Read it in as
 583             // a hex-string
 584             char arg_temp[256];
 585
 586             // Try to parse pointer value directly
 587
 588 #ifdef OLD
 589             f.add_local("char *", "tempstr");
 590             f.add_local("int","templength");
 591             f.code << tab4 << "if ((tempstr = Tcl_GetStringFromObj(objv[" << j+1 << "],&templength)) == NULL) return TCL_ERROR;\n";
 592             get_pointer(iname,arg_temp,"tempstr",target,p->t,f.code,"return TCL_ERROR");
 593 #endif
 594             sprintf(arg_temp,"argument %d",j+1);
 595             f.add_local("char *", "rettype");
 596             get_pointer(iname,arg_temp,source,target,p->t,f.code,"return TCL_ERROR");
 597           }
 598         }
 599       }
 600       if (j >= (pcount-numopt))
 601         f.code << tab4 << "}\n";
 602       j++;
 603     }
 604
 605
 606     // Check to see if there is any sort of "build" typemap (highly complicated)
 607
 608     if ((tm = typemap_lookup("build","tcl8",p->t,p->name,source,target))) {
 609       build << tm << "\n";
 610       have_build = 1;
 611     }
 612
 613     // Check to see if there was any sort of a constaint typemap
 614     if ((tm = typemap_lookup("check","tcl8",p->t,p->name,source,target))) {
 615       // Yep.  Use it instead of the default
 616       f.code << tm << "\n";
 617       f.code.replace("$argnum",argnum);
 618       f.code.replace("$arg",source);
 619     }
 620
 621     // Check if there was any cleanup code (save it for later)
 622     if ((tm = typemap_lookup("freearg","tcl8",p->t,p->name,target,"tcl_result"))) {
 623       // Yep.  Use it instead of the default
 624       cleanup << tm << "\n";
 625       cleanup.replace("$argnum",argnum);
 626       cleanup.replace("$arg",source);
 627     }
 628     // Look for output arguments
 629     if ((tm = typemap_lookup("argout","tcl8",p->t,p->name,target,"tcl_result"))) {
 630       outarg << tm << "\n";
 631       outarg.replace("$argnum",argnum);
 632       outarg.replace("$arg",source);
 633     }
 634     i++;
 635     p = l->get_next();   // Get next parameter and continue
 636   }
 637
 638
 639   // If there was a "build" typemap, we need to go in and perform a serious hack
 640
 641   if (have_build) {
 642     char temp1[32];
 643     char temp2[256];
 644     l->sub_parmnames(build);            // Replace all parameter names
 645     j = 1;
 646     for (i = 0; i < l->nparms; i++) {
 647       p = l->get(i);
 648       if (strlen(p->name) > 0) {
 649         sprintf(temp1,"_in_%s", p->name);
 650       } else {
 651         sprintf(temp1,"_in_arg%d", i);
 652       }
 653       sprintf(temp2,"argv[%d]",j);
 654       build.replaceid(temp1,temp2);
 655       if (!p->ignore)
 656         j++;
 657     }
 658     f.code << build;
 659   }
 660
 661   // Now write code to make the function call
 662
 663   emit_func_call(name,d,l,f);
 664
 665   // Extract the tcl result object
 666
 667   f.code << tab4 << "tcl_result = Tcl_GetObjResult(interp);\n";
 668
 669
 670   // Return value if necessary
 671
 672   if ((tm = typemap_lookup("out","tcl8",d,name,"_result","tcl_result"))) {
 673     // Yep.  Use it instead of the default
 674     f.code << tm << "\n";
 675   } else if ((d->type != T_VOID) || (d->is_pointer)) {
 676     if (!d->is_pointer) {
 677
 678       // Function returns a "value"
 679
 680       switch(d->type) {
 681         // Is an integer
 682       case T_BOOL:
 683       case T_INT:
 684       case T_SINT:
 685       case T_SHORT:
 686       case T_SSHORT:
 687       case T_LONG :
 688       case T_SLONG:
 689       case T_SCHAR:
 690       case T_UINT:
 691       case T_USHORT:
 692       case T_ULONG:
 693       case T_UCHAR:
 694         f.code << tab4 << "Tcl_SetIntObj(tcl_result,(long) _result);\n";
 695         break;
 696
 697         // Is a single character.  Assume we return it as a string
 698       case T_CHAR :
 699         f.code << tab4 << "Tcl_SetStringObj(tcl_result,&_result,1);\n";
 700         break;
 701
 702         // Floating point number
 703       case T_DOUBLE :
 704       case T_FLOAT :
 705         f.code << tab4 << "Tcl_SetDoubleObj(tcl_result,(double) _result);\n";
 706         break;
 707
 708         // User defined type
 709       case T_USER :
 710
 711         // Okay. We're returning malloced memory at this point.
 712         // Probably dangerous, but who said safety was a good thing?
 713
 714         //      f.add_local("char","resultchar[256]");
 715         d->is_pointer++;
 716 #ifdef OLD
 717         f.code << tab4 << "SWIG_MakePtr(resultchar, (void *) _result,\"" << d->print_mangle() << "\");\n"
 718                << tab4 << "Tcl_SetStringObj(tcl_result,resultchar,-1);\n";
 719 #endif
 720         f.code << tab4 << "SWIG_SetPointerObj(tcl_result,(void *) _result,\"" << d->print_mangle() << "\");\n";
 721
 722         d->is_pointer--;
 723         break;
 724
 725         // Unknown type
 726       default :
 727         fprintf(stderr,"%s : Line %d: Unable to use return type %s in function %s.\n",
 728                 input_file, line_number, d->print_type(), name);
 729         break;
 730       }
 731     } else {
 732
 733       // Is a pointer return type
 734
 735       if ((d->type == T_CHAR) && (d->is_pointer == 1)) {
 736         // Return a character string
 737         f.code << tab4 << "Tcl_SetStringObj(tcl_result,_result,-1);\n";
 738       } else {
 739 #ifdef OLD
 740         f.add_local("char","resultchar[256]");
 741         f.code << tab4 << "SWIG_MakePtr(resultchar, (void *) _result,\"" << d->print_mangle() << "\");\n"
 742                << tab4 << "Tcl_SetStringObj(tcl_result,resultchar,-1);\n";
 743 #endif
 744
 745         f.code << tab4 << "SWIG_SetPointerObj(tcl_result,(void *) _result,\"" << d->print_mangle() << "\");\n";
 746       }
 747     }
 748   }
 749
 750
 751   // Dump output argument code
 752   f.code << outarg;
 753
 754   // Dump the argument cleanup code
 755   f.code << cleanup;
 756
 757   // Look for any remaining cleanup
 758
 759   if (NewObject) {
 760     if ((tm = typemap_lookup("newfree","tcl8",d,iname,"_result",""))) {
 761       f.code << tm << "\n";
 762     }
 763   }
 764
 765   if ((tm = typemap_lookup("ret","tcl8",d,name,"_result",""))) {
 766     // Yep.  Use it instead of the default
 767     f.code << tm << "\n";
 768   }
 769
 770   // Wrap things up (in a manner of speaking)
 771
 772   f.code << tab4 << "return TCL_OK;\n}";
 773
 774   // Substitute the cleanup code
 775   f.code.replace("$cleanup",cleanup);
 776   f.code.replace("$name",iname);
 777
 778   // Dump out the function
 779
 780   f.print(f_wrappers);
 781
 782   // Now register the function with Tcl
 783
 784   fprintf(f_init,"\t Tcl_CreateObjCommand(%s, SWIG_prefix \"%s\", %s, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);\n",interp_name, iname, wname);
 785
 786   // If there's a documentation entry, produce a usage string
 787
 788   if (doc_entry) {
 789
 790     static DocEntry *last_doc_entry = 0;
 791
 792     // Use usage as description
 793     doc_entry->usage << usage;
 794
 795     // Set the cinfo field to specific a return type
 796
 797     if (last_doc_entry != doc_entry) {
 798       doc_entry->cinfo << "returns " << d->print_type();
 799       last_doc_entry = doc_entry;
 800     }
 801   }
 802 }
 803
 804 // -----------------------------------------------------------------------
 805 // TCL8::link_variable(char *name, char *iname, DataType *t,
 806 //                           int ex)
 807 //
 808 // Create a TCL link to a variable.
 809 // -----------------------------------------------------------------------
 810
 811 void TCL8::link_variable(char *name, char *iname, DataType *t)
 812 {
 813
 814   String    s;
 815   char      *tm, *tm1;
 816
 817   // See if there were any typemaps
 818
 819   tm = typemap_lookup("varin","tcl8",t,name,"","");
 820   tm1 = typemap_lookup("varout","tcl8",t,name,"","");
 821   if (tm || tm1) {
 822     fprintf(stderr,"%s : Line %d. Warning. varin/varout typemap methods not supported.",
 823             input_file, line_number);
 824   }
 825
 826   // Check the datatype.  Must be a valid Tcl type (there aren't many)
 827
 828   if (((t->type == T_INT) && (!t->is_pointer)) ||
 829       ((t->type == T_UINT) && (!t->is_pointer)) ||
 830       ((t->type == T_SINT) && (!t->is_pointer)) ||
 831       ((t->type == T_DOUBLE) && (!t->is_pointer)) ||
 832       ((t->type == T_BOOL) && (!t->is_pointer)) ||
 833       ((t->type == T_CHAR) && (t->is_pointer == 1))) {
 834
 835     // This is a valid TCL type.
 836
 837     if (t->type == T_UINT)
 838       fprintf(stderr,"%s : Line %d : ** Warning. Linkage of unsigned type may be unsafe.\n",
 839               input_file,  line_number);
 840
 841     // Now add symbol to the TCL interpreter
 842
 843     switch(t->type) {
 844     case T_CHAR :
 845       if (t->arraystr) {
 846         // Is an array.  We have to do something different
 847         fprintf(f_wrappers,"static char *tclvar%s = %s;\n",name,name);
 848         s << "(char *) &tclvar" << name << ", TCL_LINK_STRING";
 849       } else {
 850         s << "(char *) &" << name << ", TCL_LINK_STRING";
 851       }
 852       break;
 853     case T_BOOL:
 854     case T_INT :
 855     case T_UINT:
 856     case T_SINT:
 857       s << "(char *) &" << name << ", TCL_LINK_INT";
 858       break;
 859     case T_DOUBLE :
 860       s << "(char *) &" << name << ", TCL_LINK_DOUBLE";
 861       break;
 862     default :
 863       fprintf(f_init,"Fatal error. Internal error (Tcl:link_variable)\n");
 864       break;
 865     }
 866
 867     if (Status & STAT_READONLY)
 868       s << " | TCL_LINK_READ_ONLY);\n";
 869     else
 870       s << ");\n";
 871
 872     fprintf(f_init,"\t Tcl_LinkVar(%s, SWIG_prefix \"%s\", %s",interp_name, iname, s.get());
 873
 874     // Make a usage string for it
 875
 876     if (doc_entry) {
 877       doc_entry->usage << usage_var(iname,t);
 878       doc_entry->cinfo = "";
 879       doc_entry->cinfo << "Global : " << t->print_type() << " " << name;
 880     }
 881   } else {
 882
 883     // Have some sort of "other" type.
 884     // We're going to emit some functions to set/get it's value instead
 885
 886     emit_set_get(name,iname, t);
 887     if (doc_entry) {
 888       doc_entry->cinfo = "";
 889       doc_entry->cinfo << "Global : " << t->print_type() << " " << iname;
 890     }
 891
 892     // If shadow classes are enabled and we have a user-defined type
 893     // that we know about, create a command for it.
 894
 895     if (shadow) {
 896       if ((t->type == T_USER) && (t->is_pointer < 1)) {
 897         // See if the datatype is in our hash table
 898         if (hash.lookup(t->name)) {
 899           // Yep.  Try to create a command for it
 900
 901           postinit << tab4 << "{\n"
 902                    << tab8 << "char cmd[] = \""
 903                    << (char *) hash.lookup(t->name) << " " << iname << " -this ["
 904                    << iname << "_get ]\";\n"
 905                    << tab8 << "Tcl_GlobalEval(interp,cmd);\n"
 906                    << tab4 << "}\n";
 907         }
 908       }
 909     }
 910   }
 911 }
 912
 913 // -----------------------------------------------------------------------
 914 // TCL8::declare_const(char *name, char *iname, DataType *type, char *value)
 915 //
 916 // Makes a constant.  Really just creates a variable and links to it.
 917 // Tcl variable linkage allows read-only variables so we'll use that
 918 // instead of just creating a Tcl variable.
 919 // ------------------------------------------------------------------------
 920
 921 void TCL8::declare_const(char *name, char *, DataType *type, char *value) {
 922
 923   int OldStatus = Status;      // Save old status flags
 924   DataType *t;
 925   char   var_name[256];
 926   char     *tm;
 927   String  rvalue;
 928   Status = STAT_READONLY;      // Enable readonly mode.
 929
 930   // Make a static variable;
 931
 932   sprintf(var_name,"_wrap_const_%s",name);
 933
 934   // See if there's a typemap
 935   rvalue = value;
 936   if ((type->type == T_CHAR) && (type->is_pointer == 1)) {
 937     rvalue << "\"";
 938     "\"" >> rvalue;
 939   }
 940   if ((type->type == T_CHAR) && (type->is_pointer == 0)) {
 941     rvalue << "'";
 942     "'" >> rvalue;
 943   }
 944   if ((tm = typemap_lookup("const","tcl8",type,name,rvalue.get(),name))) {
 945     // Yep.  Use it instead of the default
 946     fprintf(f_init,"%s\n",tm);
 947   } else {
 948
 949     // Create variable and assign it a value
 950
 951     if (type->is_pointer == 0) {
 952       switch(type->type) {
 953       case T_BOOL: case T_INT: case T_SINT: case T_DOUBLE:
 954         fprintf(f_header,"static %s %s = %s;\n", type->print_type(), var_name, value);
 955         link_variable(var_name,name,type);
 956         break;
 957       case T_SHORT:
 958       case T_LONG:
 959       case T_SSHORT:
 960       case T_SCHAR:
 961       case T_SLONG:
 962         fprintf(f_header,"static %s %s = %s;\n", type->print_type(), var_name, value);
 963         fprintf(f_header,"static char *%s_char;\n", var_name);
 964         if (CPlusPlus)
 965           fprintf(f_init,"\t %s_char = new char[32];\n",var_name);
 966         else
 967           fprintf(f_init,"\t %s_char = (char *) malloc(32);\n",var_name);
 968
 969         fprintf(f_init,"\t sprintf(%s_char,\"%%ld\", (long) %s);\n", var_name, var_name);
 970         sprintf(var_name,"%s_char",var_name);
 971         t = new DataType(T_CHAR);
 972         t->is_pointer = 1;
 973         link_variable(var_name,name,t);
 974         delete t;
 975         break;
 976       case T_UINT:
 977       case T_USHORT:
 978       case T_ULONG:
 979       case T_UCHAR:
 980         fprintf(f_header,"static %s %s = %s;\n", type->print_type(), var_name, value);
 981         fprintf(f_header,"static char *%s_char;\n", var_name);
 982         if (CPlusPlus)
 983           fprintf(f_init,"\t %s_char = new char[32];\n",var_name);
 984         else
 985           fprintf(f_init,"\t %s_char = (char *) malloc(32);\n",var_name);
 986
 987         fprintf(f_init,"\t sprintf(%s_char,\"%%lu\", (unsigned long) %s);\n", var_name, var_name);
 988         sprintf(var_name,"%s_char",var_name);
 989         t = new DataType(T_CHAR);
 990         t->is_pointer = 1;
 991         link_variable(var_name,name,t);
 992         delete t;
 993         break;
 994       case T_FLOAT:
 995         type->type = T_DOUBLE;
 996         strcpy(type->name,"double");
 997         fprintf(f_header,"static %s %s = %s (%s);\n", type->print_type(), var_name, type->print_cast(), value);
 998         link_variable(var_name,name,type);
 999         break;
1000
1001       case T_CHAR:
1002         type->is_pointer++;
1003         fprintf(f_header,"static %s %s = \"%s\";\n", type->print_type(), var_name, value);
1004         link_variable(var_name,name,type);
1005         type->is_pointer--;
1006         break;
1007       default:
1008         fprintf(stderr,"%s : Line %d. Unsupported constant value.\n", input_file, line_number);
1009         break;
1010       }
1011     } else {
1012       // Have some sort of pointer value here
1013       if ((type->type == T_CHAR) && (type->is_pointer == 1)) {
1014         // Character string
1015         fprintf(f_header,"static %s %s = \"%s\";\n", type->print_type(), var_name, value);
1016         link_variable(var_name,name,type);
1017       } else {
1018         // Something else.   Some sort of pointer value
1019         fprintf(f_header,"static %s %s = %s;\n", type->print_type(), var_name, value);
1020         fprintf(f_header,"static char *%s_char;\n", var_name);
1021         if (CPlusPlus)
1022           fprintf(f_init,"\t %s_char = new char[%d];\n",var_name,(int) strlen(type->print_mangle())+ 20);
1023         else
1024           fprintf(f_init,"\t %s_char = (char *) malloc(%d);\n",var_name, (int) strlen(type->print_mangle())+ 20);
1025
1026         t = new DataType(T_CHAR);
1027         t->is_pointer = 1;
1028         fprintf(f_init,"\t SWIG_MakePtr(%s_char, (void *) %s,\"%s\");\n",
1029                 var_name, var_name, type->print_mangle());
1030         sprintf(var_name,"%s_char",var_name);
1031         link_variable(var_name,name,t);
1032         delete t;
1033       }
1034     }
1035   }
1036
1037   // Create a documentation entry for this
1038
1039   if (doc_entry) {
1040     doc_entry->usage = "";       // Destroy any previous information from linking
1041     doc_entry->usage << usage_const(name, type, value);
1042     doc_entry->cinfo = "";
1043     doc_entry->cinfo << "Constant : " << type->print_type();
1044   }
1045
1046   Status = OldStatus;
1047 }
1048
1049 // ----------------------------------------------------------------------
1050 // TCL8::usage_var(char *iname, DataType *t, char **s)
1051 //
1052 // Produces a usage string for a tcl variable.  Stores it in s
1053 // ----------------------------------------------------------------------
1054
1055 char *TCL8::usage_var(char *iname, DataType *t) {
1056
1057   static char temp[1024];
1058
1059   if (!nspace) {
1060     sprintf(temp,"$%s%s", prefix, iname);
1061   } else {
1062     sprintf(temp,"%s::%s", ns_name, iname);
1063   }
1064   if (!(((t->type == T_INT) && (!t->is_pointer)) ||
1065         ((t->type == T_UINT) && (!t->is_pointer)) ||
1066         ((t->type == T_DOUBLE) && (!t->is_pointer)) ||
1067         ((t->type == T_BOOL) && (!t->is_pointer)) ||
1068         ((t->type == T_CHAR) && (t->is_pointer)))) {
1069     /* We emitted a pair of set/get functions instead.  Doc will be generated for that */
1070     return temp;
1071   }
1072   return temp;
1073 }
1074
1075
1076
1077 // ---------------------------------------------------------------------------
1078 // char *TCL8::usage_string(char *iname, DataType *t, ParmList *l),
1079 //
1080 // Generates a generic usage string for a Tcl function.
1081 // ---------------------------------------------------------------------------
1082
1083 char * TCL8::usage_string(char *iname, DataType *, ParmList *l) {
1084
1085   static String temp;
1086   Parm  *p;
1087   int   i, numopt,pcount;
1088
1089   temp = "";
1090   temp << iname << " ";
1091
1092   /* Now go through and print parameters */
1093   i = 0;
1094   pcount = l->nparms;
1095   numopt = l->numopt();
1096   p = l->get_first();
1097   while (p != 0) {
1098
1099     // Only print an argument if not ignored
1100
1101     if (!typemap_check("ignore","tcl8",p->t,p->name)) {
1102       if (i >= (pcount-numopt))
1103         temp << "?";
1104
1105       /* If parameter has been named, use that.   Otherwise, just print a type  */
1106
1107       if ((p->t->type != T_VOID) || (p->t->is_pointer)) {
1108         if (strlen(p->name) > 0) {
1109           temp << p->name;
1110         }
1111         else {
1112           temp << "{ " << p->t->print_type() << " }";
1113         }
1114       }
1115       if (i >= (pcount-numopt))
1116         temp << "?";
1117       temp << " ";
1118       i++;
1119     }
1120     p = l->get_next();
1121   }
1122   return temp;
1123 }
1124
1125 // ---------------------------------------------------------------------------
1126 // char *TCL8::usage_func(char *iname, DataType *t, ParmList *l),
1127 //
1128 // Produces a usage string for a function in Tcl
1129 // ---------------------------------------------------------------------------
1130
1131 char * TCL8::usage_func(char *iname, DataType *t, ParmList *l) {
1132
1133   String temp;
1134
1135   if (nspace) {
1136     temp << ns_name << "::" << iname;
1137   } else {
1138     temp << prefix << iname;
1139   }
1140   return usage_string(temp,t,l);
1141 }
1142
1143 // -----------------------------------------------------------------
1144 // TCL8::usage_const(char *name, DataType *type, char *value)
1145 //                         char **s)
1146 //
1147 // Makes a usage string and returns it
1148 // -----------------------------------------------------------------
1149
1150 char *TCL8::usage_const(char *name, DataType *, char *value) {
1151   static String temp;
1152   temp = "";
1153   if (nspace) {
1154     temp << ns_name << "::" << name << " = " << value;
1155   } else {
1156     temp << "$" << prefix << name << " = " << value;
1157   }
1158   return temp.get();
1159 }
1160
1161 // -------------------------------------------------------------------
1162 // TCL8::add_native(char *name, char *funcname)
1163 //
1164 // This adds an already written Tcl wrapper function to our
1165 // initialization function.
1166 // -------------------------------------------------------------------
1167
1168
1169 void TCL8::add_native(char *name, char *funcname) {
1170
1171   fprintf(f_init,"\t Tcl_CreateCommand(%s, SWIG_prefix \"%s\", %s, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);\n",interp_name, name, funcname);
1172
1173   if (doc_entry) {
1174     if (nspace)
1175       doc_entry->usage << ns_name << "::" << name << " args";
1176     else
1177       doc_entry->usage << prefix << name << " args";
1178
1179     doc_entry->cinfo << "Native method : " << funcname;
1180   }
1181
1182 }
1183
1184 // -------------------------------------------------------------------
1185 // TCL8::pragma(char *lname, char *name, char *value)
1186 //
1187 // Handle pragmas.
1188 // --------------------------------------------------------------------
1189
1190 void TCL8::pragma(char *, char *, char *) {
1191
1192 }
1193
1194 // ---------------------------------------------------------------------
1195 // C++ Handling
1196 //
1197 // The following functions provide some support for C++ classes and
1198 // C structs.
1199 // ---------------------------------------------------------------------
1200
1201 void TCL8::cpp_open_class(char *classname, char *rename, char *ctype, int strip) {
1202
1203   this->Language::cpp_open_class(classname,rename,ctype,strip);
1204
1205   if (shadow) {
1206
1207     config = "";
1208     cget = "";
1209     methods = "";
1210     options = "";
1211     config_options = "";
1212     methodnames = "";
1213
1214     have_constructor = 0;
1215     have_destructor = 0;
1216     have_methods = 0;
1217     have_config = 0;
1218     have_cget = 0;
1219
1220     if (rename)
1221       class_name = copy_string(rename);
1222     else
1223       class_name = copy_string(classname);
1224
1225     base_class = (char *) 0;
1226     if (!strip) {
1227       class_type = new char[strlen(ctype)+2];
1228       sprintf(class_type,"%s ", ctype);
1229     } else
1230       class_type = "";
1231
1232     real_classname = copy_string(classname);
1233   }
1234 }
1235
1236 void TCL8::cpp_close_class() {
1237   String code,temp;
1238   DataType *t;
1239
1240   this->Language::cpp_close_class();
1241   if (shadow) {
1242
1243     t = new DataType;
1244     sprintf(t->name,"%s%s", class_type, real_classname);
1245     t->type = T_USER;
1246     t->is_pointer = 1;
1247
1248     // Note : The object oriented interface is defined by three files
1249     //     delcmd8.swg          - Object deletion wrapper
1250     //     methodcmd8.swg       - Method invocation command
1251     //     objcmd8.swg          - Command to create a new object
1252     //
1253     // These files are located in the SWIG library.  This module
1254     // grabs the files and performs marker replacements to
1255     // build the wrapper function.
1256
1257     // Generate a Tcl function for object destruction
1258
1259     if (have_destructor) {
1260       code << delcmd;
1261     }
1262
1263     // Dump out method code
1264     code << methodcmd;
1265
1266     // Dump out object creation command
1267     code << objcmd;
1268
1269     // Now perform marker replacements
1270     code.replace("@CLASS@",class_name);
1271     temp = "";
1272     temp << name_destroy(class_name);
1273     code.replace("@DESTRUCTOR@",temp);
1274     code.replace("@CLASSTYPE@",t->print_type());
1275     "configure " >> methodnames;
1276     "cget " >> methodnames;
1277     code.replace("@METHODLIST@", methodnames);
1278     code.replace("@CLASSMANGLE@",t->print_mangle());
1279     code.replace("@METHODS@",methods);
1280     code.replace("@CONFIGMETHODS@",config);
1281     code.replace("@CGETMETHODS@",cget);
1282     if (have_constructor) {
1283       temp = "";
1284       temp << name_wrapper(name_construct(class_name),prefix);
1285     } else {
1286       temp = "0";
1287     }
1288     code.replace("@TCLCONSTRUCTOR@",temp);
1289     code.replace("@CONFIGLIST@",config_options);
1290     code.replace("@CGETLIST@",options);
1291     if (have_destructor) {
1292       temp = "TclDelete";
1293       temp << class_name;
1294     } else {
1295       temp = "0";
1296     }
1297     code.replace("@TCLDESTRUCTOR@",temp);
1298     fprintf(f_wrappers,"%s\n", code.get());
1299
1300     fprintf(f_init,"\t Tcl_CreateObjCommand(interp,SWIG_prefix \"%s\",Tcl%sCmd, (ClientData) NULL, NULL);\n", class_name, class_name);
1301   }
1302 }
1303
1304 void TCL8::cpp_member_func(char *name, char *iname, DataType *t, ParmList *l) {
1305
1306   char *realname;
1307   String temp;
1308   char  *rname;
1309
1310   this->Language::cpp_member_func(name,iname,t,l);
1311
1312   if (shadow) {
1313     if (iname)
1314       realname = iname;
1315     else
1316       realname = name;
1317
1318     // Add stubs for this member to our class handler function
1319
1320     if (have_methods)
1321       methods << tab4 << "else ";
1322     else
1323       methods << tab4;
1324
1325     temp = "";
1326     temp << name_member(realname,class_name);
1327     rname = (char *) repeatcmd.lookup(temp);
1328     if (!rname)
1329       rname = name_wrapper(temp.get(),prefix);
1330
1331     methods << "if (strcmp(_str,\"" << realname << "\") == 0) {\n"
1332             << tab4 << tab4 << "cmd = " << rname << ";\n"
1333             << tab4 << "}";
1334
1335     have_methods = 1;
1336     methodnames << realname << " ";
1337
1338     if (doc_entry) {
1339       doc_entry->usage = "";
1340       doc_entry->usage << usage_string(realname,t,l);
1341     }
1342   }
1343 }
1344
1345 void TCL8::cpp_variable(char *name, char *iname, DataType *t) {
1346   char *realname;
1347   String temp;
1348   char *rname;
1349
1350   this->Language::cpp_variable(name, iname, t);
1351
1352   if (shadow) {
1353     if (iname)
1354       realname = iname;
1355     else
1356       realname = name;
1357
1358     char *bc = class_name;
1359
1360     // Write config code
1361
1362     if (!(Status & STAT_READONLY)) {
1363       if (!have_config) {
1364         config << tab8 << tab8;
1365       } else {
1366         config << " else ";
1367       }
1368
1369       // Try to figure out if there is already a wrapper for this
1370
1371       temp = "";
1372       temp << name_set(name_member(realname,bc));
1373       rname = (char *) repeatcmd.lookup(temp);
1374       if (!rname)
1375         rname = name_wrapper(temp.get(),prefix);
1376
1377       config << "if (strcmp(_str,\"-" << realname << "\") == 0) {\n"
1378              << tab8 << tab8 << tab4 << "cmd = " << rname << ";\n"
1379              << tab8 << tab8 << "} ";
1380
1381       have_config = 1;
1382     }
1383
1384     // Write cget code
1385
1386     if (!have_cget) {
1387       cget << tab8 << tab8;
1388     } else {
1389       cget << " else ";
1390     }
1391
1392
1393     // Try to figure out if there is a wrapper for this function
1394     temp = "";
1395     temp << name_get(name_member(realname,bc));
1396     rname = (char *) repeatcmd.lookup(temp);
1397     if (!rname)
1398       rname = name_wrapper(temp.get(),prefix);
1399
1400     cget << "if (strcmp(_str,\"-" << realname << "\") == 0) {\n"
1401          << tab8 << tab8 << tab4 << "cmd = " << rname << ";\n"
1402          << tab8 << tab8 << "} ";
1403     have_cget = 1;
1404
1405     options << "-" << realname << " ";
1406     if (!(Status & STAT_READONLY)) {
1407       config_options << "-" << realname << " ";
1408     }
1409     if (doc_entry){
1410       doc_entry->usage = "";
1411       doc_entry->usage << "-" << realname << "\n";
1412     }
1413   }
1414 }
1415
1416 void TCL8::cpp_constructor(char *name, char *iname, ParmList *l) {
1417   this->Language::cpp_constructor(name,iname,l);
1418
1419   if (shadow) {
1420     if ((!have_constructor) && (doc_entry)) {
1421       doc_entry->usage = "";
1422       doc_entry->usage << class_name << usage_string(" name",0,l);
1423     }
1424     have_constructor = 1;
1425   }
1426 }
1427 void TCL8::cpp_destructor(char *name, char *newname) {
1428   this->Language::cpp_destructor(name,newname);
1429   if (shadow) {
1430     if (!have_destructor) {
1431       if (doc_entry) {
1432         doc_entry->usage = "rename obj {}";
1433       }
1434     }
1435     have_destructor = 1;
1436   }
1437 }
1438
1439 void TCL8::cpp_inherit(char **baseclass, int) {
1440   this->Language::cpp_inherit(baseclass);
1441 }
1442
1443 void TCL8::cpp_declare_const(char *name, char *iname, DataType *type, char *value) {
1444   this->Language::cpp_declare_const(name,iname,type,value);
1445 }
1446
1447 // --------------------------------------------------------------------------------
1448 // TCL8::add_typedef(DataType *t, char *name)
1449 //
1450 // This is called whenever a typedef is encountered.   When shadow classes are
1451 // used, this function lets us discovered hidden uses of a class.  For example :
1452 //
1453 //     struct FooBar {
1454 //            ...
1455 //     }
1456 //
1457 // typedef FooBar *FooBarPtr;
1458 //
1459 // --------------------------------------------------------------------------------
1460
1461 void TCL8::add_typedef(DataType *t, char *name) {
1462
1463   if (!shadow) return;
1464
1465   // First check to see if there aren't too many pointers
1466
1467   if (t->is_pointer > 1) return;
1468   if (hash.lookup(name)) return;      // Already added
1469
1470   // Now look up the datatype in our shadow class hash table
1471
1472   if (hash.lookup(t->name)) {
1473
1474     // Yep.   This datatype is in the hash
1475     // Put this types 'new' name into the hash
1476     hash.add(name,copy_string((char *) hash.lookup(t->name)));
1477   }
1478 }
1479
1480 // -----------------------------------------------------------------------
1481 // TCL8::cpp_class_decl(char *name, char *rename, char *type)
1482 //
1483 // Treatment of an empty class definition.    Used to handle
1484 // shadow classes across modules.
1485 // -----------------------------------------------------------------------
1486
1487 void TCL8::cpp_class_decl(char *name, char *rename, char *type) {
1488   char temp[256];
1489   this->Language::cpp_class_decl(name,rename, type);
1490
1491   if (shadow) {
1492     hash.add(name,copy_string(rename));
1493     // Add full name of datatype to the hash table
1494     if (strlen(type) > 0) {
1495       sprintf(temp,"%s %s", type, name);
1496       hash.add(temp,copy_string(rename));
1497     }
1498   }
1499 }