]> git.saurik.com Git - wxWidgets.git/blame_incremental - wxPython/wxSWIG/Modules/guile.cxx
compilation error fix (trailing comma in an enum)
[wxWidgets.git] / wxPython / wxSWIG / Modules / guile.cxx
... / ...
CommitLineData
1/*******************************************************************************
2 * Simplified Wrapper and Interface Generator (SWIG)
3 *
4 * Author : David Beazley
5 *
6 * Department of Computer Science
7 * University of Chicago
8 * 1100 E 58th Street
9 * Chicago, IL 60637
10 * beazley@cs.uchicago.edu
11 *
12 * Please read the file LICENSE for the copyright and terms by which SWIG
13 * can be used and distributed.
14 *******************************************************************************/
15
16/***********************************************************************
17 * $Header$
18 *
19 * guile.cxx
20 *
21 * Definitions for adding functions to Guile 3.0
22 ***********************************************************************/
23
24#include "swig.h"
25#include "guile.h"
26
27static char *guile_usage = "\
28Guile Options (available with -guile)\n\
29 None available. \n\n";
30
31// ---------------------------------------------------------------------
32// GUILE::parse_args(int argc, char *argv[])
33//
34// Parse arguments.
35// ---------------------------------------------------------------------
36
37void GUILE::parse_args(int argc, char *argv[]) {
38
39 int i;
40
41 sprintf(LibDir,"%s",guile_path);
42
43 // Look for certain command line options
44
45 // Look for additional command line options.
46 for (i = 1; i < argc; i++) {
47 if (argv[i]) {
48 if (strcmp(argv[i],"-help") == 0) {
49 fputs(guile_usage,stderr);
50 SWIG_exit(0);
51 }
52 }
53 }
54 // Add a symbol for this module
55
56 add_symbol("SWIGGUILE",0,0);
57
58 // Set name of typemaps
59
60 typemap_lang = "guile";
61
62}
63
64// --------------------------------------------------------------------
65// GUILE::parse()
66//
67// Parse the input file
68// --------------------------------------------------------------------
69
70void GUILE::parse()
71{
72
73 printf("Generating wrappers for Guile\n");
74
75 // Print out GUILE specific headers
76
77 headers();
78
79 // Run the parser
80
81 yyparse();
82
83}
84
85// ---------------------------------------------------------------------
86// GUILE::set_module(char *mod_name)
87//
88// Sets the module name.
89// Does nothing if it's already set (so it can be overridden as a command
90// line option).
91//
92//----------------------------------------------------------------------
93
94void GUILE::set_module(char *mod_name, char **) {
95
96 if (module) return;
97
98 module = new char[strlen(mod_name)+1];
99 strcpy(module,mod_name);
100
101}
102
103// ---------------------------------------------------------------------
104// GUILE::set_init(char *iname)
105//
106// Sets the initialization function name.
107// Does nothing if it's already set
108//
109//----------------------------------------------------------------------
110
111void GUILE::set_init(char *iname) {
112 set_module(iname,0);
113}
114
115// ---------------------------------------------------------------------
116// GUILE::headers(void)
117//
118// Generate the appropriate header files for GUILE interface.
119// ----------------------------------------------------------------------
120
121void GUILE::headers(void)
122{
123
124 emit_banner(f_header);
125
126 fprintf(f_header,"/* Implementation : GUILE */\n\n");
127 fprintf(f_header,"#define SWIGGUILE\n");
128 fprintf(f_header,"#include <stdio.h>\n");
129 fprintf(f_header,"#include <string.h>\n");
130 fprintf(f_header,"#include <stdlib.h>\n");
131
132 // Write out hex conversion functions
133
134 if (!NoInclude) {
135 if (insert_file("guile.swg", f_header) == -1) {
136 fprintf(stderr,"SWIG : Fatal error. Unable to locate 'guile.swg' in SWIG library.\n");
137 SWIG_exit(1);
138 }
139 emit_hex(f_header);
140 } else {
141 fprintf(f_header,"#ifdef __cplusplus\n");
142 fprintf(f_header,"extern \"C\" {\n");
143 fprintf(f_header,"#endif\n");
144 fprintf(f_header,"extern void SWIG_MakePtr(char *, void *, char *);\n");
145 fprintf(f_header,"extern void SWIG_RegisterMapping(char *, char *, void *(*)(void *));\n");
146 fprintf(f_header,"extern char *SWIG_GetPtr(char *, void **, char *);\n");
147 fprintf(f_header,"#ifdef __cplusplus\n");
148 fprintf(f_header,"}\n");
149 fprintf(f_header,"#endif\n");
150 }
151}
152
153// --------------------------------------------------------------------
154// GUILE::initialize()
155//
156// Output initialization code that registers functions with the
157// interface.
158// ---------------------------------------------------------------------
159void GUILE::initialize()
160{
161
162 int i;
163
164 if (!module) {
165 module = "swig_init";
166 fprintf(stderr,"SWIG : *** Warning. No module name specified.\n");
167 }
168
169 fprintf(f_header,"#define SWIG_init %s\n\n", module);
170 fprintf(f_init,"void %s() {\n", module);
171
172 if (InitNames) {
173 i = 0;
174 while (InitNames[i]) {
175 fprintf(f_init,"\t %s();\n",InitNames[i]);
176 i++;
177 }
178 }
179}
180
181// ---------------------------------------------------------------------
182// GUILE::close(void)
183//
184// Wrap things up. Close initialization function.
185// ---------------------------------------------------------------------
186
187void GUILE::close(void)
188{
189
190 emit_ptr_equivalence(f_init);
191 fprintf(f_init,"}\n");
192
193}
194
195// ----------------------------------------------------------------------
196// GUILE::get_pointer(int parm, DataType *t)
197//
198// Emits code to get a pointer from a parameter and do type checking.
199// parm is the parameter number. This function is only used
200// in create_function().
201// ----------------------------------------------------------------------
202
203void GUILE::get_pointer(char *iname, int parm, DataType *t) {
204
205 // Pointers are read as hex-strings with encoded type information
206 fprintf(f_wrappers,"\t _tempc = gh_scm2newstr(s_%d, &_len);\n",parm);
207 fprintf(f_wrappers,"\t if (SWIG_GetPtr(_tempc, (void **) &_arg%d,",parm);
208 if (t->type == T_VOID) fprintf(f_wrappers,"(char *) 0)) {\n");
209 else
210 fprintf(f_wrappers,"\"%s\")) {\n", t->print_mangle());
211
212 // Now emit code according to the level of strictness desired
213
214 switch(TypeStrict) {
215 case 0: // No type checking
216 fprintf(f_wrappers,"\t}\n");
217 break;
218 case 1: // Warning message only
219 fprintf(f_wrappers,
220 "\t fprintf(stderr,\"Warning : type mismatch in argument %d of %s. Expected %s, received %%s\\n\", _tempc);\n", parm+1,iname, t->print_mangle());
221 fprintf(f_wrappers,"\t }\n");
222 break;
223 case 2: // Super strict mode.
224
225// 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);
226 fprintf(f_wrappers,"\t}\n");
227 break;
228
229 default :
230 fprintf(stderr,"Unknown strictness level\n");
231 break;
232 }
233}
234
235// ----------------------------------------------------------------------
236// GUILE::create_function(char *name, char *iname, DataType *d,
237// ParmList *l)
238//
239// Create a function declaration and register it with the interpreter.
240// ----------------------------------------------------------------------
241
242void GUILE::create_function(char *name, char *iname, DataType *d, ParmList *l)
243{
244
245 Parm *p;
246 int pcount;
247 char wname[256];
248 char source[64];
249 char target[64];
250 char *tm;
251 String cleanup;
252 int need_len = 0;
253 int need_tempc = 0;
254
255 // Make a wrapper name for this
256
257 strcpy(wname,iname);
258 make_wrap_name(wname);
259
260 // Now write the wrapper function itself....this is pretty ugly
261
262 fprintf(f_wrappers,"SCM _wrap_gscm_%s(",wname);
263
264 int i = 0;
265 p = l->get_first();
266 while (p != 0) {
267 if (p->t->is_pointer)
268 need_len = 1;
269 if ((p->t->type != T_CHAR) && (p->t->is_pointer))
270 need_tempc = 1;
271
272 if ((p->t->type != T_VOID) || (p->t->is_pointer))
273 fprintf(f_wrappers,"SCM s_%d", i);
274 if ((p = l->get_next()))
275 fprintf(f_wrappers,", ");
276 i++;
277 }
278 fprintf(f_wrappers,")\n{\n");
279
280 // Declare return variable and arguments
281
282 pcount = emit_args(d,l,f_wrappers);
283
284 // Now declare a few helper variables here
285 if (d->is_pointer && (d->type != T_CHAR) &&
286 !typemap_lookup("out","guile",d,name,"_result","scmresult"))
287 fprintf(f_wrappers," char _ptemp[128];\n");
288 if (need_tempc)
289 fprintf(f_wrappers," char *_tempc;\n");
290 if (need_len)
291 fprintf(f_wrappers," int _len;\n");
292 fprintf(f_wrappers," SCM scmresult; /* fun1 */\n");
293
294 // Now write code to extract the parameters(this is super ugly)
295
296 i = 0;
297 p = l->get_first();
298 while (p != 0) {
299 // Produce names of source and target
300 sprintf(source,"s_%d",i);
301 sprintf(target,"_arg%d",i);
302
303 if ((tm = typemap_lookup("in","guile",p->t,p->name,source,target))) {
304 // Yep. Use it instead of the default
305 fprintf(f_wrappers,"%s\n", tm);
306 } else {
307 if (!p->t->is_pointer) {
308 switch(p->t->type) {
309
310 // Signed Integers
311
312 case T_INT :
313 case T_SINT :
314 case T_SHORT:
315 case T_SSHORT:
316 case T_LONG:
317 case T_SLONG:
318 case T_SCHAR:
319 fprintf(f_wrappers,"\t _arg%d = %s gh_scm2long(s_%d);\n",i, p->t->print_cast(), i);
320 break;
321
322 // Unsigned Integers
323
324 case T_UINT:
325 case T_USHORT:
326 case T_ULONG:
327 case T_UCHAR:
328 fprintf(f_wrappers,"\t _arg%d = %s gh_scm2ulong(s_%d);\n", i, p->t->print_cast(), i);
329 break;
330
331 // A single character
332
333 case T_CHAR :
334 fprintf(f_wrappers,"\t _arg%d = %s gh_scm2char(s_%d);\n", i, p->t->print_cast(), i);
335 break;
336
337 // Floating point
338
339 case T_DOUBLE :
340 case T_FLOAT:
341 fprintf(f_wrappers,"\t _arg%d = %s gh_scm2double(s_%d);\n", i, p->t->print_cast(), i);
342 break;
343
344 // Void.. Do nothing.
345
346 case T_VOID :
347 break;
348
349 // This is some sort of user-defined call by value type. We're
350 // going to try and wing it here....
351
352 case T_USER:
353
354 // User defined type not allowed by value.
355
356 default :
357 fprintf(stderr,"%s : Line %d. Unable to use type %s as a function argument.\n",
358 input_file, line_number, p->t->print_type());
359 break;
360 }
361 } else {
362
363 // Argument is a pointer type. Special case is for char *
364 // since that is usually a string.
365
366 if ((p->t->type == T_CHAR) && (p->t->is_pointer == 1)) {
367 fprintf(f_wrappers,"\t _arg%d = gh_scm2newstr(s_%d, &_len);\n",i,i);
368 } else {
369
370 // Have a generic pointer type here.
371
372 get_pointer(iname, i, p->t);
373 }
374 }
375 }
376 if ((tm = typemap_lookup("check","guile",p->t,p->name,source,target))) {
377 // Yep. Use it instead of the default
378 fprintf(f_wrappers,"%s\n",tm);
379 }
380 if ((tm = typemap_lookup("freearg","guile",p->t,p->name,target,"scmresult"))) {
381 // Yep. Use it instead of the default
382 cleanup << tm << "\n";
383 }
384 p = l->get_next();
385 i++;
386 }
387
388 // Now write code to make the function call
389
390 fprintf(f_wrappers,"\t SCM_DEFER_INTS;\n");
391 emit_func_call(name,d,l,f_wrappers);
392
393 fprintf(f_wrappers,"\t SCM_ALLOW_INTS;\n");
394 // Now have return value, figure out what to do with it.
395
396 if ((d->type != T_VOID) || (d->is_pointer)) {
397 if ((tm = typemap_lookup("out","guile",d,name,"_result","scmresult"))) {
398 // Yep. Use it instead of the default
399 fprintf(f_wrappers,"%s\n",tm);
400 } else {
401 if (!d->is_pointer) {
402 switch(d->type) {
403 case T_INT: case T_SINT:
404 case T_SHORT: case T_SSHORT:
405 case T_LONG: case T_SLONG:
406 case T_SCHAR:
407 fprintf(f_wrappers,"\t scmresult = gh_long2scm((long) _result);\n");
408 break;
409 case T_UINT:
410 case T_USHORT:
411 case T_ULONG:
412 case T_UCHAR:
413 fprintf(f_wrappers,"\t scmresult = gh_ulong2scm((unsigned long) _result);\n");
414 break;
415 case T_DOUBLE :
416 case T_FLOAT:
417 fprintf(f_wrappers,"\t scmresult = gh_double2scm((double) _result);\n");
418 break;
419 case T_CHAR :
420 fprintf(f_wrappers,"\t scmresult = gh_char2scm(_result);\n");
421 break;
422 default:
423 fprintf(stderr,"%s : Line %d: Unable to use return type %s in function %s.\n",
424 input_file, line_number, d->print_type(), name);
425 break;
426 }
427 } else {
428
429 // Is a pointer return type
430
431 if ((d->type == T_CHAR) && (d->is_pointer == 1)) {
432 fprintf(f_wrappers,"\t scmresult = gh_str02scm(_result);\n");
433 } else {
434
435 // Is an ordinary pointer type.
436
437 fprintf(f_wrappers,"\t SWIG_MakePtr(_ptemp, _result,\"%s\");\n",
438 d->print_mangle());
439 fprintf(f_wrappers,"\t scmresult = gh_str02scm(_ptemp);\n");
440 }
441 }
442 }
443 } else {
444 /* Some void type. Need to return something. I'll return 1 */
445 fprintf(f_wrappers,"\t scmresult = gh_int2scm(1);\n");
446 }
447
448 // Dump the argument cleanup code
449 fprintf(f_wrappers,"%s\n",cleanup.get());
450
451 // Look for any remaining cleanup
452
453 if (NewObject) {
454 if ((tm = typemap_lookup("newfree","guile",d,iname,"_result",""))) {
455 fprintf(f_wrappers,"%s\n",tm);
456 }
457 }
458
459 if ((tm = typemap_lookup("ret","guile",d,name,"_result",""))) {
460 // Yep. Use it instead of the default
461 fprintf(f_wrappers,"%s\n",tm);
462 }
463
464 // Wrap things up (in a manner of speaking)
465
466 fprintf(f_wrappers,"\t return scmresult;\n");
467 fprintf(f_wrappers,"}\n");
468
469 // Now register the function
470 fprintf(f_init,"\t gh_new_procedure(\"%s\", _wrap_gscm_%s, %d, 0, 0);\n",
471 iname, wname, pcount);
472
473 // Make a documentation entry for this
474
475 if (doc_entry) {
476 static DocEntry *last_doc_entry = 0;
477 char *usage = 0;
478 usage_func(iname,d,l,&usage);
479 doc_entry->usage << usage;
480 if (last_doc_entry != doc_entry) {
481 doc_entry->cinfo << "returns " << d->print_type();
482 last_doc_entry = doc_entry;
483 }
484 delete usage;
485 }
486}
487
488// -----------------------------------------------------------------------
489// GUILE::link_variable(char *name, char *iname, DataType *d)
490//
491// Create a link to a C variable.
492// This creates a single function _wrap_gscm_var_varname().
493// This function takes a single optional argument. If supplied, it means
494// we are setting this variable to some value. If ommitted, it means we are
495// simply evaluating this variable. Either way, we return the variables
496// value.
497// -----------------------------------------------------------------------
498
499void GUILE::link_variable(char *name, char *iname, DataType *t)
500{
501
502 char var_name[256];
503 char *tm;
504 char *tm2 = typemap_lookup("varout","guile",t,name,name,"scmresult");
505
506 // evaluation function names
507
508 sprintf(var_name,"_wrap_gscm_var_%s",iname);
509
510 if ((t->type != T_USER) || (t->is_pointer)) {
511
512 fprintf(f_wrappers,"SCM %s(SCM s_0) {\n", var_name);
513
514 if (!(Status & STAT_READONLY) && (t->is_pointer)) {
515 fprintf(f_wrappers,"\t char *_temp;\n");
516 fprintf(f_wrappers,"\t int _len;\n");
517 }
518
519 if (tm2) {
520 fprintf(f_wrappers,"\t char _ptemp[128];\n");
521 }
522 fprintf(f_wrappers,"\t SCM scmresult; /* fun2 */\n");
523
524 // Check for a setting of the variable value
525
526 fprintf(f_wrappers,"\t if (s_0 != GH_NOT_PASSED) {\n");
527
528 // Yup. Extract the type from s_0 and set variable value
529 if (Status & STAT_READONLY) {
530// fprintf(f_wrappers,"\t\t gscm_error(\"Unable to set %s. Variable is read only.\", s_0);\n", iname);
531 } else {
532 if ((tm = typemap_lookup("varin","guile",t,name,"s_0",name))) {
533 // Yep. Use it instead of the default
534 fprintf(f_wrappers,"%s\n",tm);
535 } else {
536 if (!t->is_pointer) {
537
538 switch(t->type) {
539 // Signed Integer
540
541 case T_INT: case T_SINT:
542 case T_SHORT: case T_SSHORT:
543 case T_LONG: case T_SLONG:
544 case T_SCHAR:
545 fprintf(f_wrappers,"\t\t %s = %s gh_scm2long(s_0);\n",name, t->print_cast());
546 break;
547
548 // Unsigned integer
549
550 case T_UINT:
551 case T_USHORT:
552 case T_ULONG:
553 case T_UCHAR:
554 fprintf(f_wrappers,"\t\t %s = %s gh_scm2ulong(s_0);\n",name, t->print_cast());
555 break;
556
557 // Floating point
558
559 case T_FLOAT:
560 case T_DOUBLE:
561 fprintf(f_wrappers,"\t\t %s = %s gh_scm2double(s_0);\n",name, t->print_cast());
562 break;
563
564 // Character value
565
566 case T_CHAR:
567 fprintf(f_wrappers,"\t\t %s = gh_scm2char(s_0);\n", name);
568 break;
569
570 // Unknown value
571
572 default:
573 fprintf(stderr,"Line %d. Error, unsupported data-type.\n", line_number);
574 break;
575 }
576 } else {
577
578 // Have some sort of pointer type here, Process it differently
579
580 if ((t->type == T_CHAR) && (t->is_pointer == 1)) {
581 fprintf(f_wrappers,"\t\t _temp = gh_scm2newstr(s_0, &_len);\n");
582 fprintf(f_wrappers,"\t\t if (%s) { free(%s);}\n", name,name);
583 fprintf(f_wrappers,"\t\t %s = (char *) malloc((_len+1)*sizeof(char));\n",name);
584 fprintf(f_wrappers,"\t\t strncpy(%s,_temp,_len);\n",name);
585 fprintf(f_wrappers,"\t\t %s[_len] = 0;\n", name);
586 } else {
587 // Set the value of a pointer
588 fprintf(f_wrappers,"\t\t _temp = gh_scm2newstr(s_0,&_len);\n");
589 fprintf(f_wrappers,"\t if (SWIG_GetPtr(_temp, (void **) &%s,",name);
590 if (t->type == T_VOID) fprintf(f_wrappers,"(char *) 0)) {\n");
591 else
592 fprintf(f_wrappers,"\"%s\")) {\n", t->print_mangle());
593
594 // Now emit code according to the level of strictness desired
595
596 switch(TypeStrict) {
597 case 0: // No type checking
598 fprintf(f_wrappers,"\t}\n");
599 break;
600 case 1: // Warning message only
601 fprintf(f_wrappers,
602 "\t fprintf(stderr,\"Warning : type mismatch in variable %s. Expected %s, received %%s\\n\", _temp);\n", name, t->print_mangle());
603 fprintf(f_wrappers,"\t }\n");
604 break;
605 case 2: // Super strict mode.
606
607// fprintf(f_wrappers,"\t\t gscm_error(\"Type error in variable %s. Expected %s.\", s_0);\n", name,t->print_mangle());
608 fprintf(f_wrappers,"\t}\n");
609 break;
610
611 default :
612 fprintf(stderr,"Unknown strictness level\n");
613 break;
614 }
615 }
616 }
617 }
618 }
619 fprintf(f_wrappers,"\t}\n");
620
621 // Now return the value of the variable (regardless of evaluating or setting)
622
623 if (tm2) {
624 // Yep. Use it instead of the default
625 fprintf(f_wrappers,"%s\n",tm);
626 } else {
627 if (!t->is_pointer) {
628 /* Return variable by value */
629
630 switch(t->type) {
631
632 // Signed Integer
633
634 case T_INT: case T_SINT:
635 case T_SHORT: case T_SSHORT:
636 case T_LONG: case T_SLONG:
637 case T_SCHAR:
638 fprintf(f_wrappers,"\t scmresult = gh_long2scm((long) %s);\n", name);
639 break;
640
641 // Unsigned integer
642
643 case T_UINT:
644 case T_USHORT:
645 case T_ULONG:
646 case T_UCHAR:
647 fprintf(f_wrappers,"\t scmresult = gh_ulong2scm((unsigned long) %s);\n",name);
648 break;
649
650 // Floats
651
652 case T_DOUBLE:
653 case T_FLOAT:
654 fprintf(f_wrappers,"\t scmresult = gh_double2scm((double) %s);\n", name);
655 break;
656 case T_CHAR:
657 fprintf(f_wrappers,"\t scmresult = gh_char2scm(%s);\n",name);
658 break;
659 default :
660 /* Unknown type */
661 break;
662 }
663 } else {
664
665 // Is a pointer return type
666
667 if ((t->type == T_CHAR) && (t->is_pointer == 1)) {
668 fprintf(f_wrappers,"\t scmresult = gh_str02scm(%s);\n",name);
669 } else {
670 // Is an ordinary pointer type.
671 fprintf(f_wrappers,"\t SWIG_MakePtr(_ptemp, %s,\"%s\");\n",name,
672 t->print_mangle());
673 fprintf(f_wrappers,"\t scmresult = gh_str02scm(_ptemp);\n");
674 }
675 }
676 }
677 fprintf(f_wrappers,"\t return scmresult;\n");
678 fprintf(f_wrappers,"}\n");
679
680 // Now add symbol to the Guile interpreter
681
682 fprintf(f_init,"\t gh_new_procedure(\"%s\", %s, 0, 1, 0);\n",iname, var_name);
683
684 } else {
685 fprintf(stderr,"%s : Line %d. ** Warning. Unable to link with type %s (ignored).\n",
686 input_file, line_number, t->print_type());
687 }
688
689 // Add a documentation entry
690
691 if (doc_entry) {
692 char *usage = 0;
693 usage_var(iname,t,&usage);
694 doc_entry->usage << usage;
695 doc_entry->cinfo << "Global : " << t->print_type() << " " << name;
696 delete usage;
697 }
698
699}
700
701// -----------------------------------------------------------------------
702// GUILE::declare_const(char *name, char *iname, DataType *type, char *value)
703//
704// Makes a constant. Not sure how this is really supposed to work.
705// I'm going to fake out SWIG and create a variable instead.
706// ------------------------------------------------------------------------
707
708void GUILE::declare_const(char *name, char *, DataType *type, char *value) {
709
710 int OldStatus = Status; // Save old status flags
711 char var_name[256];
712
713 Status = STAT_READONLY; // Enable readonly mode.
714
715 // Make a static variable;
716
717 sprintf(var_name,"_wrap_const_%s",name);
718
719 if ((type->type == T_USER) && (!type->is_pointer)) {
720 fprintf(stderr,"%s : Line %d. Unsupported constant value.\n", input_file, line_number);
721 return;
722 }
723
724 // Create variable and assign it a value
725
726 fprintf(f_header,"static %s %s = ", type->print_type(), var_name);
727 if ((type->type == T_CHAR) && (type->is_pointer <= 1)) {
728 fprintf(f_header,"\"%s\";\n", value);
729 } else {
730 fprintf(f_header,"%s;\n", value);
731 }
732
733 // Now create a variable declaration
734
735 link_variable(var_name, name, type);
736 Status = OldStatus;
737
738 if (doc_entry) {
739 char *usage = 0;
740 usage_const(name,type,value,&usage);
741 doc_entry->usage = "";
742 doc_entry->usage << usage;
743 doc_entry->cinfo = "";
744 doc_entry->cinfo << "Constant: " << type->print_type();
745 delete usage;
746 }
747
748}
749
750// ----------------------------------------------------------------------
751// GUILE::usage_var(char *iname, DataType *t, char **s)
752//
753// Produces a usage string for a Guile variable.
754// ----------------------------------------------------------------------
755
756void GUILE::usage_var(char *iname, DataType *t, char **s) {
757
758 char temp[1024], *c;
759
760 sprintf(temp,"(%s)", iname);
761 c = temp + strlen(temp);
762
763 if (!((t->type != T_USER) || (t->is_pointer))) {
764 sprintf(c," - unsupported");
765 }
766
767 if (*s == 0)
768 *s = new char[strlen(temp)+1];
769 strcpy(*s,temp);
770}
771
772// ---------------------------------------------------------------------------
773// GUILE::usage_func(char *iname, DataType *t, ParmList *l, char **s)
774//
775// Produces a usage string for a function in Guile
776// ---------------------------------------------------------------------------
777
778void GUILE::usage_func(char *iname, DataType *, ParmList *l,
779 char **s) {
780
781 char temp[1024];
782 char *c;
783 int i;
784 Parm *p;
785
786 sprintf(temp,"(%s ", iname);
787 c = temp + strlen(temp);
788
789 /* Now go through and print parameters */
790
791 p = l->get_first();
792 while (p != 0) {
793
794 /* If parameter has been named, use that. Otherwise, just print a type */
795
796 if ((p->t->type != T_VOID) || (p->t->is_pointer)) {
797 if (strlen(p->name) > 0) {
798 sprintf(c,"%s ",p->name);
799 c += strlen(p->name)+1;
800 }
801 else {
802 sprintf(c,"%s",p->t->name);
803 c += strlen(p->t->name);
804 if (p->t->is_pointer) {
805 for (i = 0; i < (p->t->is_pointer-p->t->implicit_ptr); i++) {
806 sprintf(c,"*");
807 c++;
808 }
809 }
810 }
811 }
812 p = l->get_next();
813 if (p != 0) {
814 sprintf(c," ");
815 c++;
816 }
817 }
818 sprintf(c,")");
819 if (*s == 0)
820 *s = new char[strlen(temp)+1];
821 strcpy(*s,temp);
822}
823
824
825// ----------------------------------------------------------------------
826// GUILE::usage_const(char *iname, DataType *type, char *value, char **s)
827//
828// Produces a usage string for a Guile constant
829// ----------------------------------------------------------------------
830
831void GUILE::usage_const(char *iname, DataType *, char *value, char **s) {
832
833 char temp[1024];
834
835 sprintf(temp,"(%s %s)", iname, value);
836
837 if (*s == 0)
838 *s = new char[strlen(temp)+1];
839 strcpy(*s,temp);
840
841}