/[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 411 - (show annotations) (download) (as text)
Sun Apr 2 07:05:54 2006 UTC (16 years, 1 month ago) by ben.allan
File MIME type: text/x-csrc
File size: 38924 byte(s)
Restored autotools to working, parsers to typ_ and zz_,
Fixed many missing initializations, many casting insanities
that have been creeping in, many missing forward declarations
in preparation for fixing external relations.

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 <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 (void)cdata; /* stop gcc whine about unused parameter */
388 (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 abbr = (char *)ascmalloc(tmax+1);
1074 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