wxPython Merge #2 of 2.4 branch --> HEAD (branch tag: wxPy_2_4_merge_2)

[wxWidgets.git] / wxPython / wxSWIG / Modules / guile.cxx

/*******************************************************************************
 * Simplified Wrapper and Interface Generator  (SWIG)
 * 
 * Author : David Beazley
 *
 * Department of Computer Science        
 * University of Chicago
 * 1100 E 58th Street
 * Chicago, IL  60637
 * beazley@cs.uchicago.edu
 *
 * Please read the file LICENSE for the copyright and terms by which SWIG
 * can be used and distributed.
 *******************************************************************************/

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

#include "swig.h"
#include "guile.h"

static char *guile_usage = "\
Guile Options (available with -guile)\n\
     None available. \n\n";     

// ---------------------------------------------------------------------
// GUILE::parse_args(int argc, char *argv[])
//
// Parse arguments.
// ---------------------------------------------------------------------

void GUILE::parse_args(int argc, char *argv[]) {

  int i;
  
  sprintf(LibDir,"%s",guile_path);

  // Look for certain command line options

  // Look for additional command line options.
  for (i = 1; i < argc; i++) {  
      if (argv[i]) {
          if (strcmp(argv[i],"-help") == 0) {
            fputs(guile_usage,stderr);
            SWIG_exit(0);
          }
      }
  }
  // Add a symbol for this module

  add_symbol("SWIGGUILE",0,0);

  // Set name of typemaps

  typemap_lang = "guile";

}

// --------------------------------------------------------------------
// GUILE::parse()
//
// Parse the input file
// --------------------------------------------------------------------

void GUILE::parse()
{

  printf("Generating wrappers for Guile\n");

  // Print out GUILE specific headers
  
  headers();
  
  // Run the parser
  
  yyparse();

}

// ---------------------------------------------------------------------
// GUILE::set_module(char *mod_name)
//
// Sets the module name.
// Does nothing if it's already set (so it can be overridden as a command
// line option).
//
//----------------------------------------------------------------------

void GUILE::set_module(char *mod_name, char **) {

  if (module) return;
  
  module = new char[strlen(mod_name)+1];
  strcpy(module,mod_name);

}

// ---------------------------------------------------------------------
// GUILE::set_init(char *iname)
//
// Sets the initialization function name.
// Does nothing if it's already set
//
//----------------------------------------------------------------------

void GUILE::set_init(char *iname) {
  set_module(iname,0);
}

// ---------------------------------------------------------------------
// GUILE::headers(void)
//
// Generate the appropriate header files for GUILE interface.
// ----------------------------------------------------------------------

void GUILE::headers(void)
{

  emit_banner(f_header);

  fprintf(f_header,"/* Implementation : GUILE */\n\n");
  fprintf(f_header,"#define SWIGGUILE\n");
  fprintf(f_header,"#include <stdio.h>\n");
  fprintf(f_header,"#include <string.h>\n");
  fprintf(f_header,"#include <stdlib.h>\n");

  // Write out hex conversion functions

  if (!NoInclude) {
      if (insert_file("guile.swg", f_header) == -1) {
          fprintf(stderr,"SWIG : Fatal error.  Unable to locate 'guile.swg' in SWIG library.\n");
          SWIG_exit(1);
      }
      emit_hex(f_header);
  } else {
    fprintf(f_header,"#ifdef __cplusplus\n");
    fprintf(f_header,"extern \"C\" {\n");
    fprintf(f_header,"#endif\n");
    fprintf(f_header,"extern void SWIG_MakePtr(char *, void *, char *);\n");
    fprintf(f_header,"extern void SWIG_RegisterMapping(char *, char *, void *(*)(void *));\n");
    fprintf(f_header,"extern char *SWIG_GetPtr(char *, void **, char *);\n");
    fprintf(f_header,"#ifdef __cplusplus\n");
    fprintf(f_header,"}\n");
    fprintf(f_header,"#endif\n");
  }
}

// --------------------------------------------------------------------
// GUILE::initialize()
//
// Output initialization code that registers functions with the
// interface.
// ---------------------------------------------------------------------
void GUILE::initialize()
{

  int i;
        
  if (!module) {
    module = "swig_init";
    fprintf(stderr,"SWIG : *** Warning. No module name specified.\n");
  }
  
  fprintf(f_header,"#define SWIG_init    %s\n\n", module);
  fprintf(f_init,"void %s() {\n", module);

  if (InitNames) {
    i = 0;
    while (InitNames[i]) {
      fprintf(f_init,"\t %s();\n",InitNames[i]);
      i++;
    }
  }
}

// ---------------------------------------------------------------------
// GUILE::close(void)
//
// Wrap things up.  Close initialization function.
// ---------------------------------------------------------------------

void GUILE::close(void)
{

  emit_ptr_equivalence(f_init);
  fprintf(f_init,"}\n");

}

// ----------------------------------------------------------------------
// GUILE::get_pointer(int parm, DataType *t)
//
// Emits code to get a pointer from a parameter and do type checking.
// parm is the parameter number.   This function is only used
// in create_function().
// ----------------------------------------------------------------------

void GUILE::get_pointer(char *iname, int parm, DataType *t) {

  // Pointers are read as hex-strings with encoded type information
  fprintf(f_wrappers,"\t _tempc = gh_scm2newstr(s_%d, &_len);\n",parm);
  fprintf(f_wrappers,"\t if (SWIG_GetPtr(_tempc, (void **) &_arg%d,",parm);
  if (t->type == T_VOID) fprintf(f_wrappers,"(char *) 0)) {\n");
  else 
    fprintf(f_wrappers,"\"%s\")) {\n", t->print_mangle());

  // Now emit code according to the level of strictness desired

  switch(TypeStrict) {
  case 0: // No type checking
    fprintf(f_wrappers,"\t}\n");
    break;
  case 1: // Warning message only
    fprintf(f_wrappers,
      "\t fprintf(stderr,\"Warning : type mismatch in argument %d of %s. Expected %s, received %%s\\n\", _tempc);\n", parm+1,iname, t->print_mangle());
    fprintf(f_wrappers,"\t }\n");
    break;
  case 2: // Super strict mode.

//    fprintf(f_wrappers,"\t\t gscm_error(\"Type error in argument %d of %s. Expected %s.\", s_%d);\n", parm+1,iname,t->print_mangle(),parm);
    fprintf(f_wrappers,"\t}\n");
    break;

  default :
    fprintf(stderr,"Unknown strictness level\n");
    break;
  }
}

// ----------------------------------------------------------------------
// GUILE::create_function(char *name, char *iname, DataType *d,
//                             ParmList *l)
//
// Create a function declaration and register it with the interpreter.
// ----------------------------------------------------------------------

void GUILE::create_function(char *name, char *iname, DataType *d, ParmList *l)
{

  Parm *p;
  int   pcount;
  char  wname[256];
  char  source[64];
  char  target[64];
  char  *tm;
  String cleanup;
  int need_len = 0;
  int need_tempc = 0;

  // Make a wrapper name for this

  strcpy(wname,iname);
  make_wrap_name(wname);

  // Now write the wrapper function itself....this is pretty ugly

  fprintf(f_wrappers,"SCM _wrap_gscm_%s(",wname);

  int i = 0;
  p = l->get_first();
  while (p != 0) {
    if (p->t->is_pointer)
      need_len = 1;
    if ((p->t->type != T_CHAR) && (p->t->is_pointer))
      need_tempc = 1;

    if ((p->t->type != T_VOID) || (p->t->is_pointer))
      fprintf(f_wrappers,"SCM s_%d", i);
    if ((p = l->get_next()))
       fprintf(f_wrappers,", ");
    i++;
  }
  fprintf(f_wrappers,")\n{\n");

  // Declare return variable and arguments

  pcount = emit_args(d,l,f_wrappers);
  
  // Now declare a few helper variables here
  if (d->is_pointer && (d->type != T_CHAR) && 
      !typemap_lookup("out","guile",d,name,"_result","scmresult"))
    fprintf(f_wrappers,"  char _ptemp[128];\n");
  if (need_tempc)
    fprintf(f_wrappers,"  char *_tempc;\n");
  if (need_len)
    fprintf(f_wrappers,"  int _len;\n");
  fprintf(f_wrappers,"  SCM scmresult;  /* fun1 */\n");

  // Now write code to extract the parameters(this is super ugly)

  i = 0;
  p = l->get_first();
  while (p != 0) {
    // Produce names of source and target
    sprintf(source,"s_%d",i);
    sprintf(target,"_arg%d",i);

    if ((tm = typemap_lookup("in","guile",p->t,p->name,source,target))) {
      // Yep.  Use it instead of the default
      fprintf(f_wrappers,"%s\n", tm);
    } else {
      if (!p->t->is_pointer) {
        switch(p->t->type) {

          // Signed Integers
          
        case T_INT :
        case T_SINT :
        case T_SHORT:
        case T_SSHORT:
        case T_LONG:
        case T_SLONG:
        case T_SCHAR:
          fprintf(f_wrappers,"\t _arg%d = %s gh_scm2long(s_%d);\n",i, p->t->print_cast(), i);
          break;
          
          // Unsigned Integers
          
        case T_UINT:
        case T_USHORT:
        case T_ULONG:
        case T_UCHAR:
          fprintf(f_wrappers,"\t _arg%d = %s gh_scm2ulong(s_%d);\n", i, p->t->print_cast(), i);
          break;
          
          // A single character
          
        case T_CHAR :
          fprintf(f_wrappers,"\t _arg%d = %s gh_scm2char(s_%d);\n", i, p->t->print_cast(), i);
          break;
          
          // Floating point
          
        case T_DOUBLE :
        case T_FLOAT:
          fprintf(f_wrappers,"\t _arg%d = %s gh_scm2double(s_%d);\n", i, p->t->print_cast(), i);
          break;
          
          // Void.. Do nothing.
          
        case T_VOID :
          break;
          
          // This is some sort of user-defined call by value type.   We're
          // going to try and wing it here....
          
        case T_USER:
          
          // User defined type not allowed by value.
          
        default :
          fprintf(stderr,"%s : Line %d. Unable to use type %s as a function argument.\n",
                  input_file, line_number, p->t->print_type());
          break;
        }
      } else {
        
        // Argument is a pointer type.   Special case is for char *
        // since that is usually a string.
        
        if ((p->t->type == T_CHAR) && (p->t->is_pointer == 1)) {
          fprintf(f_wrappers,"\t _arg%d = gh_scm2newstr(s_%d, &_len);\n",i,i);
        } else {
          
          // Have a generic pointer type here.    
          
          get_pointer(iname, i, p->t);
        }
      }
    }
    if ((tm = typemap_lookup("check","guile",p->t,p->name,source,target))) {
      // Yep.  Use it instead of the default
      fprintf(f_wrappers,"%s\n",tm);
    }
    if ((tm = typemap_lookup("freearg","guile",p->t,p->name,target,"scmresult"))) {
      // Yep.  Use it instead of the default
      cleanup << tm << "\n";
    }
    p = l->get_next();
    i++;
  }

  // Now write code to make the function call

  fprintf(f_wrappers,"\t SCM_DEFER_INTS;\n");
  emit_func_call(name,d,l,f_wrappers);

  fprintf(f_wrappers,"\t SCM_ALLOW_INTS;\n");
  // Now have return value, figure out what to do with it.

  if ((d->type != T_VOID) || (d->is_pointer)) {
    if ((tm = typemap_lookup("out","guile",d,name,"_result","scmresult"))) {
      // Yep.  Use it instead of the default
      fprintf(f_wrappers,"%s\n",tm);
    } else {
      if (!d->is_pointer) {
        switch(d->type) {
        case T_INT:  case T_SINT:
        case T_SHORT: case T_SSHORT:
        case T_LONG: case T_SLONG:
        case T_SCHAR:
          fprintf(f_wrappers,"\t scmresult = gh_long2scm((long) _result);\n");
          break;
        case T_UINT:
        case T_USHORT:
        case T_ULONG:
        case T_UCHAR:
          fprintf(f_wrappers,"\t scmresult = gh_ulong2scm((unsigned long) _result);\n");
          break;
        case T_DOUBLE :
        case T_FLOAT:
          fprintf(f_wrappers,"\t scmresult = gh_double2scm((double) _result);\n");
          break;
        case T_CHAR :
          fprintf(f_wrappers,"\t scmresult = gh_char2scm(_result);\n");
          break;
        default:
          fprintf(stderr,"%s : Line %d: Unable to use return type %s in function %s.\n",
                  input_file, line_number, d->print_type(), name);
          break;
        }
      } else {
        
        // Is a pointer return type
        
        if ((d->type == T_CHAR) && (d->is_pointer == 1)) {
          fprintf(f_wrappers,"\t scmresult = gh_str02scm(_result);\n");
        } else {
          
          // Is an ordinary pointer type.
          
          fprintf(f_wrappers,"\t  SWIG_MakePtr(_ptemp, _result,\"%s\");\n",
                  d->print_mangle());
          fprintf(f_wrappers,"\t scmresult = gh_str02scm(_ptemp);\n");
        }
      }
    }
  } else {
    /* Some void type.   Need to return something.  I'll return 1 */
    fprintf(f_wrappers,"\t scmresult = gh_int2scm(1);\n");
  }

  // Dump the argument cleanup code
  fprintf(f_wrappers,"%s\n",cleanup.get());

  // Look for any remaining cleanup

  if (NewObject) {
    if ((tm = typemap_lookup("newfree","guile",d,iname,"_result",""))) {
      fprintf(f_wrappers,"%s\n",tm);
    }
  }

  if ((tm = typemap_lookup("ret","guile",d,name,"_result",""))) {
    // Yep.  Use it instead of the default
    fprintf(f_wrappers,"%s\n",tm);
  }
  
  // Wrap things up (in a manner of speaking)
  
  fprintf(f_wrappers,"\t return scmresult;\n");
  fprintf(f_wrappers,"}\n");

  // Now register the function
  fprintf(f_init,"\t gh_new_procedure(\"%s\", _wrap_gscm_%s, %d, 0, 0);\n", 
          iname, wname, pcount);

  // Make a documentation entry for this

  if (doc_entry) {
    static DocEntry *last_doc_entry = 0;
    char *usage = 0;
    usage_func(iname,d,l,&usage);
    doc_entry->usage << usage;
    if (last_doc_entry != doc_entry) {
      doc_entry->cinfo << "returns " << d->print_type();
      last_doc_entry = doc_entry;
    }
    delete usage;
  }
}

// -----------------------------------------------------------------------
// GUILE::link_variable(char *name, char *iname, DataType *d)
//
// Create a link to a C variable.
// This creates a single function _wrap_gscm_var_varname().
// This function takes a single optional argument.   If supplied, it means
// we are setting this variable to some value.  If ommitted, it means we are
// simply evaluating this variable.  Either way, we return the variables
// value.
// -----------------------------------------------------------------------

void GUILE::link_variable(char *name, char *iname, DataType *t)
{

  char  var_name[256];
  char  *tm;
  char  *tm2 = typemap_lookup("varout","guile",t,name,name,"scmresult");

  // evaluation function names

  sprintf(var_name,"_wrap_gscm_var_%s",iname);

  if ((t->type != T_USER) || (t->is_pointer)) {

    fprintf(f_wrappers,"SCM %s(SCM s_0) {\n", var_name);

    if (!(Status & STAT_READONLY) && (t->is_pointer)) {
      fprintf(f_wrappers,"\t char *_temp;\n");
      fprintf(f_wrappers,"\t int  _len;\n");
    }

    if (tm2) {
      fprintf(f_wrappers,"\t char _ptemp[128];\n");
    }
    fprintf(f_wrappers,"\t SCM scmresult; /* fun2 */\n");

    // Check for a setting of the variable value

    fprintf(f_wrappers,"\t if (s_0 != GH_NOT_PASSED) {\n");
    
    // Yup. Extract the type from s_0 and set variable value 
    if (Status & STAT_READONLY) {
//      fprintf(f_wrappers,"\t\t gscm_error(\"Unable to set %s. Variable is read only.\", s_0);\n", iname);
    } else {
      if ((tm = typemap_lookup("varin","guile",t,name,"s_0",name))) {
        // Yep.  Use it instead of the default
        fprintf(f_wrappers,"%s\n",tm);
      } else {
        if (!t->is_pointer) {

          switch(t->type) {
            // Signed Integer
            
          case T_INT:  case T_SINT:
          case T_SHORT: case T_SSHORT:
          case T_LONG: case T_SLONG:
          case T_SCHAR:
            fprintf(f_wrappers,"\t\t %s = %s gh_scm2long(s_0);\n",name, t->print_cast());
            break;
            
            // Unsigned integer
            
          case T_UINT:
          case T_USHORT:
          case T_ULONG:
          case T_UCHAR:
            fprintf(f_wrappers,"\t\t %s = %s gh_scm2ulong(s_0);\n",name, t->print_cast());
            break;
            
            // Floating point
            
          case T_FLOAT:
          case T_DOUBLE:
            fprintf(f_wrappers,"\t\t %s = %s gh_scm2double(s_0);\n",name, t->print_cast());
            break;
            
            // Character value
            
          case T_CHAR:
            fprintf(f_wrappers,"\t\t %s = gh_scm2char(s_0);\n", name);
            break;
            
            // Unknown value 
            
          default:
            fprintf(stderr,"Line %d.  Error, unsupported data-type.\n", line_number);
            break;
          }
        } else {
          
          // Have some sort of pointer type here, Process it differently
          
          if ((t->type == T_CHAR) && (t->is_pointer == 1)) {
            fprintf(f_wrappers,"\t\t _temp = gh_scm2newstr(s_0, &_len);\n");
            fprintf(f_wrappers,"\t\t if (%s) { free(%s);}\n", name,name);
            fprintf(f_wrappers,"\t\t %s = (char *) malloc((_len+1)*sizeof(char));\n",name);
            fprintf(f_wrappers,"\t\t strncpy(%s,_temp,_len);\n",name);
            fprintf(f_wrappers,"\t\t %s[_len] = 0;\n", name);
          } else {
            // Set the value of a pointer
            fprintf(f_wrappers,"\t\t _temp = gh_scm2newstr(s_0,&_len);\n");
            fprintf(f_wrappers,"\t if (SWIG_GetPtr(_temp, (void **) &%s,",name);
            if (t->type == T_VOID) fprintf(f_wrappers,"(char *) 0)) {\n");
            else 
              fprintf(f_wrappers,"\"%s\")) {\n", t->print_mangle());
            
            // Now emit code according to the level of strictness desired
            
            switch(TypeStrict) {
            case 0: // No type checking
              fprintf(f_wrappers,"\t}\n");
              break;
            case 1: // Warning message only
              fprintf(f_wrappers,
                      "\t fprintf(stderr,\"Warning : type mismatch in variable %s. Expected %s, received %%s\\n\", _temp);\n", name, t->print_mangle());
              fprintf(f_wrappers,"\t }\n");
              break;
            case 2: // Super strict mode.
              
//            fprintf(f_wrappers,"\t\t gscm_error(\"Type error in variable %s. Expected %s.\", s_0);\n", name,t->print_mangle());
              fprintf(f_wrappers,"\t}\n");
              break;
              
            default :
              fprintf(stderr,"Unknown strictness level\n");
              break;
            }
          }
        }
      }
    }
    fprintf(f_wrappers,"\t}\n");

    // Now return the value of the variable (regardless of evaluating or setting)

    if (tm2) {
      // Yep.  Use it instead of the default
      fprintf(f_wrappers,"%s\n",tm);
    } else {
      if (!t->is_pointer) {
        /* Return variable by value */
        
        switch(t->type) {
          
          // Signed Integer
          
        case T_INT: case T_SINT:
        case T_SHORT: case T_SSHORT:
        case T_LONG: case T_SLONG:
        case T_SCHAR:
          fprintf(f_wrappers,"\t scmresult = gh_long2scm((long) %s);\n", name);
          break;
          
          // Unsigned integer
          
        case T_UINT:
        case T_USHORT:
        case T_ULONG:
        case T_UCHAR:
          fprintf(f_wrappers,"\t scmresult = gh_ulong2scm((unsigned long) %s);\n",name);
          break;
          
          // Floats
          
        case T_DOUBLE:
        case T_FLOAT:
          fprintf(f_wrappers,"\t scmresult = gh_double2scm((double) %s);\n", name);
          break;
        case T_CHAR:
          fprintf(f_wrappers,"\t scmresult = gh_char2scm(%s);\n",name);
          break;
        default :
          /* Unknown type */
          break;
        }
      } else {
        
        // Is a pointer return type
        
        if ((t->type == T_CHAR) && (t->is_pointer == 1)) {
          fprintf(f_wrappers,"\t scmresult = gh_str02scm(%s);\n",name);
        } else {
          // Is an ordinary pointer type.
          fprintf(f_wrappers,"\t  SWIG_MakePtr(_ptemp, %s,\"%s\");\n",name,
                  t->print_mangle());
          fprintf(f_wrappers,"\t scmresult = gh_str02scm(_ptemp);\n");
        }
      }
    }
    fprintf(f_wrappers,"\t return scmresult;\n");
    fprintf(f_wrappers,"}\n");
    
    // Now add symbol to the Guile interpreter
    
    fprintf(f_init,"\t gh_new_procedure(\"%s\", %s, 0, 1, 0);\n",iname, var_name);
    
  } else {
    fprintf(stderr,"%s : Line %d. ** Warning. Unable to link with type %s (ignored).\n",
            input_file, line_number, t->print_type());
  }

  // Add a documentation entry
  
  if (doc_entry) {
    char *usage = 0; 
    usage_var(iname,t,&usage);
    doc_entry->usage << usage;
    doc_entry->cinfo << "Global : " << t->print_type() << " " << name;
    delete usage;
  }

}

// -----------------------------------------------------------------------
// GUILE::declare_const(char *name, char *iname, DataType *type, char *value)
//
// Makes a constant.   Not sure how this is really supposed to work.
// I'm going to fake out SWIG and create a variable instead.
// ------------------------------------------------------------------------

void GUILE::declare_const(char *name, char *, DataType *type, char *value) {

  int OldStatus = Status;      // Save old status flags
  char   var_name[256];

  Status = STAT_READONLY;      // Enable readonly mode.

  // Make a static variable;

  sprintf(var_name,"_wrap_const_%s",name);

  if ((type->type == T_USER) && (!type->is_pointer)) {
    fprintf(stderr,"%s : Line %d.  Unsupported constant value.\n", input_file, line_number);
    return;
  }

  // Create variable and assign it a value

  fprintf(f_header,"static %s %s = ", type->print_type(), var_name);
  if ((type->type == T_CHAR) && (type->is_pointer <= 1)) {
    fprintf(f_header,"\"%s\";\n", value);
  } else {
    fprintf(f_header,"%s;\n", value);
  }

  // Now create a variable declaration

  link_variable(var_name, name, type);
  Status = OldStatus;

  if (doc_entry) {
    char *usage = 0;
    usage_const(name,type,value,&usage);
    doc_entry->usage = "";
    doc_entry->usage << usage;
    doc_entry->cinfo = "";
    doc_entry->cinfo << "Constant: " << type->print_type();
    delete usage;
  }

}

// ----------------------------------------------------------------------
// GUILE::usage_var(char *iname, DataType *t, char **s)
//
// Produces a usage string for a Guile variable.
// ----------------------------------------------------------------------

void GUILE::usage_var(char *iname, DataType *t, char **s) {

  char temp[1024], *c;

  sprintf(temp,"(%s)", iname);
  c = temp + strlen(temp);

  if (!((t->type != T_USER) || (t->is_pointer))) {
    sprintf(c," - unsupported");
  }

  if (*s == 0) 
    *s = new char[strlen(temp)+1];
  strcpy(*s,temp);
}

// ---------------------------------------------------------------------------
// GUILE::usage_func(char *iname, DataType *t, ParmList *l, char **s)
// 
// Produces a usage string for a function in Guile
// ---------------------------------------------------------------------------

void GUILE::usage_func(char *iname, DataType *, ParmList *l,
                        char **s) {

  char temp[1024];
  char *c;
  int  i;
  Parm  *p;

  sprintf(temp,"(%s ", iname);
  c = temp + strlen(temp);
  
  /* Now go through and print parameters */

  p = l->get_first();
  while (p != 0) {
    
    /* If parameter has been named, use that.   Otherwise, just print a type  */

    if ((p->t->type != T_VOID) || (p->t->is_pointer)) {
      if (strlen(p->name) > 0) {
        sprintf(c,"%s ",p->name);
        c += strlen(p->name)+1;
      }
      else {
        sprintf(c,"%s",p->t->name);
        c += strlen(p->t->name);
        if (p->t->is_pointer) {
          for (i = 0; i < (p->t->is_pointer-p->t->implicit_ptr); i++) {
            sprintf(c,"*");
            c++;
          }
        }
      }
    }
      p = l->get_next();
      if (p != 0) {
        sprintf(c," ");
        c++;
      }
  }
  sprintf(c,")");
  if (*s == 0) 
    *s = new char[strlen(temp)+1];
  strcpy(*s,temp);
}


// ----------------------------------------------------------------------
// GUILE::usage_const(char *iname, DataType *type, char *value, char **s)
//
// Produces a usage string for a Guile constant
// ----------------------------------------------------------------------

void GUILE::usage_const(char *iname, DataType *, char *value, char **s) {

  char temp[1024];

  sprintf(temp,"(%s %s)", iname, value);

  if (*s == 0) 
    *s = new char[strlen(temp)+1];
  strcpy(*s,temp);

}