/[ascend]/trunk/tcltk/generic/interface/LibraryProc.c
ViewVC logotype

Annotation of /trunk/tcltk/generic/interface/LibraryProc.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 708 - (hide annotations) (download) (as text)
Tue Jun 27 07:34:31 2006 UTC (18 years ago) by johnpye
File MIME type: text/x-csrc
File size: 38895 byte(s)
Replaced some references to ascmalloc with ASC_NEW_ARRAY
1 johnpye 571 /*
2     * LibraryProc.c
3     * by Kirk Abbott and Ben Allan
4     * Created: 1/94
5     * Version: $Revision: 1.44 $
6     * Version control file: $RCSfile: LibraryProc.c,v $
7     * Date last modified: $Date: 2003/08/23 18:43:06 $
8     * Last modified by: $Author: ballan $
9     *
10     * This file is part of the ASCEND Tcl/Tk interface
11     *
12     * Copyright 1997, Carnegie Mellon University
13     *
14     * The ASCEND Tcl/Tk interface is free software; you can redistribute
15     * it and/or modify it under the terms of the GNU General Public License as
16     * published by the Free Software Foundation; either version 2 of the
17     * License, or (at your option) any later version.
18     *
19     * The ASCEND Tcl/Tk interface is distributed in hope that it will be
20     * useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
21     * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
22     * General Public License for more details.
23     *
24     * You should have received a copy of the GNU General Public License
25     * along with the program; if not, write to the Free Software Foundation,
26     * Inc., 675 Mass Ave, Cambridge, MA 02139 USA. Check the file named
27     * COPYING. COPYING is found in ../compiler.
28     */
29    
30     #include <time.h>
31     #include <tcl.h>
32     #include <utilities/ascConfig.h>
33     #include <utilities/ascMalloc.h>
34     #include <general/dstring.h>
35     #include <general/list.h>
36     #include <compiler/compiler.h>
37     #include <compiler/symtab.h>
38     #include <compiler/braced.h>
39     #include <compiler/notate.h>
40     #include <compiler/fractions.h>
41     #include <compiler/dimen.h>
42 johnpye 670 #include <compiler/expr_types.h>
43 johnpye 571 #include <compiler/syntax.h>
44     #include <compiler/module.h>
45     #include <compiler/instance_enum.h>
46     #include <compiler/dump.h>
47     #include <compiler/stattypes.h>
48     #include <compiler/slist.h>
49     #include <compiler/child.h>
50     #include <compiler/childio.h>
51     #include <compiler/type_desc.h>
52     #include <compiler/typedef.h>
53     #include <compiler/extfunc.h>
54     #include <compiler/library.h>
55     #include <compiler/prototype.h>
56     #include <compiler/proc.h>
57     #include <compiler/nameio.h>
58     #include <compiler/parser.h>
59     #include <solver/slv_types.h>
60     #include "HelpProc.h"
61     #include "LibraryProc.h"
62     #include "Commands.h"
63     #include "SimsProc.h"
64    
65     #ifndef lint
66     static CONST char LibraryProcID[] = "$Id: LibraryProc.c,v 1.44 2003/08/23 18:43:06 ballan Exp $";
67     #endif
68    
69    
70     extern
71     int Asc_FileIDCopy(FILE *filein, FILE *fileout)
72     {
73     int c;
74     while ((c = fgetc(filein)) != EOF) {
75     FPUTC(c,fileout);
76     }
77     return 0;
78     }
79    
80    
81     struct int_option {
82     int *option_ptr;
83     char *option_name;
84     int low;
85     int high;
86     };
87    
88     /* keep the names here < 60 chars. Data for Options command */
89     #define OPTIONCOUNT 4
90     static
91     struct int_option g_option_list[OPTIONCOUNT] = {
92     {&g_compiler_warnings,"-compilerWarnings",0,INT_MAX},
93     {&g_parser_warnings,"-parserWarnings",0,5},
94     {&g_simplify_relations,"-simplifyRelations",0,1},
95     {&g_use_copyanon,"-useCopyAnon",0,1}
96     };
97     #define GOL g_option_list
98     STDHLF(Asc_LibrOptionsCmd,(Asc_LibrOptionsCmdHL,HLFSTOP));
99     int Asc_LibrOptionsCmd(ClientData cdata, Tcl_Interp *interp,
100     int argc, CONST84 char **argv)
101     {
102     int i, opt, status;
103     char buf[80];
104     ASCUSE; /* see if first arg is -help */
105     if (argc == 1) {
106     for (i = 0; i < OPTIONCOUNT; i++) {
107     sprintf(buf,"%s %d",GOL[i].option_name, *(GOL[i].option_ptr));
108     Tcl_AppendElement(interp,buf);
109     }
110     return TCL_OK;
111     }
112     if (argc == 2) {
113     for (i = 0; i < OPTIONCOUNT; i++) {
114     if (strcmp(argv[1],GOL[i].option_name)==0) {
115     sprintf(buf,"%d", *(GOL[i].option_ptr));
116     Tcl_AppendResult(interp,buf,(char *)NULL);
117     return TCL_OK;
118     }
119     }
120     Tcl_AppendResult(interp,"Unknown option '",argv[1],"' to ",
121     Asc_LibrOptionsCmdHN,(char *)NULL);
122     return TCL_ERROR;
123     }
124     if (argc == 3) {
125     for (i = 0; i < OPTIONCOUNT; i++) {
126     if (strcmp(argv[1],GOL[i].option_name)==0) {
127     status = Tcl_GetInt(interp,argv[2],&opt);
128     if (status != TCL_OK) {
129     Tcl_AppendResult(interp,"Non-integer value (",argv[2],") given for ",
130     argv[0]," ",argv[1],(char *)NULL);
131     return TCL_ERROR;
132     }
133     if (opt < GOL[i].low || opt > GOL[i].high) {
134     sprintf(buf,"Value %d out of range [%d - %d]",opt,GOL[i].low,
135     GOL[i].high);
136     Tcl_AppendResult(interp,argv[0],": ",buf," for ",argv[1],
137     (char *)NULL);
138     return TCL_ERROR;
139     }
140     *(GOL[i].option_ptr) = opt;
141     return TCL_OK;
142     }
143     }
144     Tcl_AppendResult(interp,"Unknown option '",argv[1],"' to ",
145     argv[0],(char *)NULL);
146     return TCL_ERROR;
147     }
148     sprintf(buf,"%d",argc);
149     Tcl_AppendResult(interp,"Too many arguments (",buf,") to ",
150     Asc_LibrOptionsCmdHN, (char *)NULL);
151     return TCL_ERROR;
152     }
153    
154     STDHLF(Asc_LibrReadCmd,(Asc_LibrReadCmdHL,HLFSTOP));
155     int Asc_LibrReadCmd(ClientData cdata, Tcl_Interp *interp,
156     int argc, CONST84 char **argv)
157     {
158     struct module_t *mod;
159     int relns_flag = 1;
160     int result;
161    
162     ASCUSE; /* see if first arg is -help */
163    
164     if ( argc < 2 || argc > 3 ) {
165     Tcl_SetResult(interp,
166     "wrong # args: Usage: " Asc_LibrReadCmdHU, TCL_STATIC);
167     return TCL_ERROR;
168     }
169    
170     /* set up the parse relns flag */
171     if ( argc == 3 ) {
172     relns_flag = atoi(argv[2]);
173     }
174    
175     SetParseRelnsFlag(relns_flag);
176     if((mod = Asc_OpenModule(argv[1],NULL)) == NULL) {
177     Tcl_AppendResult(interp,
178     Asc_LibrReadCmdHN ": Error in opening file ",
179     argv[1], (char*)NULL);
180     result = TCL_ERROR;
181     } else {
182     /*
183     * the open was successful. parse the file.
184     */
185     Tcl_SetResult(interp, (char*)SCP(Asc_ModuleName(mod)), TCL_VOLATILE);
186     zz_parse(); /*FIXME*/
187     result = TCL_OK;
188     }
189     SetParseRelnsFlag(1); /* always reset */
190     return result;
191     }
192    
193     STDHLF(Asc_LibrParseCmd,(Asc_LibrParseCmdHL,HLFSTOP));
194     int Asc_LibrParseCmd(ClientData cdata, Tcl_Interp *interp,
195     int argc, CONST84 char **argv)
196     {
197     struct module_t *mod;
198     int osmerr;
199     int result;
200    
201     ASCUSE; /* see if first arg is -help */
202    
203     if ( argc != 2) {
204     Tcl_SetResult(interp,
205     "wrong # args: Usage: " Asc_LibrParseCmdHU, TCL_STATIC);
206     return TCL_ERROR;
207     }
208    
209     mod = Asc_OpenStringModule(argv[1],&osmerr,NULL);
210     if (mod == NULL) {
211     Tcl_AppendResult(interp,
212     Asc_LibrParseCmdHN ": Insufficient memory to open "
213     "string buffer ",
214     argv[1], (char*)NULL);
215     result = TCL_ERROR;
216     } else {
217     /*
218     * the open was successful. parse the string.
219     */
220     Tcl_SetResult(interp, (char*)SCP(Asc_ModuleName(mod)), TCL_VOLATILE);
221     zz_parse(); /*FIXME*/
222     Asc_CloseCurrentModule();
223     result = TCL_OK;
224     }
225     return result;
226     }
227    
228    
229     static
230     int LibrModuleList(Tcl_Interp *interp, int module_type)
231     {
232     unsigned long c;
233     struct gl_list_t *ml;
234    
235     if ( module_type < 0 || module_type > 2) {
236     Tcl_SetResult(interp, "module_type given not in [0 .. 2]", TCL_STATIC);
237     return TCL_ERROR;
238     }
239     ml = Asc_ModuleList(module_type);
240     if( ml == NULL ) {
241     /* module list is empty, return empty string */
242     Tcl_ResetResult(interp);
243     return TCL_OK;
244     }
245    
246     for( c = gl_length(ml); c > 0; c-- ) {
247     Tcl_AppendElement(interp, (char *)gl_fetch( ml, c ));
248     }
249     gl_destroy(ml);
250     return TCL_OK;
251     }
252    
253    
254     static
255     int LibrModelDefinitionMethods(Tcl_Interp *interp)
256     {
257     struct gl_list_t *pl;
258     unsigned long c,len;
259    
260     pl = GetUniversalProcedureList();
261     if (pl == NULL) {
262     return TCL_OK;
263     }
264     len = gl_length(pl);
265     for (c = 1; c <= len; c++) {
266     Tcl_AppendElement(interp,
267     (char *)SCP(ProcName((struct InitProcedure *)gl_fetch(pl,c))));
268     }
269     return TCL_OK;
270     }
271    
272     STDHLF(Asc_LibrTypeListCmd,(Asc_LibrTypeListCmdHL,HLFSTOP));
273     int Asc_LibrTypeListCmd(ClientData cdata, Tcl_Interp *interp,
274     int argc, CONST84 char **argv)
275     {
276     struct gl_list_t *dl;
277     unsigned long len;
278     unsigned long c;
279     CONST struct module_t *module;
280    
281     ASCUSE; /* see if first arg is -help */
282    
283     if ( argc != 2 ) {
284     Tcl_SetResult(interp, "wrong # args: Usage: " Asc_LibrTypeListCmdHU,
285     TCL_STATIC);
286     return TCL_ERROR;
287     }
288    
289     module = Asc_GetModuleByName(argv[1]);
290     if( module == NULL ) {
291     Tcl_AppendResult(interp, Asc_LibrTypeListCmdHN
292     ": Cannot find a module having the name ", argv[1],
293     NULL);
294     return TCL_ERROR;
295     }
296    
297     dl = Asc_TypeByModule(module);
298     if ( dl == NULL ) {
299     Tcl_AppendResult(interp, Asc_LibrTypeListCmdHN
300     ": The type definition list for", argv[1], "is NULL",
301     NULL);
302     return TCL_ERROR;
303     }
304    
305     len = gl_length(dl);
306     for( c = 1; c <= len; c++ ) {
307     Tcl_AppendElement(interp, (char*)gl_fetch(dl,c));
308     }
309     gl_destroy(dl);
310     return TCL_OK;
311     }
312    
313    
314     STDHLF(Asc_LibrDestroyTypesCmd, (Asc_LibrDestroyTypesCmdHL,HLFSTOP));
315     int Asc_LibrDestroyTypesCmd(ClientData cdata, Tcl_Interp *interp,
316     int argc, CONST84 char **argv)
317     {
318     ASCUSE; /* see if first arg is -help */
319    
320     FFLUSH(stderr);
321     DestroyNotesDatabase(LibraryNote());
322     SetUniversalProcedureList(NULL);
323     DestroyLibrary();
324     DestroyPrototype();
325     EmptyTrash();
326     Asc_DestroyModules((DestroyFunc)DestroyStatementList);
327     WriteChildMissing(NULL,NULL,NULL);
328     DefineFundamentalTypes();
329     InitNotesDatabase(LibraryNote());
330     return TCL_OK;
331     }
332    
333    
334    
335     /*
336     * void AddRootName(t);
337     * const struct TypeDescription *t;
338     *
339     * AddRootName is called via gl_interate to find all root types, i.e,
340     * types that don't refine other types, and append the names of those
341     * types to the Tcl result. We need to make a locally global pointer
342     * to the Tcl interpreter (called lroottypesinterp) so that AddRootName
343     * can access it.
344     */
345     static Tcl_Interp *lroottypesinterp;
346     static void AddRootName(CONST struct TypeDescription *t)
347     {
348     if(( t != NULL ) && ( GetRefinement(t) == NULL )) {
349     Tcl_AppendElement(lroottypesinterp, (char *)SCP(GetName(t)));
350     }
351     }
352    
353     static
354     int LibrRootTypes(Tcl_Interp *interp)
355     {
356     struct gl_list_t *deflist;
357    
358     deflist = DefinitionList();
359     lroottypesinterp = interp;
360     gl_iterate(deflist,(void (*)(VOIDPTR))AddRootName);
361     gl_destroy(deflist);
362     return TCL_OK;
363     }
364    
365     static
366     int LibrCatalog(Tcl_Interp *interp)
367     {
368     struct gl_list_t *deflist;
369     unsigned long len;
370     unsigned long c;
371    
372     deflist = DefinitionList();
373     len = gl_length(deflist);
374     for (c = 1; c <= len; c++) {
375     Tcl_AppendElement(interp,
376     (char*)SCP(GetName((CONST struct TypeDescription *)gl_fetch(deflist,c))));
377     }
378     gl_destroy(deflist);
379     return TCL_OK;
380     }
381    
382    
383    
384     int Asc_GNUTextCmd(ClientData cdata, Tcl_Interp *interp,
385     int argc, CONST84 char **argv)
386     {
387 johnpye 670 UNUSED_PARAMETER(cdata);
388 johnpye 571 (void)argc; /* stop gcc whine about unused parameter */
389     (void)argv; /* stop gcc whine about unused parameter */
390    
391     Tcl_AppendResult(interp,
392     "See the \"License\" buffer in the Script\n",
393     "for information on the GNU License and Warranty\n",
394     (char*)NULL);
395     return TCL_OK;
396     }
397    
398    
399     static
400     int LibrFindType(Tcl_Interp *interp, struct TypeDescription *desc)
401     {
402     struct module_t *mod;
403     assert(desc!=NULL);
404    
405     mod = GetModule(desc);
406     if( mod == NULL ) {
407     Tcl_AppendResult(interp, Asc_LibrQueryTypeCmdHN
408     ": Type ", (char *)SCP(GetName(desc)),
409     " is a fundamental type", NULL);
410     return TCL_ERROR;
411     }
412    
413     Tcl_SetResult(interp, (char *)SCP(Asc_ModuleName(mod)), TCL_VOLATILE);
414     return TCL_OK;
415     }
416    
417     static
418     int LibrAncestorType(Tcl_Interp *interp, struct TypeDescription *desc)
419     {
420     struct gl_list_t *names;
421     unsigned long c,len;
422    
423     assert(desc!=NULL);
424     names = GetAncestorNames(desc);
425     if( names == NULL ) {
426     Tcl_AppendResult(interp, "-ancestors: out of memory", NULL);
427     return TCL_ERROR;
428     }
429     for (c = 1, len = gl_length(names); c <= len; c++) {
430     Tcl_AppendElement(interp,(char *)gl_fetch(names,c));
431     }
432     gl_destroy(names);
433     return TCL_OK;
434     }
435    
436    
437     STDHLF(Asc_LibrModuleInfoCmd,(Asc_LibrModuleInfoCmdHL,HLFSTOP));
438     int Asc_LibrModuleInfoCmd(ClientData cdata, Tcl_Interp *interp,
439     int argc, CONST84 char **argv)
440     {
441     CONST struct module_t *mod;
442     CONST char *string;
443     char index[36];
444     int i;
445    
446     ASCUSE; /* see if first arg is -help */
447    
448     if( argc < 2 ) {
449     Tcl_SetResult(interp, "wrong # args: Usage: " Asc_LibrModuleInfoCmdHU,
450     TCL_STATIC);
451     return TCL_ERROR;
452     }
453    
454     for( i = 1; i < argc; i++ ) {
455     if((mod = Asc_GetModuleByName(argv[i])) != NULL ) {
456     Tcl_AppendElement(interp, (char *)SCP(Asc_ModuleName(mod)));
457     Tcl_AppendElement(interp, (char *)SCP(Asc_ModuleBestName(mod)));
458     string = Asc_ModuleString(mod);
459     if (string == NULL) {
460     Tcl_AppendElement(interp, asctime(Asc_ModuleTimeModified(mod)));
461     Tcl_AppendElement(interp, NULL);
462     } else {
463     sprintf(index,"%d",(int)Asc_ModuleStringIndex(mod));
464     Tcl_AppendElement(interp, index);
465     Tcl_AppendElement(interp, (char *)string);
466     }
467     }
468     }
469     return TCL_OK;
470     }
471    
472    
473     static
474     int LibrExternalFuncs(Tcl_Interp *interp)
475     {
476     char *stringresult;
477     stringresult = WriteExtFuncLibraryString();
478     if (stringresult!=NULL) {
479     Tcl_AppendResult(interp,stringresult,(char *)NULL);
480     ascfree(stringresult);
481     }
482     return TCL_OK;
483     }
484    
485    
486    
487     STDHLF(Asc_LibrHideTypeCmd, (Asc_LibrHideTypeCmdHL,HLFSTOP));
488     int Asc_LibrHideTypeCmd(ClientData cdata, Tcl_Interp *interp,
489     int argc, CONST84 char **argv)
490     {
491     struct TypeDescription *type;
492     ChildListPtr clist;
493     unsigned long c;
494    
495     ASCUSE; /* see if first arg is -help */
496    
497     if( argc < 2 || argc > 3 ) {
498     Tcl_SetResult(interp, "wrong # args: Usage: " Asc_LibrHideTypeCmdHU,
499     TCL_STATIC);
500     return TCL_ERROR;
501     }
502    
503     type = FindType(AddSymbol(argv[1]));
504     if (type==NULL) {
505     Tcl_AppendResult(interp,
506     Asc_LibrHideTypeCmdHN " called with unknown type: ",
507     argv[1], (char *)NULL);
508     return TCL_ERROR;
509     }
510    
511     if ( argc == 2 ) {
512     SetTypeShowBit(type,FALSE);
513     return TCL_OK;
514     }
515    
516     clist = GetChildList(type);
517     if (clist==NULL) {
518     Tcl_AppendResult(interp,
519     Asc_LibrHideTypeCmdHN " called with unknown type part",
520     (char *)NULL);
521     return TCL_ERROR;
522     }
523     c = ChildPos(clist,AddSymbol(argv[2]));
524     if( c == 0UL ) {
525     Tcl_AppendResult(interp,
526     Asc_LibrHideTypeCmdHN " called with unknown type part",
527     (char *)NULL);
528     return TCL_ERROR;
529     }
530     ChildHide(clist,c);
531     return TCL_OK;
532     }
533    
534    
535     STDHLF(Asc_LibrUnHideTypeCmd, (Asc_LibrUnHideTypeCmdHL,HLFSTOP));
536     int Asc_LibrUnHideTypeCmd(ClientData cdata, Tcl_Interp *interp,
537     int argc, CONST84 char **argv)
538     {
539     struct TypeDescription *type;
540     ChildListPtr clist;
541     unsigned long c;
542    
543     ASCUSE; /* see if first arg is -help */
544    
545     if (argc < 2 || argc > 3) {
546     Tcl_SetResult(interp, "wrong # args: Usage: " Asc_LibrUnHideTypeCmdHU,
547     TCL_STATIC);
548     return TCL_ERROR;
549     }
550    
551     type = FindType(AddSymbol(argv[1]));
552     if (type==NULL) {
553     Tcl_AppendResult(interp,
554     Asc_LibrUnHideTypeCmdHN " called with unknown type: ",
555     argv[1], (char*)NULL);
556     return TCL_ERROR;
557     }
558    
559     if ( argc == 2 ) {
560     SetTypeShowBit(type,TRUE);
561     return TCL_OK;
562     }
563    
564     clist = GetChildList(type);
565     if (clist==NULL) {
566     Tcl_AppendResult(interp,
567     Asc_LibrUnHideTypeCmdHN " called with unknown type part",
568     (char*)NULL);
569     return TCL_ERROR;
570     }
571     c = ChildPos(clist,AddSymbol(argv[2]));
572     if (c == 0UL) {
573     Tcl_AppendResult(interp,
574     Asc_LibrUnHideTypeCmdHN " called with unknown type part",
575     (char*)NULL);
576     return TCL_ERROR;
577     }
578     ChildShow(clist,c);
579     return TCL_OK;
580     }
581    
582    
583     static
584     int LibrGetFundamentals(Tcl_Interp *interp)
585     {
586     struct gl_list_t *fundies;
587     struct TypeDescription *type;
588     unsigned long len,c;
589     symchar *name;
590    
591     fundies = FindFundamentalTypes();
592     len = gl_length(fundies);
593    
594     for (c=1;c<=len;c++) {
595     type = (struct TypeDescription *)gl_fetch(fundies,c);
596     name = GetName(type);
597     Tcl_AppendElement(interp,(char *)SCP(name));
598     }
599     gl_destroy(fundies);
600     return TCL_OK;
601     }
602    
603    
604     STDHLF(Asc_LibrTypeIsShownCmd, (Asc_LibrTypeIsShownCmdHL, HLFSTOP));
605     int Asc_LibrTypeIsShownCmd(ClientData cdata, Tcl_Interp *interp,
606     int argc, CONST84 char **argv)
607     {
608     struct TypeDescription *type;
609     char buf[MAXIMUM_NUMERIC_LENGTH]; /* string to hold integer */
610    
611     ASCUSE; /* see if first arg is -help */
612    
613     if ( argc != 2 ) {
614     Tcl_SetResult(interp,
615     "wrong # args: Usage: " Asc_LibrTypeIsShownCmdHU,
616     TCL_STATIC);
617     return TCL_ERROR;
618     }
619     type = FindType(AddSymbol(argv[1]) );
620     if( type == NULL ) {
621     Tcl_AppendResult(interp,
622     Asc_LibrTypeIsShownCmdHN " called with unknown type",
623     argv[1], (char *)NULL);
624     return TCL_ERROR;
625     }
626     sprintf(buf,"%d",TypeShow(type));
627     Tcl_SetResult(interp, buf, TCL_VOLATILE);
628     return TCL_OK;
629     }
630    
631     static
632     int LibrFileExtsCmd(Tcl_Interp *interp)
633     {
634     int i;
635    
636     for (i = 0; i < MOD_FILE_EXTS; i++) {
637     Tcl_AppendElement(interp,(char *)g_alt_ending[i]);
638     }
639     return TCL_OK;
640     }
641    
642     static
643     int LibrTypeChildren(Tcl_Interp *interp, struct TypeDescription *desc)
644     {
645     ChildListPtr children;
646     unsigned long nch;
647     unsigned long c = 0;
648     assert(desc!=NULL);
649    
650     children = GetChildList(desc);
651     if (!children) {
652     Tcl_ResetResult(interp);
653     return TCL_OK;
654     }
655     nch = ChildListLen(children);
656     if(!nch) {
657     Tcl_ResetResult(interp);
658     return TCL_OK;
659     }
660     for(c=1;c<=nch;c++) {
661     Tcl_AppendElement(interp,(char *)SCP(ChildStrPtr(children,c)));
662     }
663     return TCL_OK;
664     }
665    
666    
667     static
668     int LibrChildInfo(Tcl_Interp *interp, struct TypeDescription *desc,
669     symchar *child)
670     {
671     char *s;
672     ChildListPtr cl;
673     unsigned long nch;
674     unsigned long c = 0;
675    
676     if (desc == NULL) {
677     Tcl_AppendResult(interp,WriteChildMetaDetails(),(char *)NULL);
678     return TCL_OK;
679     }
680     cl = GetChildList(desc);
681     assert(cl != NULL);
682     if (child!=NULL) {
683     c = ChildPos(cl,child);
684     if (!c) {
685     Tcl_AppendResult(interp,"child ",(char *)SCP(child)," not found",
686     (char *)NULL);
687     return TCL_ERROR;
688     }
689     s = WriteChildDetails(cl,c);
690     Tcl_AppendResult(interp,s,(char *)NULL);
691     ascfree(s);
692     return TCL_OK;
693     } else {
694     nch = ChildListLen(cl);
695     for (c = 1; c <= nch; c++) {
696     s = WriteChildDetails(cl,c);
697     Tcl_AppendResult(interp,s,(char *)NULL);
698     ascfree(s);
699     }
700     return TCL_OK;
701     }
702     }
703    
704     static
705     int LibrMethods(Tcl_Interp *interp, struct TypeDescription *desc)
706     {
707     struct InitProcedure *ip;
708     struct gl_list_t *pl;
709     unsigned long len,c;
710    
711     assert(desc!=NULL);
712     pl = GetInitializationList(desc);
713     if (pl!=NULL) {
714     len = gl_length(pl);
715     for(c=1;c<=len;c++) {
716     ip = (struct InitProcedure *)gl_fetch(pl,c);
717     Tcl_AppendElement(interp,(char *)SCP(ProcName(ip)));
718     }
719     }
720     return TCL_OK;
721     }
722    
723     static
724     int LibrNoteDBList(Tcl_Interp *interp)
725     {
726     struct gl_list_t *dbl;
727     unsigned long len;
728     dbl = ListNotesDatabases();
729     if (dbl != NULL) {
730     len = gl_length(dbl);
731     while (len>0) {
732     Tcl_AppendElement(interp,(char *)SCP(gl_fetch(dbl,len)));
733     len--;
734     }
735     }
736     return TCL_OK;
737     }
738    
739     static
740     int LibrNoteLangs(Tcl_Interp *interp, symchar *dbid)
741     {
742     struct gl_list_t *langs;
743     unsigned long len;
744     langs = GetNotesAllLanguages(dbid);
745     if (langs==NULL) {
746     Tcl_AppendResult(interp,"dbid invalid: ",(char *)SCP(dbid),(char *)NULL);
747     return TCL_ERROR;
748     }
749     len = gl_length(langs);
750     while (len > 0) {
751     Tcl_AppendElement(interp,(char *)SCP(gl_fetch(langs,len)));
752     len--;
753     }
754     gl_destroy(langs);
755     return TCL_OK;
756     }
757    
758     /* this function does not return the notes on qualified names
759     * since we don't have an elegant way of executing the query.
760     * We need more switches to the notes query syntax tcl
761     * interface to manage those.
762     * This returns notes about simple names.
763     * This function is conceptually several functions, arg!
764     * The empty symchar "" is treated as NULL.
765     */
766     static
767     int LibrGetNotes(Tcl_Interp *interp,symchar *type, symchar *lang,
768     symchar *child, symchar *method, long noteptr, long tokenptr,
769     symchar *dbid)
770     {
771     struct gl_list_t *notes;
772     struct Note *n;
773     struct bracechar *bc;
774     char *text;
775     char linenum[40];
776     unsigned long len;
777     symchar *empty;
778     struct Name *qlfdid;
779     symchar *typename, *language, *childname, *methodname;
780     struct gl_list_t *tl, *ll, *cl, *ml, *ndl;
781     void *hold;
782    
783     if (tokenptr != (long)NULL) {
784     /* release previously held result */
785     ReleaseNoteData(dbid,(void *)tokenptr);
786     return TCL_OK;
787     }
788     if (noteptr == (long)NULL) {
789     /* return pointer (as text) to held list we find */
790     typename = ( (type==NULL || SCLEN(type)<1) ? NOTESWILD : type);
791     language = ( (lang==NULL || SCLEN(lang)<1) ? NOTESWILD : lang);
792     childname = ( (child==NULL || SCLEN(child)<1) ? NOTESWILD : child);
793     methodname = ( (method==NULL || SCLEN(method)<1) ? NOTESWILD : method);
794     tl = gl_create(2);
795     gl_append_ptr(tl,(VOIDPTR)typename);
796     ll = gl_create(2);
797     gl_append_ptr(ll,(VOIDPTR)language);
798     cl = gl_create(2);
799     gl_append_ptr(cl,(VOIDPTR)childname);
800     ml = gl_create(2);
801     gl_append_ptr(ml,(VOIDPTR)methodname);
802     ndl = gl_create(2);
803     gl_append_ptr(ndl,(VOIDPTR)nd_empty);
804     gl_append_ptr(ndl,(VOIDPTR)nd_name);
805     notes = GetNotesList(dbid,tl,ll,cl,ml,ndl);
806     gl_destroy(tl);
807     gl_destroy(ll);
808     gl_destroy(cl);
809     gl_destroy(ml);
810     gl_destroy(ndl);
811     hold = HoldNoteData(dbid,notes);
812     sprintf(linenum,"%ld",(long)hold);
813     Tcl_AppendResult(interp,linenum,(char *)NULL);
814     return TCL_OK;
815     } else {
816     /* return formatted record */
817     notes = GetExactNote(dbid,(struct Note *)noteptr);
818     }
819    
820     /* list notes must not be held before here because we
821     * destroy it at the END.
822     */
823     if (notes==NULL) {
824     Tcl_AppendResult(interp,"note not found in ",(char *)SCP(dbid),
825     (char *)NULL);
826     return TCL_ERROR;
827     }
828     len = gl_length(notes);
829     empty = AddSymbolL("",0);
830     while (len > 0) {
831     n = (struct Note *)gl_fetch(notes,len);
832     len--;
833     if (n==NULL) {
834     continue;
835     }
836     typename = GetNoteType(n);
837     if (typename == NULL) {
838     typename = empty;
839     }
840     childname = GetNoteId(n);
841     if (childname == NULL) {
842     childname = empty;
843     }
844     language = GetNoteLanguage(n);
845     if (language == NULL) {
846     language = empty;
847     }
848     methodname = GetNoteMethod(n);
849     if (methodname == NULL) {
850     methodname = empty;
851     }
852     Tcl_AppendResult(interp,"{{",(char *)SCP(typename),"} {",
853     (char *)SCP(language),"} {",(char *)NULL);
854     qlfdid = (struct Name *)GetNoteData(n,nd_name);
855     if (childname==empty && qlfdid != NULL) {
856     text = WriteNameString(qlfdid);
857     Tcl_AppendResult(interp, text,"} {",(char *)NULL);
858     ascfree(text);
859     } else {
860     Tcl_AppendResult(interp, (char *)SCP(childname),"} {",(char *)NULL);
861     }
862     bc = GetNoteText(n);
863     if (bc == NULL) {
864     text = (char *)SCP(empty);
865     } else {
866     text = (char *)BCS(bc);
867     }
868     Tcl_AppendResult(interp, (char *)SCP(methodname),"} {",text,"}",
869     (char *)NULL);
870     if (noteptr == (long)NULL) {
871     /* close element */
872     Tcl_AppendResult(interp, "} ",(char *)NULL);
873     } else {
874     /* digging up everything on specific note */
875     text = (char *)GetNoteFilename(n);
876     if (text == NULL) {
877     text = (char *)SCP(empty);
878     }
879     sprintf(linenum,"%d",GetNoteLineNum(n));
880     Tcl_AppendResult(interp, " {",text,"} {",linenum,"}} ", (char *)NULL);
881     }
882     }
883     /* END */
884     gl_destroy(notes);
885     return TCL_OK;
886     }
887    
888     /* Function to set up the tcl regexp engine and call it with the
889     * notes in heldlist or database for matches against pattern.
890     */
891     static
892     int LibrMatchNotes(Tcl_Interp *interp, char *pattern,
893     long heldlist,symchar *dbid)
894     {
895     struct gl_list_t *notes = NULL;
896     int status = TCL_OK;
897     void *held;
898     char idnum[40];
899     struct NoteEngine *ne;
900     if (pattern==NULL) {
901     Tcl_AppendResult(interp,"NOTES match needs pattern string to match",
902     (char *)NULL);
903     return TCL_ERROR;
904     }
905     if (heldlist != (long)NULL) {
906     notes = HeldNotes(dbid,(void *)heldlist);
907     if (notes == NULL) {
908     Tcl_AppendResult(interp,"NOTES database token given not valid",
909     (char *)NULL);
910     return TCL_ERROR;
911     }
912     }
913     ne = NotesCreateEngine(interp,
914     (NEInitFunc)Tcl_RegExpCompile,
915     (NECompareFunc)Tcl_RegExpExec);
916     if (ne == NULL) {
917     Tcl_AppendResult(interp,"NOTES match unable to set up regexp engine",
918     (char *)NULL);
919     return TCL_ERROR;
920     }
921     sprintf(idnum,"xxx");
922     notes = GetMatchingNotes(dbid,pattern,notes,ne);
923     if (notes != NULL) {
924     held = HoldNoteData(dbid,notes);
925     sprintf(idnum,"%ld",(long)held);
926     Tcl_ResetResult(interp);
927     Tcl_AppendResult(interp,idnum,(char *)NULL);
928     } else {
929     if (strlen(Tcl_GetStringResult(interp)) == 0) {
930     sprintf(idnum,"%ld",(long)0);
931     Tcl_ResetResult(interp);
932     Tcl_AppendResult(interp,idnum,(char *)NULL);
933     } else {
934     status = TCL_ERROR;
935     /* else leave possible error in interp */
936     }
937     }
938     NotesDestroyEngine(ne);
939     return status;
940     }
941    
942     /* this function returns the notes on everything in more or less
943     * easily sortable columns form.
944     */
945     static
946     int LibrDumpNotes(Tcl_Interp *interp, int tmax, long heldlist, symchar *dbid)
947     {
948     struct gl_list_t *notes;
949     struct Note *n;
950     struct bracechar *bc;
951     char *text;
952     char *abbr, idnum[40];
953     int tlen; /* length of text in a note */
954     int row; /* the 'row' in the database, which may change with new reads
955     * and should not be shown to the user.
956     */
957     unsigned long len;
958     symchar *empty;
959     struct Name *qlfdid;
960     symchar *typename, *language, *childname, *methodname;
961    
962     if (tmax < 5) {
963     tmax = 5;
964     }
965    
966     if (heldlist != (long)NULL) {
967     notes = HeldNotes(dbid,(void *)heldlist);
968     if (notes == NULL) {
969     Tcl_AppendResult(interp,"NOTES database token given not valid",
970     (char *)NULL);
971     return TCL_ERROR;
972     }
973     } else {
974     notes = GetNotes(dbid,NOTESWILD,NOTESWILD,NOTESWILD,NOTESWILD,nd_wild);
975     if (notes==NULL) {
976     return TCL_OK; /* empty database */
977     }
978     }
979     empty = AddSymbolL("~",1);
980    
981     /* process type names */
982     row = 0;
983     len = gl_length(notes);
984     Tcl_AppendResult(interp,"{",(char *)NULL);
985     while (len > 0) {
986     n = (struct Note *)gl_fetch(notes,len);
987     len--;
988     if (n==NULL || GetNoteEnum(n) == nd_vlist) {
989     continue;
990     }
991     typename = GetNoteType(n);
992     if (typename == NULL) {
993     typename = empty;
994     }
995     sprintf(idnum,"%d",row);
996     Tcl_AppendResult(interp,"{{",
997     (char *)SCP(typename),"} ",idnum,
998     "} ", (char *)NULL);
999     row++;
1000     }
1001     Tcl_AppendResult(interp,"} {",(char *)NULL);
1002     /* process languages */
1003     row = 0;
1004     len = gl_length(notes);
1005     while (len > 0) {
1006     n = (struct Note *)gl_fetch(notes,len);
1007     len--;
1008     if (n==NULL || GetNoteEnum(n) == nd_vlist) {
1009     continue;
1010     }
1011     language = GetNoteLanguage(n);
1012     if (language == NULL) {
1013     language = empty;
1014     }
1015     sprintf(idnum,"%d",row);
1016     Tcl_AppendResult(interp,"{{",
1017     (char *)SCP(language),"} ",idnum,
1018     "} ", (char *)NULL);
1019     row++;
1020     }
1021     Tcl_AppendResult(interp,"} {",(char *)NULL);
1022     /* process names. use qlfdid iff id == NULL */
1023     row = 0;
1024     len = gl_length(notes);
1025     while (len > 0) {
1026     n = (struct Note *)gl_fetch(notes,len);
1027     len--;
1028     if (n==NULL || GetNoteEnum(n) == nd_vlist) {
1029     continue;
1030     }
1031     childname = GetNoteId(n);
1032     qlfdid = (struct Name *)GetNoteData(n,nd_name);
1033     if (childname == NULL) {
1034     childname = empty;
1035     }
1036     sprintf(idnum,"%d",row);
1037     if (childname == empty && qlfdid != NULL) {
1038     text = WriteNameString(qlfdid);
1039     Tcl_AppendResult(interp,"{{", text, "} ",idnum, "} ", (char *)NULL);
1040     ascfree(text);
1041     } else {
1042     Tcl_AppendResult(interp,"{{", (char *)SCP(childname),"} ",idnum, "} ",
1043     (char *)NULL);
1044     }
1045     row++;
1046     }
1047     Tcl_AppendResult(interp,"} {",(char *)NULL);
1048    
1049     /* process method names */
1050     row = 0;
1051     len = gl_length(notes);
1052     while (len > 0) {
1053     n = (struct Note *)gl_fetch(notes,len);
1054     len--;
1055     if (n==NULL || GetNoteEnum(n) == nd_vlist) {
1056     continue;
1057     }
1058     methodname = GetNoteMethod(n);
1059     if (methodname == NULL) {
1060     methodname = empty;
1061     }
1062     sprintf(idnum,"%d",row);
1063     Tcl_AppendResult(interp,"{{",
1064     (char *)SCP(methodname),"} ",idnum,
1065     "} ", (char *)NULL);
1066     row++;
1067     }
1068     Tcl_AppendResult(interp,"} {",(char *)NULL);
1069    
1070     /* process text */
1071     row = 0;
1072     len = gl_length(notes);
1073 johnpye 708 abbr = ASC_NEW_ARRAY(char,tmax+1);
1074 johnpye 571 if (abbr == NULL) {
1075     Tcl_ResetResult(interp);
1076     Tcl_AppendResult(interp,"NOTES dump: out of memory",(char *)NULL);
1077     gl_destroy(notes);
1078     return TCL_ERROR;
1079     }
1080     while (len > 0) {
1081     n = (struct Note *)gl_fetch(notes,len);
1082     len--;
1083     if (n==NULL || GetNoteEnum(n) == nd_vlist) {
1084     continue;
1085     }
1086     bc = GetNoteText(n);
1087     if (bc == NULL) {
1088     text = (char *)SCP(empty);
1089     tlen = 0;
1090     } else {
1091     text = (char *)BCS(bc);
1092     tlen = BCL(bc);
1093     }
1094     if (tlen < tmax) {
1095     sprintf(abbr,"%s",text);
1096     } else {
1097     sprintf(abbr,"%.*s...",tmax-3,text); /* fixme variable prec %s fmt */
1098     }
1099     sprintf(idnum,"%d",row);
1100     Tcl_AppendResult(interp,"{{", abbr, "} ",idnum, "} ", (char *)NULL);
1101     row++;
1102     }
1103     Tcl_AppendResult(interp,"} {",(char *)NULL);
1104     ascfree(abbr);
1105    
1106     /* process filename,line */
1107     row = 0;
1108     len = gl_length(notes);
1109     while (len > 0) {
1110     n = (struct Note *)gl_fetch(notes,len);
1111     len--;
1112     if (n==NULL || GetNoteEnum(n) == nd_vlist) {
1113     continue;
1114     }
1115     tlen = GetNoteLineNum(n);
1116     text = (char *)GetNoteFilename(n);
1117     if (text == NULL) {
1118     text = (char *)SCP(empty);
1119     }
1120     /* fixme. want leaf name only. use file tail in tcl */
1121     sprintf(idnum,":%d} %d",tlen,row);
1122     Tcl_AppendResult(interp,"{{", text,/*d} d*/ idnum, "} ", (char *)NULL);
1123     row++;
1124     }
1125     Tcl_AppendResult(interp,"} {", (char *)NULL);
1126    
1127     /* process record number, which we are cheating an using the pointer for. */
1128     row = 0;
1129     len = gl_length(notes);
1130     while (len > 0) {
1131     n = (struct Note *)gl_fetch(notes,len);
1132     len--;
1133     if (n==NULL || GetNoteEnum(n) == nd_vlist) {
1134     continue;
1135     }
1136     sprintf(idnum,"%lu",(unsigned long)n);
1137     Tcl_AppendResult(interp,"{", idnum,(char *)NULL);
1138     sprintf(idnum,"%d",row);
1139     Tcl_AppendResult(interp," ", idnum,"} ",(char *)NULL);
1140     row++;
1141     }
1142     Tcl_AppendResult(interp,"}", (char *)NULL);
1143    
1144     gl_destroy(notes);
1145     return TCL_OK;
1146     }
1147    
1148     static
1149     int LibrUnimplemented(Tcl_Interp *interp, CONST84 char **argv)
1150     {
1151     Tcl_AppendResult(interp,"Unimplemented option '",argv[1],"' in ",
1152     Asc_LibrQueryTypeCmdHN,(char *)NULL);
1153     return TCL_ERROR;
1154     }
1155    
1156     STDHLF(Asc_LibrQueryTypeCmd,(Asc_LibrQueryTypeCmdHL1,
1157     Asc_LibrQueryTypeCmdHL10,
1158     Asc_LibrQueryTypeCmdHL20,
1159     Asc_LibrQueryTypeCmdHL30,
1160     Asc_LibrQueryTypeCmdHL40,
1161     Asc_LibrQueryTypeCmdHL50,
1162     Asc_LibrQueryTypeCmdHL60,
1163     Asc_LibrQueryTypeCmdHL70,
1164     Asc_LibrQueryTypeCmdHL80,
1165     Asc_LibrQueryTypeCmdHL85,
1166     Asc_LibrQueryTypeCmdHL90,
1167     Asc_LibrQueryTypeCmdHL100,
1168     Asc_LibrQueryTypeCmdHL110,
1169     Asc_LibrQueryTypeCmdHL115,
1170     Asc_LibrQueryTypeCmdHL120,
1171     Asc_LibrQueryTypeCmdHL130,
1172     Asc_LibrQueryTypeCmdHL131,
1173     Asc_LibrQueryTypeCmdHL132,
1174     Asc_LibrQueryTypeCmdHL133,
1175     Asc_LibrQueryTypeCmdHL135,
1176     Asc_LibrQueryTypeCmdHL136,
1177     Asc_LibrQueryTypeCmdHL137,
1178     Asc_LibrQueryTypeCmdHL140,
1179     HLFSTOP));
1180     int Asc_LibrQueryTypeCmd(ClientData cdata, Tcl_Interp *interp,
1181     int argc, CONST84 char **argv)
1182     {
1183     enum qtype {
1184     q_error,
1185     q_ancestors,
1186     q_basemethods,
1187     q_catalog,
1188     q_childnames,
1189     q_childinfo,
1190     q_definition,
1191     q_exists,
1192     q_externalfunctions,
1193     q_findtype,
1194     q_filetypes,
1195     q_fundamentals,
1196     q_language,
1197     q_methods,
1198     q_modulelist,
1199     q_notes,
1200     q_notesdump,
1201     q_notekinds,
1202     q_notesmatch,
1203     q_notesdblist,
1204     q_roottypes
1205     } q = q_error;
1206     symchar *type=NULL;
1207     symchar *method=NULL;
1208     symchar *child=NULL;
1209     symchar *language=NULL;
1210     symchar *dbid=NULL;
1211     int mtype=0;
1212     int i;
1213     int status;
1214     long noteptr = (long)NULL; /* parsed as long and cast to ptr. */
1215     long tokenptr = (long)NULL; /* parsed as long and cast to ptr. */
1216     char *pattern = NULL;
1217     struct TypeDescription *desc=NULL;
1218    
1219     ASCUSE; /* see if first arg is -help */
1220    
1221     if (argc < 2) {
1222     Tcl_AppendResult(interp,Asc_LibrQueryTypeCmdHN " called without arguments",
1223     (char *)NULL);
1224     return TCL_ERROR;
1225     }
1226     if (strcmp(argv[1],"-ancestors")==0) {
1227     q = q_ancestors;
1228     }
1229     if (strcmp(argv[1],"-basemethods")==0) {
1230     q = q_basemethods;
1231     }
1232     if (strcmp(argv[1],"-catalog")==0) {
1233     q = q_catalog;
1234     }
1235     if (strcmp(argv[1],"-childnames")==0) {
1236     q = q_childnames;
1237     }
1238     if (strcmp(argv[1],"-childinfo")==0) {
1239     q = q_childinfo;
1240     }
1241     if (strcmp(argv[1],"-definition")==0) {
1242     q = q_definition;
1243     }
1244     if (strcmp(argv[1],"-exists")==0) {
1245     q = q_exists;
1246     }
1247     if (strcmp(argv[1],"-externalfunctions")==0) {
1248     q = q_externalfunctions;
1249     }
1250     if (strcmp(argv[1],"-findtype")==0) {
1251     q = q_findtype;
1252     }
1253     if (strcmp(argv[1],"-filetypes")==0) {
1254     q = q_filetypes;
1255     }
1256     if (strcmp(argv[1],"-fundamentals")==0) {
1257     q = q_fundamentals;
1258     }
1259     if (strcmp(argv[1],"-language")==0) {
1260     q = q_language;
1261     }
1262     if (strcmp(argv[1],"-methods")==0) {
1263     q = q_methods;
1264     }
1265     if (strcmp(argv[1],"-modulelist")==0) {
1266     q = q_modulelist;
1267     }
1268     if (strcmp(argv[1],"-notesdblist")==0) {
1269     q = q_notesdblist;
1270     }
1271     if (strcmp(argv[1],"-notes")==0) {
1272     q = q_notes;
1273     }
1274     if (strcmp(argv[1],"-notesdump")==0) {
1275     q = q_notesdump;
1276     }
1277     if (strcmp(argv[1],"-notekinds")==0) {
1278     q = q_notekinds;
1279     }
1280     if (strcmp(argv[1],"-notesmatch")==0) {
1281     q = q_notesmatch;
1282     }
1283     if (strcmp(argv[1],"-roottypes")==0) {
1284     q = q_roottypes;
1285     }
1286     if (q==q_error) {
1287     Tcl_AppendResult(interp,"Unknown option '",argv[1],"' to ",
1288     Asc_LibrQueryTypeCmdHN,(char *)NULL);
1289     return TCL_ERROR;
1290     }
1291     /* pick off the options */
1292     for (i=2; i < argc; /* ifs do increment */ ) {
1293     if (strcmp(argv[i],"-type")==0) {
1294     if (i < (argc-1)) {
1295     type = AddSymbol(argv[i+1]);
1296     }
1297     i += 2;
1298     continue;
1299     }
1300     if (strcmp(argv[i],"-dbid")==0) {
1301     if (i < (argc-1)) {
1302     dbid = AddSymbol(argv[i+1]);
1303     }
1304     i += 2;
1305     continue;
1306     }
1307     if (strcmp(argv[i],"-child")==0) {
1308     if (i < (argc-1)) {
1309     child = AddSymbol(argv[i+1]);
1310     }
1311     i += 2;
1312     continue;
1313     }
1314     if (strcmp(argv[i],"-method")==0) {
1315     if (i < (argc-1)) {
1316     method = AddSymbol(argv[i+1]);
1317     }
1318     i += 2;
1319     continue;
1320     }
1321     if (strcmp(argv[i],"-pattern")==0) {
1322     if (i < (argc-1)) {
1323     pattern = QUIET(argv[i+1]);
1324     }
1325     i += 2;
1326     continue;
1327     }
1328     if (strcmp(argv[i],"-language")==0) {
1329     if (i < (argc-1)) {
1330     language = AddSymbol(argv[i+1]);
1331     }
1332     i += 2;
1333     continue;
1334     }
1335     if (strcmp(argv[i],"-destroytoken")==0 ||
1336     strcmp(argv[i],"-notestoken")==0) {
1337     if (i < (argc-1)) {
1338     status = Tcl_ExprLong(interp,argv[i+1],&tokenptr);
1339     if (status != TCL_OK) {
1340     return status;
1341     }
1342     }
1343     i += 2;
1344     continue;
1345     }
1346     if (strcmp(argv[i],"-record")==0) {
1347     if (i < (argc-1)) {
1348     status = Tcl_ExprLong(interp,argv[i+1],&noteptr);
1349     if (status != TCL_OK) {
1350     return status;
1351     }
1352     }
1353     i += 2;
1354     continue;
1355     }
1356     if (strcmp(argv[i],"-mtype")==0 ||
1357     strcmp(argv[i],"-textwidth")==0) {
1358     if (i < (argc-1)) {
1359     status = Tcl_GetInt(interp,argv[i+1],&mtype);
1360     if (status != TCL_OK) {
1361     return status;
1362     }
1363     }
1364     i += 2;
1365     continue;
1366     }
1367     Tcl_AppendResult(interp,"Unknown option '",argv[i],"' to ",
1368     Asc_LibrQueryTypeCmdHN,(char *)NULL);
1369     return TCL_ERROR;
1370     }
1371    
1372     if (type != NULL) {
1373     desc = FindType(type);
1374     if (q != q_exists && desc == NULL) {
1375     Tcl_AppendResult(interp,"Unknown type '",SCP(type),"' to ",
1376     Asc_LibrQueryTypeCmdHN,(char *)NULL);
1377     return TCL_ERROR;
1378     }
1379     }
1380     switch (q) {
1381     case q_ancestors:
1382     return LibrAncestorType(interp,desc);
1383     case q_basemethods:
1384     return LibrModelDefinitionMethods(interp);
1385     case q_catalog:
1386     return LibrCatalog(interp);
1387     case q_childnames:
1388     return LibrTypeChildren(interp,desc);
1389     case q_childinfo:
1390     return LibrChildInfo(interp,desc,child);
1391     case q_definition:
1392     return LibrUnimplemented(interp,argv);
1393     case q_exists:
1394     if (desc==NULL) {
1395     Tcl_SetResult(interp,"0",TCL_STATIC);
1396     } else {
1397     Tcl_SetResult(interp,"1",TCL_STATIC);
1398     }
1399     return TCL_OK;
1400     case q_externalfunctions:
1401     return LibrExternalFuncs(interp);
1402     case q_findtype:
1403     return LibrFindType(interp,desc);
1404     case q_filetypes:
1405     return LibrFileExtsCmd(interp);
1406     case q_fundamentals:
1407     return LibrGetFundamentals(interp);
1408     case q_language:
1409     return LibrUnimplemented(interp,argv);
1410     case q_methods:
1411     return LibrMethods(interp,desc);
1412     case q_modulelist:
1413     return LibrModuleList(interp,mtype);
1414     case q_notekinds:
1415     return LibrNoteLangs(interp,dbid);
1416     case q_notesdblist:
1417     return LibrNoteDBList(interp);
1418     case q_notes:
1419     return LibrGetNotes(interp,type,language,child,method,
1420     noteptr,tokenptr,dbid);
1421     case q_notesmatch:
1422     return LibrMatchNotes(interp,pattern,tokenptr,dbid);
1423     case q_notesdump:
1424     if (mtype == 0) {
1425     mtype = 15;
1426     }
1427     return LibrDumpNotes(interp,mtype,tokenptr,dbid);
1428     case q_roottypes:
1429     return LibrRootTypes(interp);
1430     default:
1431     Tcl_AppendResult(interp,"Unhandled option '",argv[1],"' in ",
1432     Asc_LibrQueryTypeCmdHN,(char *)NULL);
1433     break;
1434     }
1435     return TCL_ERROR;
1436     }

john.pye@anu.edu.au
ViewVC Help
Powered by ViewVC 1.1.22