/******************************************************************************
 * 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.
 *****************************************************************************/

char cvsroot_guile_cxx[] = "$Header$";

/***********************************************************************
 * $Header$
 *
 * guile.cxx
 *
 * Definitions for adding functions to Guile
 ***********************************************************************/

/***********************************************************************
 * GOOPS Support added by John Lenz <jelenz@wisc.edu> in June, 2003
 * Base code copied from chicken module, writen by Jonah Beckford
 ***********************************************************************/

#include "swigmod.h"

#include <ctype.h>

// Note string broken in half for compilers that can't handle long strings
static const char *guile_usage = (char*)"\
Guile Options (available with -guile)\n\
     -prefix <name>          - Use <name> as prefix [default \"gswig_\"]\n\
     -package <name>         - Set the path of the module to <name>\n\
                               (default NULL)\n\
     -emitsetters            - Emit procedures-with-setters for variables\n\
                               and structure slots.\n\
     -onlysetters            - Don't emit traditional getter and setter\n\
                               procedures for structure slots,\n\
                               only emit procedures-with-setters.\n\
     -procdoc <file>         - Output procedure documentation to <file>\n\
     -procdocformat <format> - Output procedure documentation in <format>;\n\
                               one of `guile-1.4', `plain', `texinfo'\n\
     -linkage <lstyle>       - Use linkage protocol <lstyle> (default `simple')\n\
                               Use `module' for native Guile module linking\n\
                               (requires Guile >= 1.5.0).  Use `passive' for\n\
                               passive linking (no C-level module-handling code),\n\
                               `ltdlmod' for Guile's old dynamic module\n\
                               convention (Guile <= 1.4), or `hobbit' for hobbit\n\
                               modules.\n\
     -scmstub                - Output Scheme file with module declaration and\n\
                               exports; only with `passive' and `simple' linkage\n\
     -gh                     - Use the gh_ Guile API. (Guile <= 1.8) \n\
     -scm                    - Use the scm Guile API. (Guile >= 1.6, default) \n\
     -proxy                  - Export GOOPS class definitions\n\
     -emitslotaccessors      - Emit accessor methods for all GOOPS slots\n" "\
     -primsuffix <suffix>    - Name appended to primitive module when exporting\n\
                               GOOPS classes. (default = \"primitive\")\n\
     -goopsprefix <prefix>   - Prepend <prefix> to all goops identifiers\n\
     -useclassprefix         - Prepend the class name to all goops identifiers\n\
     -exportprimitive        - Add the (export ...) code from scmstub into the\n\
                               GOOPS file.\n";

static  File         *f_runtime = 0;
static  File         *f_header = 0;
static  File         *f_wrappers = 0;
static  File         *f_init = 0;


static char   *prefix = (char *) "gswig_";
static char   *module = 0;
static char   *package = 0;
static enum {
  GUILE_LSTYLE_SIMPLE,                // call `SWIG_init()'
  GUILE_LSTYLE_PASSIVE,               // passive linking (no module code)
  GUILE_LSTYLE_MODULE,                // native guile module linking (Guile >= 1.4.1)
  GUILE_LSTYLE_LTDLMOD_1_4,		// old (Guile <= 1.4) dynamic module convention
  GUILE_LSTYLE_HOBBIT                 // use (hobbit4d link)
} linkage = GUILE_LSTYLE_SIMPLE;

static File   *procdoc = 0;
static bool    scmstub = false;
static String *scmtext;
static bool    goops = false;
static String *goopstext;
static String *goopscode;
static String *goopsexport;

static enum {
  GUILE_1_4,
  PLAIN,
  TEXINFO
} docformat = GUILE_1_4;

static int     emit_setters = 0;
static int     only_setters = 0;
static int     emit_slot_accessors = 0;
static int     struct_member = 0;

static String *beforereturn = 0;
static String *return_nothing_doc = 0;
static String *return_one_doc = 0;
static String *return_multi_doc = 0;

static String *exported_symbols = 0;

static int     use_scm_interface = 1;
static int     exporting_destructor = 0;
static String *swigtype_ptr = 0;

/* GOOPS stuff */
static String *primsuffix = 0;
static String *class_name = 0;
static String *short_class_name = 0;
static String *goops_class_methods;
static int     in_class = 0;
static int     have_constructor = 0;
static int     useclassprefix = 0; // -useclassprefix argument
static String *goopsprefix = 0; // -goopsprefix argument
static int     primRenamer = 0; // if (use-modules ((...) :renamer ...) is exported to GOOPS file
static int     exportprimitive = 0; // -exportprimitive argument
static String *memberfunction_name = 0;

extern "C" {
  static int has_classname(Node *class_node)
  {
    return Getattr(class_node, "guile:goopsclassname") != NULL;
  }
}
  
class GUILE : public Language {
public:

  /* ------------------------------------------------------------
   * main()
   * ------------------------------------------------------------ */

  virtual void main (int argc, char *argv[]) {
    int i, orig_len;
    
    SWIG_library_directory("guile");
    SWIG_typemap_lang("guile");

  // Look for certain command line options
    for (i = 1; i < argc; i++) {
      if (argv[i]) {
	if (strcmp (argv[i], "-help") == 0) {
	  fputs (guile_usage, stdout);
	  SWIG_exit (EXIT_SUCCESS);
	}
	else if (strcmp (argv[i], "-prefix") == 0) {
	  if (argv[i + 1]) {
	    prefix = new char[strlen (argv[i + 1]) + 2];
	    strcpy (prefix, argv[i + 1]);
	    Swig_mark_arg (i);
	    Swig_mark_arg (i + 1);
	    i++;
	  } else {
	    Swig_arg_error();
	  }
	}
	else if (strcmp (argv[i], "-package") == 0) {
	  if (argv[i + 1]) {
	    package = new char[strlen (argv[i + 1]) + 2];
	    strcpy (package, argv [i + 1]);
	    Swig_mark_arg (i);
	    Swig_mark_arg (i + 1);
	    i++;
	  } else {
	    Swig_arg_error();
	  }
	}
	else if (strcmp (argv[i], "-Linkage") == 0
		 || strcmp (argv[i], "-linkage") == 0) {
	  if (argv[i + 1]) {
	    if (0 == strcmp (argv[i + 1], "ltdlmod"))
	      linkage = GUILE_LSTYLE_LTDLMOD_1_4;
	    else if (0 == strcmp (argv[i + 1], "hobbit"))
	      linkage = GUILE_LSTYLE_HOBBIT;
	    else if (0 == strcmp (argv[i + 1], "simple"))
	      linkage = GUILE_LSTYLE_SIMPLE;
	    else if (0 == strcmp (argv[i + 1], "passive"))
	      linkage = GUILE_LSTYLE_PASSIVE;
	    else if (0 == strcmp (argv[i + 1], "module"))
	      linkage = GUILE_LSTYLE_MODULE;
	    else
	      Swig_arg_error ();
	    Swig_mark_arg (i);
	    Swig_mark_arg (i + 1);
	    i++;
	  } else {
	    Swig_arg_error();
	  }
	}
	else if (strcmp (argv[i], "-procdoc") == 0) {
	  if (argv[i + 1]) {
	    procdoc = NewFile(argv[i + 1], (char *) "w");
	    if (!procdoc) {
	      FileErrorDisplay(argv[i + 1]);
	      SWIG_exit(EXIT_FAILURE);
	    }
	    Swig_mark_arg (i);
	    Swig_mark_arg (i + 1);
	    i++;
	  } else {
	    Swig_arg_error();
	  }
	}
	else if (strcmp (argv[i], "-procdocformat") == 0) {
	  if (strcmp(argv[i+1], "guile-1.4") == 0)
	    docformat = GUILE_1_4;
	  else if (strcmp(argv[i+1], "plain") == 0)
	    docformat = PLAIN;
	  else if (strcmp(argv[i+1], "texinfo") == 0)
	    docformat = TEXINFO;
	  else Swig_arg_error();
	  Swig_mark_arg(i);
	  Swig_mark_arg(i+1);
	  i++;
	}
	else if (strcmp (argv[i], "-emit-setters") == 0
		 || strcmp (argv[i], "-emitsetters") == 0) {
	  emit_setters = 1;
	  Swig_mark_arg (i);
	}
	else if (strcmp (argv[i], "-only-setters") == 0
		 || strcmp (argv[i], "-onlysetters") == 0) {
	  emit_setters = 1;
	  only_setters = 1;
	  Swig_mark_arg (i);
	}
	else if (strcmp (argv[i], "-emit-slot-accessors") == 0
		 || strcmp (argv[i], "-emitslotaccessors") == 0) {
	  emit_slot_accessors = 1;
	  Swig_mark_arg (i);
	}
	else if (strcmp (argv[i], "-scmstub") == 0) {
          scmstub = true;
          Swig_mark_arg(i);
	}
	else if ((strcmp(argv[i],"-shadow") == 0) || ((strcmp(argv[i],"-proxy") == 0))) {
          goops = true;
          Swig_mark_arg(i);
        }
        else if (strcmp(argv[i], "-gh") == 0) {
          use_scm_interface = 0;
          Swig_mark_arg(i);
        }
        else if (strcmp(argv[i], "-scm") == 0) {
          use_scm_interface = 1;
          Swig_mark_arg(i);
        }
        else if (strcmp(argv[i], "-primsuffix") == 0) {
          if (argv[i+1]) {
            primsuffix = NewString(argv[i+1]);
	    Swig_mark_arg (i);
	    Swig_mark_arg (i + 1);
	    i++;
          } else {
            Swig_arg_error();
          }
        }
        else if (strcmp(argv[i], "-goopsprefix") == 0) {
          if (argv[i+1]) {
            goopsprefix = NewString(argv[i+1]);
	    Swig_mark_arg (i);
	    Swig_mark_arg (i + 1);
	    i++;
          } else {
            Swig_arg_error();
          }
        }
        else if (strcmp(argv[i], "-useclassprefix") == 0) {
          useclassprefix = 1;
          Swig_mark_arg(i);
        }
        else if (strcmp(argv[i], "-exportprimitive") == 0) {
          exportprimitive = 1;
          // should use Swig_warning() here?
          Swig_mark_arg(i);
        }
      }
    }

    // set default value for primsuffix
    if (primsuffix == NULL)
      primsuffix = NewString("primitive");

    //goops support can only be enabled if passive or module linkage is used
    if (goops) {
      if (linkage != GUILE_LSTYLE_PASSIVE && linkage != GUILE_LSTYLE_MODULE) {
        Printf(stderr, "guile: GOOPS support requires passive or module linkage\n");
        exit(1);
      }
    }

    if (goops) {
      // -proxy implies -emit-setters
      emit_setters = 1;
    }

    if ((linkage == GUILE_LSTYLE_PASSIVE && scmstub) || linkage == GUILE_LSTYLE_MODULE)
      primRenamer = 1;

    if (exportprimitive && primRenamer) {
      // should use Swig_warning() ?
      Printf(stderr, 
          "guile: Warning: -exportprimitive only makes sense with passive linkage without a scmstub.\n");
    }

    // Make sure `prefix' ends in an underscore

    orig_len = strlen (prefix);
    if (prefix[orig_len - 1] != '_') {
      prefix[1 + orig_len] = 0;
      prefix[orig_len] = '_';
    }

    /* Add a symbol for this module */
    Preprocessor_define ("SWIGGUILE 1",0);
    /* Read in default typemaps */
    if (use_scm_interface)
      SWIG_config_file("guile_scm.swg");
    else
      SWIG_config_file("guile_gh.swg");
    allow_overloading();
    
  }

  /* ------------------------------------------------------------
   * top()
   * ------------------------------------------------------------ */

  virtual int top(Node *n)  {
    /* Initialize all of the output files */
    String *outfile = Getattr(n,"outfile");
    
    f_runtime = NewFile(outfile,"w");
    if (!f_runtime) {
      FileErrorDisplay(outfile);
      SWIG_exit(EXIT_FAILURE);
    }
    f_init = NewString("");
    f_header = NewString("");
    f_wrappers = NewString("");
    
    /* Register file targets with the SWIG file handler */
    Swig_register_filebyname("header",f_header);
    Swig_register_filebyname("wrapper",f_wrappers);
    Swig_register_filebyname("runtime",f_runtime);
    Swig_register_filebyname("init",f_init);
    
    scmtext = NewString("");
    Swig_register_filebyname("scheme", scmtext);
    exported_symbols = NewString("");
    goopstext = NewString("");
    Swig_register_filebyname("goops", goopstext);
    goopscode = NewString("");
    goopsexport = NewString("");
    
    Printf(f_runtime, "/* -*- buffer-read-only: t -*- vi: set ro: */\n");
    Swig_banner (f_runtime);
    
    Printf (f_runtime, "/* Implementation : GUILE */\n\n");

    if (!use_scm_interface) {
      if (SwigRuntime == 1)
	Printf(f_runtime, "#define SWIG_GLOBAL\n");
      if (SwigRuntime == 2)
        Printf(f_runtime, "#define SWIG_NOINCLUDE\n");
    }
    
    /* Write out directives and declarations */
    
    module = Swig_copy_string(Char(Getattr(n,"name")));
    
    switch (linkage) {
    case GUILE_LSTYLE_SIMPLE:
      /* Simple linkage; we have to export the SWIG_init function. The user can
	 rename the function by a #define. */
      Printf (f_runtime, "#define SWIG_GUILE_INIT_STATIC extern\n");
      break;
    default:
      /* Other linkage; we make the SWIG_init function static */
      Printf (f_runtime, "#define SWIG_GUILE_INIT_STATIC static\n");
      break;
    }

    if (CPlusPlus) {
      Printf(f_runtime, "extern \"C\" {\n\n");
    }
    Printf (f_runtime, "SWIG_GUILE_INIT_STATIC void\nSWIG_init (void);\n");
    if (CPlusPlus) {
      Printf(f_runtime, "\n}\n");
    }
    
    Language::top(n);
    
    /* Close module */
    
    Printf(f_wrappers,"#ifdef __cplusplus\nextern \"C\" {\n#endif\n");
    
    SwigType_emit_type_table (f_runtime, f_wrappers);
    
    Printf (f_init, "}\n\n");
    Printf (f_init, "#ifdef __cplusplus\n}\n#endif\n");

    String *module_name = NewString("");
    
    if (!module)
      Printv(module_name, "swig", NIL);
    else {
      if (package)
	Printf(module_name,"%s/%s", package, module);
      else
	Printv(module_name,module,NIL);
    }
    emit_linkage (module_name);

    Delete(module_name);
    
    if (procdoc) {
      Delete(procdoc);
      procdoc = NULL;
    }
    Delete(goopscode);
    Delete(goopsexport);
    Delete(goopstext);

    /* Close all of the files */
    Dump(f_header,f_runtime);
    Dump(f_wrappers,f_runtime);
    Wrapper_pretty_print(f_init,f_runtime);
    Delete(f_header);
    Delete(f_wrappers);
    Delete(f_init);
    Close(f_runtime);
    Delete(f_runtime);
    return SWIG_OK;
  }
  
  void emit_linkage (String *module_name) {
    String *module_func = NewString("");
    
    if (CPlusPlus) {
      Printf(f_init, "extern \"C\" {\n\n");
    }
    
    Printv(module_func,module_name,NIL);
    if (goops)
    Replaceall(module_func,"-", "_");
    
    switch (linkage) {
    case GUILE_LSTYLE_SIMPLE:
      Printf (f_init, "\n/* Linkage: simple */\n");
      break;
    case GUILE_LSTYLE_PASSIVE:
      Printf (f_init, "\n/* Linkage: passive */\n");
      Replaceall(module_func,"/", "_");
      Insert(module_func,0, "scm_init_");
      Append(module_func,"_module");
      
      Printf (f_init, "SCM\n%s (void)\n{\n", module_func);
      Printf (f_init, "  SWIG_init();\n");
      Printf (f_init, "  return SCM_UNSPECIFIED;\n");
      Printf (f_init, "}\n");
      break;
    case GUILE_LSTYLE_LTDLMOD_1_4:
      Printf (f_init, "\n/* Linkage: ltdlmod */\n");
      Replaceall(module_func,"/", "_");
      Insert(module_func,0, "scm_init_");
      Append(module_func,"_module");
      Printf (f_init, "SCM\n%s (void)\n{\n", module_func);
      {
	String *mod = NewString(module_name);
	Replaceall(mod,"/", " ");
	Printf (f_init, "    scm_register_module_xxx (\"%s\", (void *) SWIG_init);\n",
		mod);
	Printf (f_init, "    return SCM_UNSPECIFIED;\n");
	Delete(mod);
      }
      Printf (f_init, "}\n");
      break;
    case GUILE_LSTYLE_MODULE:
      Printf (f_init, "\n/* Linkage: module */\n");
      Replaceall(module_func,"/", "_");
      Insert(module_func,0, "scm_init_");
      Append(module_func,"_module");
      
      Printf (f_init, "static void SWIG_init_helper(void *data)\n");
      Printf (f_init, "{\n    SWIG_init();\n");
      if (Len(exported_symbols) > 0)
	Printf (f_init, "    scm_c_export(%sNULL);",
		exported_symbols);
      Printf (f_init, "\n}\n\n");
      
      Printf (f_init, "SCM\n%s (void)\n{\n", module_func);
      {
	String *mod = NewString(module_name);
        if (goops)
          Printv(mod,"-",primsuffix,NIL);
	Replaceall(mod,"/", " ");
	Printf(f_init, "    SCM module = scm_c_define_module(\"%s\",\n", mod);
	Printf(f_init, "      SWIG_init_helper, NULL);\n");
	Printf(f_init, "    return SCM_UNSPECIFIED;\n");
	Delete(mod);
      }
      Printf (f_init, "}\n");
      break;
    case GUILE_LSTYLE_HOBBIT:
      Printf (f_init, "\n/* Linkage: hobbit */\n");
      Replaceall(module_func,"/", "_slash_");
      Insert(module_func,0, "scm_init_");
      Printf (f_init, "SCM\n%s (void)\n{\n", module_func);
      {
	String *mod = NewString(module_name);
	Replaceall(mod,"/", " ");
	Printf (f_init, "    scm_register_module_xxx (\"%s\", (void *) SWIG_init);\n",
		mod);
	Printf (f_init, "    return SCM_UNSPECIFIED;\n");
	Delete(mod);
      }
      Printf (f_init, "}\n");
      break;
    default:
      abort();                            // for now
    }
    
    if (scmstub) {
      /* Emit Scheme stub if requested */
      String *primitive_name = NewString(module_name);
      if (goops)
        Printv(primitive_name,"-",primsuffix,NIL);
      
      String *mod = NewString(primitive_name);
      Replaceall(mod, "/", " ");
      
      String *fname = NewStringf("%s%s.scm",
				 SWIG_output_directory(),
				 primitive_name);
      Delete(primitive_name);
      File *scmstubfile = NewFile(fname, (char *) "w");
      if (!scmstubfile) {
	FileErrorDisplay(fname);
	SWIG_exit(EXIT_FAILURE);
      }	
      Delete(fname);
      
      Printf (scmstubfile, ";;; -*- buffer-read-only: t -*- vi: set ro: */\n");
      Printf (scmstubfile, ";;; Automatically generated by SWIG; do not edit.\n\n");
      if (linkage == GUILE_LSTYLE_SIMPLE
          || linkage == GUILE_LSTYLE_PASSIVE)
        Printf (scmstubfile, "(define-module (%s))\n\n", mod);
      Delete(mod);
      Printf (scmstubfile, "%s", scmtext);
      if ((linkage == GUILE_LSTYLE_SIMPLE
           || linkage == GUILE_LSTYLE_PASSIVE)
           && Len(exported_symbols) > 0) {
        String *ex = NewString(exported_symbols);
        Replaceall(ex, ", ", "\n        ");
        Replaceall(ex, "\"", "");
        Chop(ex);
        Printf(scmstubfile, "\n(export %s)\n", ex);
        Delete(ex);
      }
    }

    if (goops) {
      String *mod = NewString(module_name);
      Replaceall(mod, "/", " ");
      
      String *fname = NewStringf("%s%s.scm", SWIG_output_directory(),
				 module_name);
      File *goopsfile = NewFile(fname, (char *)"w");
      if (!goopsfile) {
	FileErrorDisplay(fname);
	SWIG_exit(EXIT_FAILURE);
      }	
      Delete(fname);
      Printf (goopsfile, ";;; -*- buffer-read-only: t -*- vi: set ro: */\n");
      Printf (goopsfile, ";;; Automatically generated by SWIG; do not edit.\n\n");
      Printf (goopsfile, "(define-module (%s))\n", mod);
      Printf (goopsfile, "%s\n", goopstext);
      Printf (goopsfile, "(use-modules (oop goops) (Swig common))\n");
      if (primRenamer) {
        Printf (goopsfile, "(use-modules ((%s-%s) :renamer (symbol-prefix-proc 'primitive:)))\n", 
                           mod, primsuffix);
      }
      Printf (goopsfile, "%s\n(export %s)", goopscode, goopsexport);
      if (exportprimitive) {
        String *ex = NewString(exported_symbols);
        Replaceall(ex, ", ", "\n        ");
        Replaceall(ex, "\"", "");
        Chop(ex);
        Printf(goopsfile, "\n(export %s)", ex);
        Delete(ex);
      }
      Delete(mod);
      Delete(goopsfile);
    }
    
    Delete(module_func);
    if (CPlusPlus) {
      Printf(f_init, "\n}\n");
    }
  }

  /* Return true iff T is a pointer type */

  int is_a_pointer (SwigType *t) {
    return SwigType_ispointer(SwigType_typedef_resolve_all(t));
  }

  /* Report an error handling the given type. */

  void throw_unhandled_guile_type_error (SwigType *d) {
    Swig_warning(WARN_TYPEMAP_UNDEF, input_file, line_number,
		 "Unable to handle type %s.\n", SwigType_str(d,0));
  }
  
  /* Write out procedure documentation */

  void write_doc(const String *proc_name,
		 const String *signature,
		 const String *doc,
		 const String *signature2 = NULL)  {
    switch (docformat) {
    case GUILE_1_4:
      Printv(procdoc, "\f\n", NIL);
      Printv(procdoc, "(", signature, ")\n", NIL);
      if (signature2)
	Printv(procdoc, "(", signature2, ")\n", NIL);
      Printv(procdoc, doc, "\n", NIL);
      break;
    case PLAIN:
      Printv(procdoc, "\f", proc_name, "\n\n", NIL);
      Printv(procdoc, "(", signature, ")\n", NIL);
      if (signature2)
	Printv(procdoc, "(", signature2, ")\n", NIL);
      Printv(procdoc, doc, "\n\n", NIL);
      break;
    case TEXINFO:
      Printv(procdoc, "\f", proc_name, "\n", NIL);
      Printv(procdoc, "@deffn primitive ", signature, "\n", NIL);
      if (signature2)
	Printv(procdoc, "@deffnx primitive ", signature2, "\n", NIL);
      Printv(procdoc, doc, "\n", NIL);
      Printv(procdoc, "@end deffn\n\n", NIL);
      break;
    }
  }

  /* returns false if the typemap is an empty string */
  bool handle_documentation_typemap(String *output,
				    const String *maybe_delimiter,
				    Parm *p,
				    const String *typemap,
				    const String *default_doc,
				    const String *name = NULL)
  {
    String *tmp = NewString("");
    String *tm;
    if (!(tm = Getattr(p, typemap))) {
      Printf(tmp, "%s", default_doc);
      tm = tmp;
    }
    bool result = (Len(tm) > 0);
    if (maybe_delimiter && Len(output) > 0 && Len(tm) > 0) {
      Printv(output, maybe_delimiter, NIL);
    }
    const String *pn = (name == NULL) ? (const String *)Getattr(p,"name") : name;
    String *pt = Getattr(p,"type");
    Replaceall(tm, "$name", pn); // legacy for $parmname
    Replaceall(tm, "$type", SwigType_str(pt,0));
    /* $NAME is like $name, but marked-up as a variable. */
    String *ARGNAME = NewString("");
    if (docformat == TEXINFO)
      Printf(ARGNAME, "@var{%s}", pn);
    else Printf(ARGNAME, "%(upper)s", pn);
    Replaceall(tm, "$NAME", ARGNAME);
    Replaceall(tm, "$PARMNAME", ARGNAME);
    Printv(output,tm,NIL);
    Delete(tmp);
    return result;
  } 
    
  /* ------------------------------------------------------------
   * functionWrapper()
   * Create a function declaration and register it with the interpreter.
   * ------------------------------------------------------------ */
  
  virtual int functionWrapper(Node *n) {
    String *iname = Getattr(n,"sym:name");
    SwigType *d = Getattr(n,"type");
    ParmList *l = Getattr(n,"parms");
    Parm *p;
    String *proc_name = 0;
    char source[256], target[256];
    Wrapper *f = NewWrapper();;
    String *cleanup = NewString("");
    String *outarg = NewString("");
    String *signature = NewString("");
    String *doc_body = NewString("");
    String *returns = NewString("");
    String *method_signature = NewString("");
    String *primitive_args = NewString("");
    Hash *scheme_arg_names = NewHash();
    int num_results = 1;
    String *tmp = NewString("");
    String *tm;
    int i;
    int numargs = 0;
    int numreq = 0;
    String *overname = 0;
    int args_passed_as_array = 0;
    int scheme_argnum = 0;
    bool any_specialized_arg = false;
    
    // Make a wrapper name for this
    String *wname = Swig_name_wrapper(iname);
    if (Getattr(n,"sym:overloaded")) {
      overname = Getattr(n,"sym:overname");
      args_passed_as_array = 1;
    } else {
      if (!addSymbol(iname,n)) return SWIG_ERROR;
    }
    if (overname) {
      Append(wname, overname);
    }
    Setattr(n,"wrap:name",wname);
    
    // Build the name for scheme.
    proc_name = NewString(iname);
    Replaceall(proc_name,"_", "-");
    
    /* Emit locals etc. into f->code; figure out which args to ignore */
    emit_args (d, l, f);
    
    /* Attach the standard typemaps */
    emit_attach_parmmaps(l,f);
    Setattr(n,"wrap:parms",l);
    
    /* Get number of required and total arguments */
    numargs = emit_num_arguments(l);
    numreq  = emit_num_required(l);
    
    /* Declare return variable */
    
    Wrapper_add_local (f,"gswig_result", "SCM gswig_result");
    Wrapper_add_local (f,"gswig_list_p", "int gswig_list_p = 0");
    
    /* Get the output typemap so we can start generating documentation.  Don't
       worry, the returned string is saved as 'tmap:out' */
    
    Swig_typemap_lookup_new("out",n,"result",0);
    
    if ((tm = Getattr(n,"tmap:out:doc"))) {
      Printv(returns,tm,NIL);
      if (Len(tm) > 0) num_results = 1;
      else num_results = 0;
    } else {
      String *s = SwigType_str(d,0);
      Chop(s);
      Printf(returns,"<%s>",s);
      Delete(s);
      num_results = 1;
    }
    
    /* Open prototype and signature */
    
    Printv(f->def, "static SCM\n", wname," (", NIL);
    if (args_passed_as_array) {
      Printv(f->def, "int argc, SCM *argv", NIL);
    }
    Printv(signature, proc_name, NIL);
    
    /* Now write code to extract the parameters */
    
    for (i = 0, p = l; i < numargs; i++) {

      while (checkAttribute(p,"tmap:in:numinputs","0")) {
	p = Getattr(p,"tmap:in:next");
      }
      
      SwigType *pt = Getattr(p,"type");
      String   *ln = Getattr(p,"lname");
      int opt_p = (i >= numreq);
      
      // Produce names of source and target
      if (args_passed_as_array)
	sprintf(source, "argv[%d]", i);
      else
	sprintf(source,"s_%d",i);
      sprintf(target,"%s", Char(ln));
      
      if (!args_passed_as_array) {
	if (i!=0) Printf(f->def,", ");
	Printf(f->def,"SCM s_%d", i);
      }
      if (opt_p) {
	Printf(f->code,"    if (%s != SCM_UNDEFINED) {\n", source);
      }
      if ((tm = Getattr(p,"tmap:in"))) {
	Replaceall(tm,"$source",source);
	Replaceall(tm,"$target",target);
	Replaceall(tm,"$input",source);
	Setattr(p,"emit:input", source);
	Printv(f->code,tm,"\n",NIL);

	SwigType *pb = SwigType_typedef_resolve_all(SwigType_base(pt));
	SwigType *pn = Getattr(p,"name");
	String *argname;
	scheme_argnum++;
	if (pn && !Getattr(scheme_arg_names, pn))
	  argname = pn;
	else {
	  /* Anonymous arg or re-used argument name -- choose a name that cannot clash */
	  argname = NewStringf("%%arg%d", scheme_argnum);
	}
	
	if (procdoc) {
	  if (i == numreq) {
	    /* First optional argument */
	    Printf(signature, " #:optional");
	  }
	  /* Add to signature (arglist) */
	  handle_documentation_typemap(signature, " ", p, "tmap:in:arglist",
				       "$name", argname);
	  /* Document the type of the arg in the documentation body */
	  handle_documentation_typemap(doc_body, ", ", p, "tmap:in:doc",
				       "$NAME is of type <$type>", argname);
	}

	if (goops) {
	  if (i < numreq) {
	    if (strcmp("void", Char(pt)) != 0) {
	      Node *class_node = Swig_symbol_clookup_check(pb, Getattr(n, "sym:symtab"),
							   has_classname);
	      String *goopsclassname = (class_node == NULL) ? NULL :
		Getattr(class_node, "guile:goopsclassname");
	      /* do input conversion */
	      if (goopsclassname) {
		Printv(method_signature, " (", argname, " ", goopsclassname, ")", NIL);
		any_specialized_arg = true;
	      } else {
		Printv(method_signature, " ", argname, NIL);
	      }
	      Printv(primitive_args, " ", argname, NIL);
	      Setattr(scheme_arg_names, argname, p);
	    }
	  }
	}
	
	if (!pn) {
	  Delete(argname);
	}
	p = Getattr(p,"tmap:in:next");
      } else {
	throw_unhandled_guile_type_error (pt);
	p = nextSibling(p);
      }
      if (opt_p)
	Printf(f->code,"    }\n");
    }
    if (Len(doc_body) > 0)
      Printf(doc_body, ".\n");
    
    /* Insert constraint checking code */
    for (p = l; p;) {
      if ((tm = Getattr(p,"tmap:check"))) {
	Replaceall(tm,"$target",Getattr(p,"lname"));
	Printv(f->code,tm,"\n",NIL);
	p = Getattr(p,"tmap:check:next");
      } else {
	p = nextSibling(p);
      }
    }
    /* Pass output arguments back to the caller. */
    
    /* Insert argument output code */
    for (p = l; p;) {
      if ((tm = Getattr(p,"tmap:argout"))) {
	Replaceall(tm,"$source",Getattr(p,"lname"));
	Replaceall(tm,"$target",Getattr(p,"lname"));
	Replaceall(tm,"$arg",Getattr(p,"emit:input"));
	Replaceall(tm,"$input",Getattr(p,"emit:input"));
	Printv(outarg,tm,"\n",NIL);
	if (procdoc) {
	  if (handle_documentation_typemap(returns, ", ",
					   p, "tmap:argout:doc",
					   "$NAME (of type $type)")) {
	    /* A documentation typemap that is not the empty string
	       indicates that a value is returned to Scheme. */
	    num_results++;
	  }
	}
	p = Getattr(p,"tmap:argout:next");
      } else {
	p = nextSibling(p);
      }
    }
    
    /* Insert cleanup code */
    for (p = l; p;) {
      if ((tm = Getattr(p,"tmap:freearg"))) {
	Replaceall(tm,"$target",Getattr(p,"lname"));
	Replaceall(tm,"$input",Getattr(p,"emit:input"));
	Printv(cleanup,tm,"\n",NIL);
	p = Getattr(p,"tmap:freearg:next");
      } else {
	p = nextSibling(p);
      }
    }

    if (use_scm_interface && exporting_destructor) {
      /* Mark the destructor's argument as destroyed. */
      String *tm = NewString("SWIG_Guile_MarkPointerDestroyed($input);");
      Replaceall(tm,"$input",Getattr(l,"emit:input"));
      Printv(cleanup, tm, "\n", NIL);
      Delete(tm);
    }
    
    /* Close prototype */
    
    Printf(f->def, ")\n{\n");
    
    /* Define the scheme name in C. This define is used by several Guile
       macros. */
    Printv(f->def, "#define FUNC_NAME \"", proc_name, "\"", NIL);
    
    // Now write code to make the function call
    if (!use_scm_interface)
      Printv(f->code, tab4, "gh_defer_ints();\n", NIL);
    emit_action(n,f);
    if (!use_scm_interface)
      Printv(f->code, tab4, "gh_allow_ints();\n", NIL);
    
    // Now have return value, figure out what to do with it.
    
    if ((tm = Getattr(n,"tmap:out"))) {
      Replaceall(tm,"$result","gswig_result");
      Replaceall(tm,"$target","gswig_result");
      Replaceall(tm,"$source","result");
      if (GetFlag(n, "feature:new"))
        Replaceall(tm, "$owner", "1");
      else 
        Replaceall(tm, "$owner", "0");
      Printv(f->code,tm,"\n",NIL);
    }
    else {
      throw_unhandled_guile_type_error (d);
    }
    
    // Dump the argument output code
    Printv(f->code,outarg,NIL);
    
    // Dump the argument cleanup code
    Printv(f->code,cleanup,NIL);
    
    // Look for any remaining cleanup
    
    if (GetFlag(n,"feature:new")) {
      if ((tm = Swig_typemap_lookup_new("newfree",n,"result",0))) {
	Replaceall(tm,"$source","result");
	Printv(f->code,tm,"\n",NIL);
      }
    }
    
    // Free any memory allocated by the function being wrapped..
    if ((tm = Swig_typemap_lookup_new("ret",n,"result",0))) {
      Replaceall(tm,"$source","result");
      Printv(f->code,tm,"\n",NIL);
    }
    
    // Wrap things up (in a manner of speaking)
    
    if (beforereturn)
      Printv(f->code, beforereturn, "\n", NIL);
    Printv(f->code, "return gswig_result;\n", NIL);
    
    // Undefine the scheme name
    
    Printf(f->code, "#undef FUNC_NAME\n");
    Printf(f->code, "}\n");
    
    Wrapper_print (f, f_wrappers);
    
    if (!Getattr(n, "sym:overloaded")) {
    if (numargs > 10) {
      int i;
      /* gh_new_procedure would complain: too many args */
      /* Build a wrapper wrapper */
      Printv(f_wrappers, "static SCM\n", wname,"_rest (SCM rest)\n", NIL);
      Printv(f_wrappers, "{\n", NIL);
      Printf(f_wrappers, "SCM arg[%d];\n", numargs);
      Printf(f_wrappers, "SWIG_Guile_GetArgs (arg, rest, %d, %d, \"%s\");\n",
	     numreq, numargs-numreq, proc_name);
      Printv(f_wrappers, "return ", wname, "(", NIL);
      Printv(f_wrappers, "arg[0]", NIL);
      for (i = 1; i<numargs; i++)
	Printf(f_wrappers, ", arg[%d]", i);
      Printv(f_wrappers, ");\n", NIL);
      Printv(f_wrappers, "}\n", NIL);
      /* Register it */
      if (use_scm_interface) {
        Printf(f_init, "scm_c_define_gsubr(\"%s\", 0, 0, 1, (swig_guile_proc) %s_rest);\n",
            proc_name, wname);
      } else {
        Printf (f_init, "gh_new_procedure(\"%s\", (swig_guile_proc) %s_rest, 0, 0, 1);\n",
	        proc_name, wname, numreq, numargs-numreq);
      }
    }
    else if (emit_setters && struct_member && strlen(Char(proc_name))>3) {
      int len = Len(proc_name);
      const char *pc = Char(proc_name);
      /* MEMBER-set and MEMBER-get functions. */
      int is_setter = (pc[len - 3] == 's');
      if (is_setter) {
	Printf(f_init, "SCM setter = ");
	struct_member = 2; /* have a setter */
      }
      else Printf(f_init, "SCM getter = ");
      if (use_scm_interface) {
	/* GOOPS support uses the MEMBER-set and MEMBER-get functions,
	   so ignore only_setters in this case. */
	if (only_setters && !goops)
	  Printf(f_init, "scm_c_make_gsubr(\"%s\", %d, %d, 0, (swig_guile_proc) %s);\n",
		 proc_name, numreq, numargs-numreq, wname);
	else
	  Printf(f_init, "scm_c_define_gsubr(\"%s\", %d, %d, 0, (swig_guile_proc) %s);\n",
		 proc_name, numreq, numargs-numreq, wname);
      } else {
	if (only_setters && !goops)
	  Printf(f_init, "scm_make_gsubr(\"%s\", %d, %d, 0, (swig_guile_proc) %s);\n",
		 proc_name, numreq, numargs-numreq, wname);
	else
	  Printf (f_init, "gh_new_procedure(\"%s\", (swig_guile_proc) %s, %d, %d, 0);\n",
		  proc_name, wname, numreq, numargs-numreq);
      }
      if (!is_setter) {
	/* Strip off "-get" */
	char *pws_name = (char*) malloc(sizeof(char) * (len - 3));
	strncpy(pws_name, pc, len - 3);
	pws_name[len - 4] = 0;
	if (struct_member==2) { 
	  /* There was a setter, so create a procedure with setter */
          if (use_scm_interface) {
            Printf(f_init, "scm_c_define");
          } else {
            Printf(f_init, "gh_define");
          }
	  Printf (f_init, "(\"%s\", "
		  "scm_make_procedure_with_setter(getter, setter));\n",
		  pws_name);
	}
	else {
	  /* There was no setter, so make an alias to the getter */
          if (use_scm_interface) {
            Printf(f_init, "scm_c_define");
          } else {
            Printf(f_init, "gh_define");
          }
	  Printf (f_init, "(\"%s\", getter);\n",
		  pws_name);
	}
	Printf (exported_symbols, "\"%s\", ", pws_name);
	free(pws_name);
      }
    }
    else {
      /* Register the function */
      if (use_scm_interface) {
        if (exporting_destructor) {
          Printf(f_init, 
              "((swig_guile_clientdata *)(SWIGTYPE%s->clientdata))->destroy = (guile_destructor) %s;\n",
              swigtype_ptr, wname);
          //Printf(f_init, "SWIG_TypeClientData(SWIGTYPE%s, (void *) %s);\n", swigtype_ptr, wname);
        } 
	Printf(f_init, "scm_c_define_gsubr(\"%s\", %d, %d, 0, (swig_guile_proc) %s);\n",
	       proc_name, numreq, numargs-numreq, wname);
      } else {
      Printf (f_init, "gh_new_procedure(\"%s\", (swig_guile_proc) %s, %d, %d, 0);\n",
	      proc_name, wname, numreq, numargs-numreq);
      }
    }
    }
    else { /* overloaded function; don't export the single methods */
      if (!Getattr(n,"sym:nextSibling")) {
	/* Emit overloading dispatch function */

	int maxargs;
	String *dispatch = Swig_overload_dispatch(n,"return %s(argc,argv);",&maxargs);
	
	/* Generate a dispatch wrapper for all overloaded functions */

	Wrapper *df      = NewWrapper();
	String  *dname   = Swig_name_wrapper(iname);

	Printv(df->def,	
	       "static SCM\n", dname,
	       "(SCM rest)\n{\n",
	       NIL);
	Printf(df->code, "#define FUNC_NAME \"%s\"\n", proc_name);
	Printf(df->code, "SCM argv[%d];\n", maxargs);
	Printf(df->code, "int argc = SWIG_Guile_GetArgs (argv, rest, %d, %d, \"%s\");\n", 
	       0, maxargs, proc_name);
	Printv(df->code,dispatch,"\n",NIL);
	Printf(df->code,"scm_misc_error(\"%s\", \"No matching method for generic function `%s'\", SCM_EOL);\n", proc_name, iname);
	Printf(df->code, "#undef FUNC_NAME\n");
	Printv(df->code,"}\n",NIL);
	Wrapper_print(df,f_wrappers);
        if (use_scm_interface) {
          Printf(f_init, "scm_c_define_gsubr(\"%s\", 0, 0, 1, (swig_guile_proc) %s);\n",
               proc_name, dname);
        } else {
	  Printf(f_init, "gh_new_procedure(\"%s\", (swig_guile_proc) %s, 0, 0, 1);\n",
	       proc_name, dname);
        }
	DelWrapper(df);
	Delete(dispatch);
	Delete(dname);
      }
    }
    Printf (exported_symbols, "\"%s\", ", proc_name);

    if (!in_class || memberfunction_name) {
    // export wrapper into goops file
      String *method_def = NewString("");
      String *goops_name;
      if (in_class)
	goops_name = NewString(memberfunction_name);
      else
	goops_name = goopsNameMapping(proc_name, (char *)"");
      String *primitive_name = NewString("");
      if (primRenamer)
	Printv(primitive_name, "primitive:", proc_name, NIL);
      else
	Printv(primitive_name, proc_name, NIL);
      Replaceall(method_signature, "_", "-");
      Replaceall(primitive_args, "_", "-");
      if (!any_specialized_arg) {
	/* If there would not be any specialized argument in
	   the method declaration, we simply re-export the
	   function.  This is a performance optimization. */
	Printv(method_def, "(define ", goops_name, " ",
	       primitive_name, ")\n", NIL);
      }
      else if (numreq == numargs) {
	Printv(method_def, "(define-method (", goops_name, method_signature, ")\n", NIL);
	Printv(method_def, "  (", primitive_name, primitive_args, "))\n", NIL);	
      }
      else {
	/* Handle optional args. For the rest argument, use a name
	   that cannot clash.*/
	Printv(method_def, "(define-method (", goops_name, method_signature, " . %args)\n", NIL);
	Printv(method_def, "  (apply ", primitive_name, primitive_args, " %args))\n", NIL);
      }
      if (in_class) {
	/* Defer method definition till end of class definition. */
	Printv(goops_class_methods, method_def, NIL);
      }
      else {
	Printv(goopscode, method_def, NIL);
      }
      Printf(goopsexport, "%s ", goops_name);
      Delete(primitive_name);
      Delete(goops_name);
      Delete(method_def);
    }
    
    if (procdoc) {
      String *returns_text = NewString("");
      if (num_results == 0) Printv(returns_text, return_nothing_doc, NIL);
      else if (num_results == 1) Printv(returns_text, return_one_doc, NIL);
      else Printv(returns_text, return_multi_doc, NIL);
      /* Substitute documentation variables */
      static const char *numbers[] = {"zero", "one", "two", "three",
			       "four", "five", "six", "seven",
			       "eight", "nine", "ten", "eleven",
			       "twelve"};
      if (num_results <= 12)
	Replaceall(returns_text, "$num_values", numbers[num_results]);
      else {
	String *num_results_str = NewStringf("%d", num_results);
	Replaceall(returns_text, "$num_values", num_results_str);
	Delete(num_results_str);
      }
      Replaceall(returns_text, "$values", returns);
      Printf(doc_body, "\n%s", returns_text);
      write_doc(proc_name, signature, doc_body);
      Delete(returns_text);
    }
    
    Delete(proc_name);
    Delete(outarg);
    Delete(cleanup);
    Delete(signature);
    Delete(method_signature);
    Delete(primitive_args);
    Delete(doc_body);
    Delete(returns);
    Delete(tmp);
    Delete(scheme_arg_names);
    DelWrapper(f);
    return SWIG_OK;
  }
  
  /* ------------------------------------------------------------
   * variableWrapper()
   *
   * Create a link to a C variable.
   * This creates a single function PREFIX_var_VARNAME().
   * This function takes a single optional argument.   If supplied, it means
   * we are setting this variable to some value.  If omitted, it means we are
   * simply evaluating this variable.  Either way, we return the variables
   * value.
   * ------------------------------------------------------------ */

  virtual int variableWrapper(Node *n) {

    char *name  = GetChar(n,"name");
    char *iname = GetChar(n,"sym:name");
    SwigType *t = Getattr(n,"type");
    
    String *proc_name;
    char  var_name[256];
    Wrapper *f;
    String  *tm;
    
    if (!addSymbol(iname,n)) return SWIG_ERROR;
    
    f = NewWrapper();
    // evaluation function names
    
    strcpy(var_name, Char(Swig_name_wrapper(iname))); 
    
    // Build the name for scheme.
    proc_name = NewString(iname);
    Replaceall(proc_name,"_", "-");
    
    if (1 || (SwigType_type(t) != T_USER) || (is_a_pointer(t))) {
      
      Printf (f->def, "static SCM\n%s(SCM s_0)\n{\n", var_name);
      
      /* Define the scheme name in C. This define is used by several Guile
	 macros. */
      Printv(f->def, "#define FUNC_NAME \"", proc_name, "\"", NIL);
      
      Wrapper_add_local (f, "gswig_result", "SCM gswig_result");
      
      if (!GetFlag(n,"feature:immutable")) {
	/* Check for a setting of the variable value */
	Printf (f->code, "if (s_0 != SCM_UNDEFINED) {\n");
	if ((tm = Swig_typemap_lookup_new("varin",n,name,0))) {
	  Replaceall(tm,"$source","s_0");
	  Replaceall(tm,"$input","s_0");
	  Replaceall(tm,"$target",name);
	  Printv(f->code,tm,"\n",NIL);
	}
	else {
	  throw_unhandled_guile_type_error (t);
	}
	Printf (f->code, "}\n");
      }
      
      // Now return the value of the variable (regardless
      // of evaluating or setting)
      
      if ((tm = Swig_typemap_lookup_new("varout",n,name,0))) {
	Replaceall(tm,"$source",name);
	Replaceall(tm,"$target","gswig_result");
	Replaceall(tm,"$result", "gswig_result");
	Printv(f->code,tm,"\n",NIL);
      }
      else {
	throw_unhandled_guile_type_error (t);
      }
      Printf (f->code, "\nreturn gswig_result;\n");
      Printf (f->code, "#undef FUNC_NAME\n");
      Printf (f->code, "}\n");
      
      Wrapper_print (f, f_wrappers);
      
      // Now add symbol to the Guile interpreter
      
      if (!emit_setters
	  || GetFlag(n,"feature:immutable")) {
	/* Read-only variables become a simple procedure returning the
	   value; read-write variables become a simple procedure with
	   an optional argument. */
        if (use_scm_interface) {
          Printf(f_init, "scm_c_define_gsubr(\"%s\", 0, %d, 0, (swig_guile_proc) %s);\n",
                proc_name, !GetFlag(n, "feature:immutable"), var_name);
        } else {
          Printf (f_init, "\t gh_new_procedure(\"%s\", (swig_guile_proc) %s, 0, %d, 0);\n",
		proc_name, var_name, !GetFlag(n,"feature:immutable"));
        }
      }
      else {
	/* Read/write variables become a procedure with setter. */
        if (use_scm_interface) {
          Printf(f_init, "{ SCM p = scm_c_define_gsubr(\"%s\", 0, 1, 0, (swig_guile_proc) %s);\n",
                proc_name, var_name);
          Printf(f_init, "scm_c_define");
        } else {
          Printf (f_init, "\t{ SCM p = gh_new_procedure(\"%s\", (swig_guile_proc) %s, 0, 1, 0);\n",
		proc_name, var_name);
          Printf(f_init, "gh_define");
        }
	Printf (f_init, "(\"%s\", "
		"scm_make_procedure_with_setter(p, p)); }\n",
		proc_name);
      }
      Printf (exported_symbols, "\"%s\", ", proc_name);

      // export wrapper into goops file
      if (!in_class) {  // only if the variable is not part of a class
        String *class_name = SwigType_typedef_resolve_all(SwigType_base(t));
        String *goops_name = goopsNameMapping(proc_name, (char*)"");
	String *primitive_name = NewString("");
	if (primRenamer) 
	  Printv(primitive_name, "primitive:", NIL);
	Printv(primitive_name, proc_name, NIL);
	/* Simply re-export the procedure */
        Printv(goopscode, "(define ", goops_name, " ", primitive_name, ")\n", NIL);
        Printf(goopsexport, "%s ", goops_name);
	Delete(primitive_name);
        Delete(class_name);
        Delete(goops_name);
      }
      
      if (procdoc) {
	/* Compute documentation */
	String *signature = NewString("");
	String *signature2 = NULL;
	String *doc = NewString("");
	
	if (GetFlag(n,"feature:immutable")) {
	  Printv(signature, proc_name, NIL);
	  Printv(doc, "Returns constant ", NIL);
	  if ((tm = Getattr(n,"tmap:varout:doc"))) {
	    Printv(doc,tm,NIL);
	  } else {
	    String *s = SwigType_str(t,0);
	    Chop(s);
	    Printf(doc,"<%s>",s);
	    Delete(s);
	  }
	}
	else if (emit_setters) {
	  Printv(signature, proc_name, NIL);
	  signature2 = NewString("");
	  Printv(signature2, "set! (", proc_name, ") ", NIL);
	  handle_documentation_typemap(signature2, NIL, n, "tmap:varin:arglist",
				       "new-value");
	  Printv(doc, "Get or set the value of the C variable, \n", NIL);
	  Printv(doc, "which is of type ", NIL);
	  handle_documentation_typemap(doc, NIL, n, "tmap:varout:doc",
				       "$1_type");
	  Printv(doc, ".");
	}
	else {
	  Printv(signature, proc_name,
		 " #:optional ", NIL);
	  if ((tm = Getattr(n,"tmap:varin:doc"))) {
	    Printv(signature,tm,NIL);
	  } else {
	    String *s = SwigType_str(t,0);
	    Chop(s);
	    Printf(signature,"new-value <%s>",s);
	    Delete(s);
	  }
	  
	  Printv(doc, "If NEW-VALUE is provided, "
		 "set C variable to this value.\n", NIL);
	  Printv(doc, "Returns variable value ", NIL);
	  if ((tm = Getattr(n,"tmap:varout:doc"))) {
	    Printv(doc,tm,NIL);
	  } else {
	    String *s = SwigType_str(t,0);
	    Chop(s);
	    Printf(doc,"<%s>",s);
	    Delete(s);
	  }
	}
	write_doc(proc_name, signature, doc, signature2);
	Delete(signature);
	if (signature2) Delete(signature2);
	Delete(doc);
      }
      
    } else {
      Swig_warning(WARN_TYPEMAP_VAR_UNDEF, input_file, line_number,
		   "Unsupported variable type %s (ignored).\n", SwigType_str(t,0));
    }
    Delete(proc_name);
    DelWrapper(f);
    return SWIG_OK;
  }

  /* ------------------------------------------------------------
   * constantWrapper()
   *
   * We create a read-only variable.
   * ------------------------------------------------------------ */

  virtual int constantWrapper(Node *n) {
    char *name      = GetChar(n,"name");
    char *iname     = GetChar(n,"sym:name");
    SwigType *type  = Getattr(n,"type");
    String   *value = Getattr(n,"value");
    
    String *proc_name;
    char   var_name[256];
    String *rvalue;
    Wrapper *f;
    SwigType *nctype;
    String   *tm;
    
    f = NewWrapper();
    
    // Make a static variable;
    
    sprintf (var_name, "%sconst_%s", prefix, iname);
    
    // Strip const qualifier from type if present
    
    nctype = NewString(type);
    if (SwigType_isconst(nctype)) {
      Delete(SwigType_pop(nctype));
    }
    
    // Build the name for scheme.
    proc_name = NewString(iname);
    Replaceall(proc_name,"_", "-");
    
    if ((SwigType_type(nctype) == T_USER) && (!is_a_pointer(nctype))) {
      Swig_warning(WARN_TYPEMAP_CONST_UNDEF, input_file, line_number,
		   "Unsupported constant value.\n");
      return SWIG_NOWRAP;
    }
    
    // See if there's a typemap
    
    if (SwigType_type(nctype) == T_STRING) {
      rvalue = NewStringf("\"%s\"", value);
    } else if (SwigType_type(nctype) == T_CHAR) {
      rvalue = NewStringf("\'%s\'", value);
    } else {
      rvalue = NewString(value);
    }
    
    if ((tm = Swig_typemap_lookup_new("constant",n,name,0))) {
      Replaceall(tm,"$source",rvalue);
      Replaceall(tm,"$value",rvalue);
      Replaceall(tm,"$target",name);
      Printv(f_header,tm,"\n",NIL);
    } else {
      // Create variable and assign it a value
      Printf (f_header, "static %s = %s;\n", SwigType_lstr(nctype,var_name),
	      rvalue);
    }
    {
      /* Hack alert: will cleanup later -- Dave */
      Node *n = NewHash();
      Setattr(n,"name",var_name);
      Setattr(n,"sym:name",iname);
      Setattr(n,"type", nctype);
      SetFlag(n,"feature:immutable");
      variableWrapper(n);
      Delete(n);
    }
    Delete(nctype);
    Delete(proc_name);
    Delete(rvalue);
    DelWrapper(f);
    return SWIG_OK;
  }

  /* ------------------------------------------------------------
   * classDeclaration()
   * ------------------------------------------------------------ */
  virtual int classDeclaration(Node *n) {
    String *class_name = NewStringf("<%s>", Getattr(n, "sym:name"));
    Setattr(n, "guile:goopsclassname", class_name);
    return Language::classDeclaration(n);
  }

  /* ------------------------------------------------------------
   * classHandler()
   * ------------------------------------------------------------ */
  virtual int classHandler(Node *n) {
    /* Create new strings for building up a wrapper function */
    have_constructor = 0;
        
    class_name = NewString("");
    short_class_name = NewString("");
    Printv(class_name, "<", Getattr(n,"sym:name"), ">", NIL);
    Printv(short_class_name, Getattr(n,"sym:name"), NIL);
    Replaceall(class_name, "_", "-");
    Replaceall(short_class_name, "_", "-");
        
    if (!addSymbol(class_name,n)) return SWIG_ERROR;

    /* Handle inheritance */
    String *base_class = NewString("<");
    List *baselist = Getattr(n,"bases");
    if (baselist && Len(baselist)) {
      Iterator i = First(baselist);
      while (i.item) {
         Printv(base_class,Getattr(i.item, "sym:name"),NIL);
         i = Next(i);
         if (i.item) {
           Printf(base_class, "> <");
         }
      }
    }
    Printf(base_class, ">");
    Replaceall(base_class, "_", "-");

    Printv(goopscode,"(define-class ", class_name, " ", NIL);
    Printf(goopsexport, "%s ", class_name);

    if (Len(base_class) > 2) {
      Printv(goopscode,"(", base_class, ")\n", NIL);
    } else {
      Printv(goopscode,"(<swig>)\n", NIL);
    }
    SwigType *ct = NewStringf("p.%s", Getattr(n, "name"));
    swigtype_ptr = SwigType_manglestr(ct);

    String *mangled_classname = Swig_name_mangle(Getattr(n, "sym:name"));
    /* Export clientdata structure */
    if (use_scm_interface) {
      Printf(f_runtime, "static swig_guile_clientdata _swig_guile_clientdata%s = { NULL, SCM_EOL };\n", 
          mangled_classname);

      Printv(f_init, "SWIG_TypeClientData(SWIGTYPE", swigtype_ptr,
          ", (void *) &_swig_guile_clientdata", mangled_classname, ");\n", NIL);
      SwigType_remember(ct);
    }
    Delete(ct);

    /* Emit all of the members */
    goops_class_methods = NewString("");

    in_class = 1;
    Language::classHandler(n);
    in_class = 0;

    Printv(goopscode,"  #:metaclass <swig-metaclass>\n",NIL);
    
    if (have_constructor)
      Printv(goopscode,"  #:new-function ", primRenamer ? "primitive:" : "", 
                       "new-", short_class_name, "\n", NIL);
    
    Printf(goopscode,")\n%s\n", goops_class_methods);
    Delete(goops_class_methods);
    goops_class_methods = 0;


    /* export class initialization function */
    if (goops) {
      /* export the wrapper function */
      String *funcName = NewString(mangled_classname);
      Printf(funcName, "_swig_guile_setgoopsclass");
      String *guileFuncName = NewString(funcName);
      Replaceall(guileFuncName, "_", "-");

      Printv(f_wrappers, "static SCM ", funcName, "(SCM cl) \n", NIL);
      Printf(f_wrappers, "#define FUNC_NAME %s\n{\n", guileFuncName);
      Printv(f_wrappers, "  ((swig_guile_clientdata *)(SWIGTYPE", swigtype_ptr, 
          "->clientdata))->goops_class = cl;\n", NIL);
      Printf(f_wrappers, "  return SCM_UNSPECIFIED;\n");
      Printf(f_wrappers, "}\n#undef FUNC_NAME\n\n");

      Printf(f_init, "scm_c_define_gsubr(\"%s\", 1, 0, 0, (swig_guile_proc) %s);\n",
          guileFuncName, funcName);
      Printf(exported_symbols, "\"%s\", ", guileFuncName);

      /* export the call to the wrapper function */
      Printf(goopscode, "(%s%s %s)\n\n", primRenamer ? "primitive:" : "", guileFuncName, class_name);

      Delete(guileFuncName);
      Delete(funcName);
    }

    Delete(mangled_classname);

    Delete(swigtype_ptr);
    swigtype_ptr = 0;

    Delete(class_name);
    Delete(short_class_name);
    class_name = 0;
    short_class_name = 0;

    return SWIG_OK;
  }

  /* ------------------------------------------------------------
   * memberfunctionHandler()
   * ------------------------------------------------------------ */
  int memberfunctionHandler(Node *n) {
    String *iname = Getattr(n,"sym:name");
    String *proc = NewString(iname);
    Replaceall(proc,"_", "-");

    memberfunction_name = goopsNameMapping(proc, short_class_name);
    Language::memberfunctionHandler(n);
    Delete(memberfunction_name);
    memberfunction_name = NULL;
    Delete(proc);
    return SWIG_OK;
  }

  /* ------------------------------------------------------------
   * membervariableHandler()
   * ------------------------------------------------------------ */
  int membervariableHandler(Node *n)
  {
    String *iname = Getattr(n,"sym:name");

    if (emit_setters) {
      struct_member = 1;
      Printf(f_init, "{\n");
    }

    Language::membervariableHandler(n);

    if (emit_setters) {
      Printf(f_init, "}\n");
      struct_member = 0;
    }

    String *proc = NewString(iname);
    Replaceall(proc,"_", "-");
    String *goops_name = goopsNameMapping(proc, short_class_name);

    /* The slot name is never qualified with the class,
       even if useclassprefix is true. */
    Printv(goopscode, "  (", proc, " #:allocation #:virtual", NIL);
    /* GOOPS (at least in Guile 1.6.3) only accepts closures, not
       primitive procedures for slot-ref and slot-set. */
    Printv(goopscode, "\n   #:slot-ref (lambda (obj) (",
	   primRenamer ? "primitive:" : "", 
	   short_class_name, "-", proc, "-get", " obj))", NIL);
    if (!GetFlag(n,"feature:immutable")) {
      Printv(goopscode, "\n   #:slot-set! (lambda (obj value) (",
	     primRenamer ? "primitive:" : "", 
	     short_class_name, "-", proc, "-set", " obj value))", NIL);
    } else {
      Printf(goopscode, "\n   #:slot-set! (lambda (obj value) (error \"Immutable slot\"))");
    }
    if (emit_slot_accessors) {
      if (GetFlag(n, "feature:immutable")) {
        Printv(goopscode, "\n   #:getter ", goops_name, NIL);
      } else {
        Printv(goopscode, "\n   #:accessor ", goops_name, NIL);
      }
      Printf(goopsexport, "%s ", goops_name);
    }
    Printv(goopscode, ")\n", NIL);
    Delete(proc);
    Delete(goops_name);
    return SWIG_OK;
  }

  /* ------------------------------------------------------------
   * constructorHandler()
   * ------------------------------------------------------------ */
  int constructorHandler(Node *n) {
    Language::constructorHandler(n);
    have_constructor = 1;
    return SWIG_OK;
  }

  /* ------------------------------------------------------------
   * destructorHandler()
   * ------------------------------------------------------------ */
  virtual int destructorHandler(Node *n) {
    exporting_destructor = true;
    Language::destructorHandler(n);
    exporting_destructor = false;
    return SWIG_OK;
  }

  /* ------------------------------------------------------------
   * pragmaDirective()
   * ------------------------------------------------------------ */

  virtual int pragmaDirective(Node *n)
  {
    if (!ImportMode) {
      String *lang = Getattr(n,"lang");
      String *cmd = Getattr(n,"name");
      String *value = Getattr(n,"value");
      
#     define store_pragma(PRAGMANAME)			\
        if (Strcmp(cmd, #PRAGMANAME) == 0) {		\
	  if (PRAGMANAME) Delete(PRAGMANAME);		\
	  PRAGMANAME = value ? NewString(value) : NULL;	\
	}
      
      if (Strcmp(lang,"guile") == 0) {
	store_pragma(beforereturn)
	  store_pragma(return_nothing_doc)
	  store_pragma(return_one_doc)
	  store_pragma(return_multi_doc);
#     undef store_pragma
      }
    }
    return Language::pragmaDirective(n);
  }

  
  /* ------------------------------------------------------------
   * goopsNameMapping()
   * Maps the identifier from C++ to the GOOPS based * on command 
   * line paramaters and such.
   * If class_name = "" that means the mapping is for a function or
   * variable not attached to any class.
   * ------------------------------------------------------------ */
  String *goopsNameMapping(String *name, String_or_char *class_name) {
    String *n = NewString("");
    
    if (Strcmp(class_name, "") == 0) {
      // not part of a class, so no class name to prefix
      if (goopsprefix) {
        Printf(n, "%s%s", goopsprefix, name);
      } else {
        Printf(n, "%s", name);
      }
    } else {
      if (useclassprefix) {
        Printf(n, "%s-%s", class_name, name);
      } else {
        if (goopsprefix) {
          Printf(n, "%s%s", goopsprefix, name);
        } else {
          Printf(n, "%s", name);
        }
      }
    }
    return n;
  }


  /* ------------------------------------------------------------
   * validIdentifier()
   * ------------------------------------------------------------ */

  virtual int validIdentifier(String *s) {
    char *c = Char(s);
    /* Check whether we have an R5RS identifier.  Guile supports a
       superset of R5RS identifiers, but it's probably a bad idea to use
       those. */
    /* <identifier> --> <initial> <subsequent>* | <peculiar identifier> */
    /* <initial> --> <letter> | <special initial> */
    if (!(isalpha(*c) || (*c == '!') || (*c == '$') || (*c == '%')
	  || (*c == '&') || (*c == '*') || (*c == '/') || (*c == ':')
	  || (*c == '<') || (*c == '=') || (*c == '>') || (*c == '?')
	  || (*c == '^') || (*c == '_') || (*c == '~'))) {
      /* <peculiar identifier> --> + | - | ... */
      if ((strcmp(c, "+") == 0)
	  || strcmp(c, "-") == 0
	  || strcmp(c, "...") == 0) return 1;
      else return 0;
    }
    /* <subsequent> --> <initial> | <digit> | <special subsequent> */
    while (*c) {
      if (!(isalnum(*c) || (*c == '!') || (*c == '$') || (*c == '%')
	    || (*c == '&') || (*c == '*') || (*c == '/') || (*c == ':')
	    || (*c == '<') || (*c == '=') || (*c == '>') || (*c == '?')
	    || (*c == '^') || (*c == '_') || (*c == '~') || (*c == '+')
	    || (*c == '-') || (*c == '.') || (*c == '@'))) return 0;
      c++;
    }
    return 1;
  }

  String *runtimeCode() {
    String *s;
    if (use_scm_interface) {
      s = Swig_include_sys("guile_scm_run.swg");
      if (!s) {
        Printf(stderr, "*** Unable to open 'guile_scm_run.swg");
        s = NewString("");
      }
    } else {
      s = Swig_include_sys("guile_gh_run.swg");
      if (!s) {
        Printf(stderr, "*** Unable to open 'guile_gh_run.swg");
        s = NewString("");
      }
    }
    return s;
  }

  String *defaultExternalRuntimeFilename() {
    if (use_scm_interface) {
      return NewString("swigguilerun.h");
    } else {
      return NewString("swigguileghrun.h");
    }
  }
};

/* -----------------------------------------------------------------------------
 * swig_guile()    - Instantiate module
 * ----------------------------------------------------------------------------- */

static Language * new_swig_guile() {
  return new GUILE();
}
extern "C" Language * swig_guile(void) {
  return new_swig_guile();
}