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

Contents of /trunk/tcltk98/generic/interface/LibraryProc.c

Parent Directory Parent Directory | Revision Log Revision Log


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

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