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

Add GOOPS support, contributed by John Lenz.

Browse source 
git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk@5180 626c5289-ae23-0410-ae9c-e8d60b6d4f22
This commit is contained in:
Matthias Köppe 2003-10-05 11:27:20 +00:00
commit 4a30a92fb1
4 changed files with 586 additions and 62 deletions
Download patch file Download diff file Expand all files Collapse all files

22
SWIG/Doc/Manual/Guile.html
View file

@ -518,7 +518,8 @@ both getting and setting the value. For struct members, SWIG creates
two wrapper procedures <code>(<var>struct</var>-<var>member</var>-get
pointer)</code> and <code>(<var>struct-member</var>-set pointer value)</code>.
<p>If invoked with the command-line option <code>-emit-setters</code>,
<p>If invoked with the command-line option <code>-emit-setters</code>
(<em>recommended</em>),
SWIG will additionally create procedures with setters. For global
variables, the procedure-with-setter <code><var>variable</var></code>
is created, so you can use <code>(<var>variable</var>)</code> to get
@ -530,6 +531,12 @@ is created, so you can use <code>(<var>struct</var>-<var>member</var>
(<var>struct</var>-<var>member</var> <var>pointer</var>)
<var>value</var>)</code> to set it.
<p>If invoked with the command-line option <code>-only-setters</code>,
SWIG will <em>only</em> create procedures with setters, i.e., for
struct members, the procedures <code>(<var>struct</var>-<var>member</var>-get
pointer)</code> and <code>(<var>struct-member</var>-set pointer
value)</code> are <em>not</em> generated.
<a name="n20"></a><h2>14.10 GOOPS</h2>
<p>SWIG can also generate classes and generic functions for use with
Guile's Object-Oriented Programming System (GOOPS). GOOPS is a
@ -545,8 +552,11 @@ swig. This will export the GOOPS wrapper definitions into the
or module linkage.</p>
<p>The generated file will contain definitions of GOOPS classes mimicking the C++ class hierarchy.
If <code>-emit-setters</code> is also passed as an argument, then the generated file will contain
getter and accessors for all the slots in the classes and for global variables. The input class</p>
<p>Enabling GOOPS support implies <code>-emit-setters</code>.
<p>If <code>-emit-slot-accessors</code> is also passed as an argument,
then the generated file will contain accessor methods for all the
slots in the classes and for global variables. The input class</p>
<blockquote><pre> class Foo {
public:
Foo(int i) : a(i) {}
@ -556,7 +566,7 @@ getter and accessors for all the slots in the classes and for global variables.
};
Foo getFooPlus(int i) { return Foo(a + i); }
</pre></blockquote>
will produce (if <code>-emit-setters</code> is not passed as a parameter)
will produce (if <code>-emit-slot-accessors</code> is not passed as a parameter)
<blockquote><pre>(define-class &lt;Foo&gt; (&lt;swig&gt;)
(a #:allocation #:swig-virtual
#:slot-ref primitive:Foo-a-get
@ -574,7 +584,7 @@ will produce (if <code>-emit-setters</code> is not passed as a parameter)
(export &lt;Foo&gt; getMultBy getFooMultBy getFooPlus )
</pre></blockquote>
and will produce (if <code>-emit-setters</code> is passed as a parameter)
and will produce (if <code>-emit-slot-accessors</code> is passed as a parameter)
<blockquote><pre>(define-class &lt;Foo&gt; (&lt;swig&gt;)
(a #:allocation #:swig-virtual
#:slot-ref primitive:Foo-a-get
@ -662,7 +672,7 @@ the member functions will be called <code>Foo-getMultBy</code>. Also, if the
of all the wrapped functions and variables, and is located either in the _wrap.cxx file (with <code>-Linkage
module</code>) or in the scmstub file (if <code>-Linkage passive -scmstub</code>). The name of this
guile-module is the swig-module name (given on the command line with the -module argument or with the
%module directive) concatinated with the string "-primitive". For
%module directive) concatenated with the string "-primitive". For
example, if <code>%module Test</code> is set in the swig interface file, the name of the guile-module in
the scmstub or <code>-Linkage module</code> will be <code>Test-primitive</code>.
The string "primitive" can be changed by the <code>-primsuffix</code> swig

56
SWIG/Lib/guile/common.scm Normal file
View file

@ -0,0 +1,56 @@
;;;************************************************************************
;;;*common.scm
;;;*
;;;* This file contains generic SWIG GOOPS classes for generated
;;;* GOOPS file support
;;;*
;;;* Copyright (C) 2003 John Lenz (jelenz@wisc.edu)
;;;*
;;;* This file may be freely redistributed without license or fee provided
;;;* this copyright message remains intact.
;;;************************************************************************
(define-module (Swig common))
(use-modules (oop goops))
(define-class <swig-metaclass> (<class>)
(new-function #:init-value #f))
(define-method (compute-get-n-set (class <swig-metaclass>) s)
(case (slot-definition-allocation s)
((#:swig-virtual)
(list
;getter
(let ((func (get-keyword #:slot-ref (slot-definition-options s) #f)))
(lambda (x) (func (slot-ref x 'smob))))
;setter
(let ((func (get-keyword #:slot-set! (slot-definition-options s) #f)))
(lambda (x val) (func (slot-ref x 'smob) val)))))
((#:swig-virtual-class)
(list
;getter
(let ((func (get-keyword #:slot-ref (slot-definition-options s) #f))
(class (get-keyword #:class (slot-definition-options s) #f)))
(lambda (x) (make class #:init-smob (func (slot-ref x 'smob)))))
;setter
(let ((func (get-keyword #:slot-set! (slot-definition-options s) #f)))
(lambda (x val) (func (slot-ref x 'smob) (slot-ref val 'smob))))))
(else (next-method))))
(define-method (initialize (class <swig-metaclass>) initargs)
(slot-set! class 'new-function (get-keyword #:new-function initargs #f))
(next-method))
(define-class <swig> ()
(smob #:init-value #f)
#:metaclass <swig-metaclass>)
(define-method (initialize (obj <swig>) initargs)
(next-method)
(let ((arg (get-keyword #:init-smob initargs #f)))
(if arg
(slot-set! obj 'smob arg)
(slot-set! obj 'smob (apply (slot-ref (class-of obj) 'new-function)
(get-keyword #:args initargs '()))))))
(export <swig-metaclass> <swig>)

1
SWIG/Lib/guile/guile.i
View file

@ -2,6 +2,7 @@
/* Macro for inserting Scheme code into the stub */
#define %scheme %insert("scheme")
#define %goops %insert("goops")
/* Return-styles */
%pragma(guile) return_nothing_doc = "Returns unspecified."

569
SWIG/Source/Modules/guile.cxx
View file

@ -23,6 +23,11 @@ char cvsroot_guile_cxx[] = "$Header$";
* 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"
#ifndef MACSWIG
@ -32,26 +37,37 @@ char cvsroot_guile_cxx[] = "$Header$";
static const char *guile_usage = (char*)"\
Guile Options (available with -guile)\n\
-ldflags - Print runtime libraries to link with\n\
-prefix <name> - Use <name> as prefix [default \"gswig_\"]\n\
-package <name> - Set the path of the module to <name> [default NULL]\n\
-emit-setters - Emit procedures-with-setters for variables\n\
and structure slots.\n\
-procdoc <file> - Output procedure documentation to <file>\n\
-ldflags - Print runtime libraries to link with\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 `module']\n\
-scmstub <file> - Output Scheme <file> with module declaration and\n\
exports; only with `passive' and `simple' linkage\n\
-gh - Use the gh_ guile interface. (default) \n\
-scm - Use the scm guile interface. (guile >=1.6) \n\
\n\
When unspecified, the default <lstyle> is `simple'. For native Guile\n\
module linking (for Guile versions >=1.5.0), use `module'. Other\n\
<lstyle> values are: `passive' for passive linking (no C-level\n\
module-handling code), `ltdlmod' for Guile's old dynamic module\n\
convention (versions <= 1.4), or `hobbit' for hobbit modules.\n\
\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 <file> - 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, default) \n\
-scm - Use the scm Guile API. (Guile >= 1.6) \n\
-goops <file> - Export GOOPS class definitions to <file>\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;
@ -73,6 +89,10 @@ static enum {
static File *procdoc = 0;
static File *scmstub = 0;
static String *scmtext;
static File *goopsfile = 0;
static String *goopstext;
static String *goopscode;
static String *goopsexport;
static enum {
GUILE_1_4,
@ -80,8 +100,10 @@ static enum {
TEXINFO
} docformat = GUILE_1_4;
static int emit_setters = 0;
static int struct_member = 0;
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;
@ -94,6 +116,19 @@ static int use_scm_interface = 0;
static int exporting_destructor = 0;
static String *swigtype_ptr = 0;
/* GOOPS stuff */
static String *primsuffix = 0;
static Hash *known_classes = 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
class GUILE : public Language {
public:
@ -184,10 +219,22 @@ public:
Swig_mark_arg(i+1);
i++;
}
else if (strcmp (argv[i], "-emit-setters") == 0) {
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) {
if (argv[i + 1]) {
scmstub = NewFile(argv[i + 1], (char *) "w");
@ -198,6 +245,16 @@ public:
Swig_arg_error();
}
}
else if (strcmp (argv[i], "-goops") == 0) {
if (argv[i + 1]) {
goopsfile = NewFile(argv[i + 1], (char *) "w");
Swig_mark_arg (i);
Swig_mark_arg (i + 1);
i++;
} else {
Swig_arg_error();
}
}
else if (strcmp(argv[i], "-gh") == 0) {
use_scm_interface = 0;
Swig_mark_arg(i);
@ -206,9 +263,64 @@ public:
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 (goopsfile) {
if (linkage != GUILE_LSTYLE_PASSIVE && linkage != GUILE_LSTYLE_MODULE) {
Printf(stderr, "guile: GOOPS support requires passive or module linkage\n");
exit(1);
}
}
if (goopsfile) {
// -goops 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);
@ -254,6 +366,11 @@ public:
scmtext = NewString("");
Swig_register_filebyname("scheme", scmtext);
exported_symbols = NewString("");
goopstext = NewString("");
Swig_register_filebyname("goops", goopstext);
goopscode = NewString("");
goopsexport = NewString("");
known_classes = NewHash();
Printf(f_runtime, "/* -*- buffer-read-only: t -*- vi: set ro: */\n");
Swig_banner (f_runtime);
@ -288,7 +405,7 @@ public:
if (CPlusPlus) {
Printf(f_runtime, "\n}\n");
}
Language::top(n);
/* Close module */
@ -299,17 +416,20 @@ public:
Printf (f_init, "}\n\n");
Printf (f_init, "#ifdef __cplusplus\n}\n#endif\n");
char module_name[256];
String *module_name = NewString("");
if (!module)
sprintf(module_name, "swig");
Printv(module_name, "swig", NIL);
else {
if (package)
sprintf(module_name,"%s/%s", package,module);
Printf(module_name,"%s/%s", package, module);
else
strcpy(module_name,module);
Printv(module_name,module,NIL);
}
emit_linkage (module_name);
Delete(module_name);
if (procdoc) {
Delete(procdoc);
@ -319,7 +439,15 @@ public:
Delete(scmstub);
scmstub = NULL;
}
if (goopsfile) {
Delete(goopsfile);
goopsfile = NULL;
}
Delete(goopscode);
Delete(goopsexport);
Delete(goopstext);
Delete(known_classes);
/* Close all of the files */
Dump(f_header,f_runtime);
Dump(f_wrappers,f_runtime);
@ -332,7 +460,7 @@ public:
return SWIG_OK;
}
void emit_linkage (char *module_name) {
void emit_linkage (String *module_name) {
String *module_func = NewString("");
if (CPlusPlus) {
@ -340,6 +468,7 @@ public:
}
Printv(module_func,module_name,NIL);
if (goopsfile)
Replaceall(module_func,"-", "_");
switch (linkage) {
@ -389,6 +518,8 @@ public:
Printf (f_init, "SCM\n%s (void)\n{\n", module_func);
{
String *mod = NewString(module_name);
if (goopsfile)
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");
@ -419,6 +550,8 @@ public:
if (scmstub) {
/* Emit Scheme stub if requested */
String *mod = NewString(module_name);
if (goopsfile)
Printv(mod,"-",primsuffix,NIL);
Replaceall(mod, "/", " ");
Printf (scmstub, ";;; -*- buffer-read-only: t -*- vi: set ro: */\n");
Printf (scmstub, ";;; Automatically generated by SWIG; do not edit.\n\n");
@ -438,6 +571,30 @@ public:
Delete(ex);
}
}
if (goopsfile) {
String *mod = NewString(module_name);
Replaceall(mod, "/", " ");
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(module_func);
if (CPlusPlus) {
@ -807,11 +964,21 @@ public:
}
else Printf(f_init, "SCM getter = ");
if (use_scm_interface) {
Printf(f_init, "scm_c_define_gsubr(\"%s\", %d, %d, 0, (swig_guile_proc) %s);\n",
proc_name, numreq, numargs-numreq, wname);
/* GOOPS support uses the MEMBER-set and MEMBER-get functions,
so ignore only_setters in this case. */
if (only_setters && !goopsfile)
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 {
Printf (f_init, "gh_new_procedure(\"%s\", (swig_guile_proc) %s, %d, %d, 0);\n",
proc_name, wname, numreq, numargs-numreq);
if (only_setters && !goopsfile)
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" */
@ -894,6 +1061,32 @@ public:
}
}
Printf (exported_symbols, "\"%s\", ", proc_name);
// export wrapper into goops file
if (!in_class) { // only if function is not in a class
String *args = NewString("");
String *wrapargs = NewString("");
buildGoopsArguments(Getattr(n, "parms"), args, wrapargs);
String *pb = SwigType_typedef_resolve_all(SwigType_base(Getattr(n, "type")));
String *goops_name = goopsNameMapping(proc_name, (char *)"");
if (Getattr(known_classes, pb)) {
Printv(goopscode, "(define-method (", goops_name, args, ")\n", NIL);
Printv(goopscode, " (make <", pb, "> #:init-smob (", primRenamer ? "primitive:" : "", NIL);
Printv(goopscode, proc_name, wrapargs, ")))\n", NIL);
} else {
Printv(goopscode, "(define-method (", goops_name, args, ")\n", NIL);
Printv(goopscode, primRenamer ? " (primitive:" : " (", proc_name, wrapargs, "))\n", NIL);
}
Printf(goopsexport, "%s ", goops_name);
Delete(pb);
Delete(goops_name);
Delete(wrapargs);
Delete(args);
}
if (procdoc) {
String *returns_text = NewString("");
if (num_results == 0) Printv(returns_text, return_nothing_doc, NIL);
@ -1035,6 +1228,37 @@ public:
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);
if (Getattr(known_classes, class_name)) {
/* Create a procedure or p-w-s that handles the GOOPS object */
if (!Getattr(n, "feature:immutable")) {
Printv(goopscode, "(define ", goops_name, " (make-procedure-with-setter\n",
"\t(lambda () (make <", class_name, "> #:init-smob (", primitive_name, ")))\n",
"\t(lambda (new-value) (", primitive_name, " (slot-ref new-value 'smob))))\n",
NIL);
}
else {
Printv(goopscode, "(define (", goops_name, ")\n",
" (make <", class_name, "> #:init-smob (", primitive_name, ")))");
}
Printf(goopscode, "\n");
} else {
/* 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 */
@ -1184,24 +1408,246 @@ public:
return SWIG_OK;
}
/* ------------------------------------------------------------
* classDeclaration()
* ------------------------------------------------------------ */
virtual int classDeclaration(Node *n) {
Setattr(known_classes, Getattr(n, "sym:name"), n);
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 *t = NewStringf("p.%s", Getattr(n, "name"));
swigtype_ptr = SwigType_manglestr(t);
Delete(t);
/* 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;
Delete(swigtype_ptr);
swigtype_ptr = 0;
Delete(class_name);
Delete(short_class_name);
class_name = 0;
short_class_name = 0;
return SWIG_OK;
}
/* ------------------------------------------------------------
* buildGoopsArguments()
* The ParmList l is parsed and any argument types that are known
* classes are wrapped with a (slot-ref)
* ------------------------------------------------------------ */
void buildGoopsArguments(ParmList *l, String *args, String *wrapargs) {
Parm *p;
Node *search;
int i;
/* input arguments */
for (i=0, p=l; p; i++) {
while (checkAttribute(p,"tmap:in:numinputs","0")) {
if (Getattr(p, "tmap:in:next")) {
p = Getattr(p,"tmap:in:next");
} else {
break;
}
}
SwigType *pt = Getattr(p,"type");
String *pn = Getattr(p,"name");
SwigType *pb = SwigType_typedef_resolve_all(SwigType_base(pt));
if (strcmp("void", Char(pt)) != 0) {
/* do input conversion */
if ((search = Getattr(known_classes, pb))) {
Printv(wrapargs, " (slot-ref ", pn, " 'smob)", NIL);
Printv(args, " (", pn, " <", pb, ">)", NIL);
} else {
Printv(wrapargs, " ", pn, NIL);
Printv(args, " ", pn, NIL);
}
}
p = nextSibling(p);
}
Replaceall(args, "_", "-");
Replaceall(wrapargs, "_", "-");
}
/* ------------------------------------------------------------
* memberfunctionHandler()
* ------------------------------------------------------------ */
int memberfunctionHandler(Node *n) {
String *iname = Getattr(n,"sym:name");
SwigType *d = Getattr(n,"type");
String *args;
String *wrapargs;
args = NewString("");
wrapargs = NewString("");
buildGoopsArguments(Getattr(n, "parms"), args, wrapargs);
Language::memberfunctionHandler(n);
String *proc = NewString(iname);
Replaceall(proc,"_", "-");
String *pb = SwigType_typedef_resolve_all(SwigType_base(d));
String *goops_name = goopsNameMapping(proc, short_class_name);
if (Getattr(known_classes, pb)) {
Printv(goops_class_methods,
"(define-method (", goops_name, " (swig_smob ", class_name, ")", args, ")\n",
" (make <", pb, "> #:init-smob (", primRenamer ? "primitive:" : "", short_class_name, "-", proc,
" (slot-ref swig_smob 'smob)", wrapargs, ")))\n", NIL);
} else {
Printv(goops_class_methods,
"(define-method (", goops_name, " (swig_smob ", class_name, ")", args, ")\n",
primRenamer ? " (primitive:" : " (", short_class_name, "-", proc,
" (slot-ref swig_smob 'smob)", wrapargs, "))\n", NIL);
}
Printf(goopsexport, "%s ", goops_name);
Delete(pb);
Delete(goops_name);
Delete(wrapargs);
Delete(args);
Delete(proc);
return SWIG_OK;
}
/* ------------------------------------------------------------
* membervariableHandler()
* ------------------------------------------------------------ */
virtual int membervariableHandler(Node *n) {
int membervariableHandler(Node *n)
{
String *iname = Getattr(n,"sym:name");
String *search;
String *pb = SwigType_typedef_resolve_all(SwigType_base(Getattr(n, "type")));
if (emit_setters) {
struct_member = 1;
Printf(f_init, "{\n");
Language::membervariableHandler(n);
}
Language::membervariableHandler(n);
if (emit_setters) {
Printf(f_init, "}\n");
struct_member = 0;
}
else {
/* Only emit traditional VAR-get and VAR-set procedures */
Language::membervariableHandler(n);
bool class_found = false;
if ((search = Getattr(known_classes, pb))) {
class_found = true;
}
String *proc = NewString(iname);
Replaceall(proc,"_", "-");
String *goops_name = goopsNameMapping(proc, short_class_name);
Printv(goopscode, " (", goops_name, " #:allocation", NIL);
if (class_found) {
Printv(goopscode, " #:swig-virtual-class", NIL);
} else {
Printv(goopscode, " #:swig-virtual", NIL);
}
Printv(goopscode, " #:slot-ref ", primRenamer ? "primitive:" : "",
short_class_name, "-", proc, "-get", NIL);
if (!Getattr(n,"feature:immutable")) {
Printv(goopscode, " #:slot-set! ", primRenamer ? "primitive:" : "",
short_class_name, "-", proc, "-set", NIL);
}
if (class_found) {
Printv(goopscode, " #:class <", pb, ">", NIL);
}
if (emit_slot_accessors) {
if (Getattr(n, "feature:immutable")) {
Printv(goopscode, " #:getter ", goops_name, NIL);
} else {
Printv(goopscode, " #: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()
* ------------------------------------------------------------ */
@ -1230,25 +1676,36 @@ public:
return Language::pragmaDirective(n);
}
/* ------------------------------------------------------------
* destructorHandler()
* ------------------------------------------------------------ */
virtual int destructorHandler(Node *n) {
exporting_destructor = true;
Language::destructorHandler(n);
exporting_destructor = false;
return SWIG_OK;
}
virtual int classHandler(Node *n) {
SwigType *t = NewStringf("p.%s", Getattr(n, "name"));
swigtype_ptr = SwigType_manglestr(t);
Delete(t);
Language::classHandler(n);
Delete(swigtype_ptr);
swigtype_ptr = 0;
return SWIG_OK;
/* ------------------------------------------------------------
* 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;
}