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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1642 - (hide annotations) (download) (as text)
Mon Nov 12 11:07:26 2007 UTC (12 years, 1 month ago) by jpye
File MIME type: text/x-csrc
File size: 10268 byte(s)
fixed bug #323 (moving references to Tcl/Tk out of <utilities/ascConfig.h>).
1 johnpye 571 /*
2     * BrowserRel_io.c
3     * by Kirk Abbott and Ben Allan
4     * Created: 1/94
5     * Version: $Revision: 1.20 $
6     * Version control file: $RCSfile: BrowserRel_io.c,v $
7     * Date last modified: $Date: 2003/08/23 18:43:05 $
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 johnpye 742 #define ASC_BUILDING_INTERFACE
31 johnpye 571
32     #include <tcl.h>
33 jpye 1642 #include "config.h"
34 johnpye 571 #include <utilities/ascMalloc.h>
35     #include <general/list.h>
36     #include <general/dstring.h>
37 johnpye 1210
38 johnpye 571 #include <compiler/instance_enum.h>
39 johnpye 670 #include <compiler/expr_types.h>
40 johnpye 571 #include <compiler/relation_io.h>
41     #include <compiler/symtab.h>
42     #include <compiler/instance_io.h>
43     #include <compiler/instquery.h>
44     #include <compiler/visitinst.h>
45     #include <compiler/mathinst.h>
46     #include <compiler/find.h>
47     #include <compiler/functype.h>
48     #include <compiler/safe.h>
49 johnpye 908 #include <compiler/rel_blackbox.h>
50     #include <compiler/vlist.h>
51 johnpye 571 #include <compiler/relation.h>
52     #include <compiler/relation_util.h>
53     #include <compiler/func.h>
54     #include <compiler/extcall.h>
55     #include <compiler/instance_name.h>
56     #include <compiler/qlfdid.h>
57 johnpye 1316 #include <system/slv_types.h>
58 johnpye 571 #include "HelpProc.h"
59     #include "BrowserProc.h"
60     #include "BrowserRel_io.h"
61     #include "Qlfdid.h"
62     #include "BrowserProc.h"
63     #include "BrowserQuery.h"
64    
65     #ifndef lint
66     static CONST char RelationOutputRoutinesRCS[]="$Id: BrowserRel_io.c,v 1.20 2003/08/23 18:43:05 ballan Exp $";
67     #endif
68    
69     /* a horde of redundant code deleted. */
70     /**************************************************************************/
71     static struct gl_list_t *g_brow_rellist = NULL;
72     static struct gl_list_t *g_brow_condrellist = NULL;
73     /**************************************************************************/
74    
75    
76     /* Get a list of pointers to normal relations
77     * and a list of pointers to conditional relations
78     */
79    
80     static
81     void BrowGetRelations(struct Instance *i)
82     {
83     CONST struct relation *rel;
84     if (i) {
85     switch(InstanceKind(i)) {
86     case REL_INST:
87     rel = GetInstanceRelationOnly(i);
88     if (!RelationIsCond(rel)) {
89     gl_append_ptr(g_brow_rellist,i);
90     } else { /* conditional relations */
91     gl_append_ptr(g_brow_condrellist,i);
92     }
93     break;
94     default:
95     break;
96     }
97     }
98     }
99    
100     /* This functions sends to the interpreter the list of relations
101     * and then the list of conditional relations if required
102     */
103     int Asc_BrowWriteRelListCmd(ClientData cdata, Tcl_Interp *interp,
104     int argc, CONST84 char *argv[])
105     {
106     struct Instance *i, *rel_inst;
107     unsigned long len, c;
108     int save=0;
109    
110 johnpye 670 UNUSED_PARAMETER(cdata);
111 johnpye 571
112     if (( argc < 2 ) || ( argc > 3 )) {
113     Tcl_AppendResult(interp,"wrong # args : ",
114     "Usage \"bgetrels\" ?cur?search? save",(char *)NULL);
115     return TCL_ERROR;
116     }
117    
118     if (strncmp(argv[1],"current",3)==0) {
119     i = g_curinst;
120     } else if (strncmp(argv[1],"search",3)==0) {
121     i = g_search_inst;
122     } else {
123     Tcl_SetResult(interp, "invalid args to \"bgetrels\"", TCL_STATIC);
124     return TCL_ERROR;
125     }
126    
127     if (argc==3) {
128     if (strncmp(argv[2],"save",4)==0) {
129     save = 1;
130     }
131     }
132    
133     if (!i) {
134     return TCL_ERROR;
135     }
136     if (!g_brow_rellist) {
137     g_brow_rellist = gl_create(40L);
138     }
139     if (!g_brow_condrellist) {
140     g_brow_condrellist = gl_create(40L);
141     }
142    
143     VisitInstanceTree(i,BrowGetRelations,0,0);
144    
145     /* relations */
146     len = gl_length(g_brow_rellist);
147     for (c=1;c<=len;c++) { /* the "{ }" is for making proper list elems */
148     char *tmp;
149     rel_inst = (struct Instance *)gl_fetch(g_brow_rellist,c);
150     Tcl_AppendResult(interp,"{",(char *)NULL);
151     tmp = WriteRelationString(rel_inst,NULL,NULL,NULL,relio_ascend,NULL);
152     Tcl_AppendResult(interp,tmp,(char *)NULL);
153     ascfree(tmp);
154     Tcl_AppendResult(interp,"} ",(char *)NULL);
155     }
156    
157     /* conditional relations. Only if required */
158     len = gl_length(g_brow_condrellist);
159     if (len) {
160     Tcl_AppendResult(interp,"{The following Relations are Conditional: } ",
161     (char *)NULL);
162     for (c=1;c<=len;c++) { /* the "{ }" is for making proper list elems */
163     char *tmp;
164     rel_inst = (struct Instance *)gl_fetch(g_brow_condrellist,c);
165     Tcl_AppendResult(interp,"{",(char *)NULL);
166     tmp = WriteRelationString(rel_inst,NULL,NULL,NULL,relio_ascend,NULL);
167     Tcl_AppendResult(interp,tmp,(char *)NULL);
168     ascfree(tmp);
169     Tcl_AppendResult(interp,"} ",(char *)NULL);
170     }
171     }
172     if (!save) {
173     gl_destroy(g_brow_rellist);
174     g_brow_rellist=NULL;
175     gl_destroy(g_brow_condrellist);
176     g_brow_condrellist=NULL;
177     }
178     return TCL_OK;
179     }
180    
181    
182     /* This function is particular for conditional relations */
183    
184     int Asc_BrowWriteCondRelListCmd(ClientData cdata, Tcl_Interp *interp,
185     int argc, CONST84 char *argv[])
186     {
187     struct Instance *i, *rel_inst;
188     unsigned long len, c;
189     int save=0;
190    
191 johnpye 670 UNUSED_PARAMETER(cdata);
192 johnpye 571
193     if (( argc < 2 ) || ( argc > 3 )) {
194     Tcl_AppendResult(interp,"wrong # args : ",
195     "Usage \"bgetcondrels\" ?cur?search? save",(char *)NULL);
196     return TCL_ERROR;
197     }
198    
199     if (strncmp(argv[1],"current",3)==0) {
200     i = g_curinst;
201     } else if (strncmp(argv[1],"search",3)==0) {
202     i = g_search_inst;
203     } else {
204     Tcl_SetResult(interp, "invalid args to \"bgetcondrels\"", TCL_STATIC);
205     return TCL_ERROR;
206     }
207    
208     if (argc==3) {
209     if (strncmp(argv[2],"save",4)==0) {
210     save = 1;
211     }
212     }
213     if (!i) {
214     return TCL_ERROR;
215     }
216    
217     if (!g_brow_rellist) {
218     g_brow_rellist = gl_create(40L);
219     }
220     if (!g_brow_condrellist) {
221     g_brow_condrellist = gl_create(40L);
222     }
223    
224     VisitInstanceTree(i,BrowGetRelations,0,0);
225    
226     len = gl_length(g_brow_condrellist);
227     if (len) {
228     for (c=1;c<=len;c++) {
229     char *tmp;
230     rel_inst = (struct Instance *)gl_fetch(g_brow_condrellist,c);
231     Tcl_AppendResult(interp,"{",(char *)NULL);
232     tmp = WriteRelationString(rel_inst,NULL,NULL,NULL,relio_ascend,NULL);
233     Tcl_AppendResult(interp,tmp,(char *)NULL);
234     ascfree(tmp);
235     Tcl_AppendResult(interp,"} ",(char *)NULL);
236     }
237     }
238     if (!save) {
239     gl_destroy(g_brow_rellist);
240     g_brow_rellist=NULL;
241     gl_destroy(g_brow_condrellist);
242     g_brow_condrellist=NULL;
243     }
244     return TCL_OK;
245     }
246    
247    
248     int Asc_BrowWriteRelListPostfixCmd(ClientData cdata, Tcl_Interp *interp,
249     int argc, CONST84 char *argv[])
250     {
251     struct Instance *i, *rel_inst;
252     enum Expr_enum type;
253     unsigned long len, c;
254     int save=0;
255    
256 johnpye 670 UNUSED_PARAMETER(cdata);
257 johnpye 571
258     if (( argc < 2 ) || ( argc > 3 )) {
259     Tcl_AppendResult(interp,"wrong # args : ",
260     "Usage \"bmake_rels\" ?cur?search? save",(char *)NULL);
261     return TCL_ERROR;
262     }
263    
264     if (strncmp(argv[1],"current",3)==0) {
265     i = g_curinst;
266     } else if (strncmp(argv[1],"search",3)==0) {
267     i = g_search_inst;
268     } else {
269     Tcl_SetResult(interp, "invalid args to \"bmake_rels\"", TCL_STATIC);
270     return TCL_ERROR;
271     }
272    
273     if (argc==3) {
274     if (strncmp(argv[2],"save",4)==0) {
275     save = 1;
276     }
277     }
278    
279     if (!i) {
280     return TCL_ERROR;
281     }
282    
283    
284     if (!g_brow_rellist) {
285     g_brow_rellist = gl_create(40L);
286     }
287     if (!g_brow_condrellist) {
288     g_brow_condrellist = gl_create(40L);
289     }
290    
291     VisitInstanceTree(i,BrowGetRelations,0,0);
292    
293     len = gl_length(g_brow_rellist);
294     for (c=1;c<=len;c++) { /* the "{ }" is for making proper list elems */
295     char *tmp;
296     rel_inst = (struct Instance *)gl_fetch(g_brow_rellist,c);
297     type = GetInstanceRelationType(rel_inst);
298     if (type!=e_token) { /* FIX FIX FIX */
299     FPRINTF(stderr,"relation type not yet supported\n");
300     continue;
301     }
302     Tcl_AppendResult(interp,"{",(char *)NULL);
303     tmp = WriteRelationPostfixString(rel_inst,NULL);
304     Tcl_AppendResult(interp,tmp,(char *)NULL);
305     ascfree(tmp);
306     Tcl_AppendResult(interp,"} ",(char *)NULL);
307     }
308     if (!save) {
309     gl_destroy(g_brow_rellist);
310     g_brow_rellist=NULL;
311     gl_destroy(g_brow_condrellist);
312     g_brow_condrellist=NULL;
313     }
314     return TCL_OK;
315     }
316    
317    
318    
319     int Asc_BrowWriteRelsForAtomCmd(ClientData cdata,Tcl_Interp *interp,
320     int argc, CONST84 char *argv[])
321     {
322     CONST struct relation *rel;
323     struct Instance *i, *rel_inst;
324     unsigned long nrels, c;
325    
326 johnpye 670 UNUSED_PARAMETER(cdata);
327 johnpye 571
328     if ( argc != 2 ) {
329     Tcl_AppendResult(interp,"wrong # args : ",
330     "Usage :__brow_relsforatom ?cur?search?",(char *)NULL);
331     return TCL_ERROR;
332     }
333     if (strncmp(argv[1],"current",3)==0) {
334     i = g_curinst;
335     } else if (strncmp(argv[1],"search",3)==0) {
336     i = g_search_inst;
337     } else {
338     Tcl_SetResult(interp, "invalid args to \"__brow_relsforatom\"",TCL_STATIC);
339     return TCL_ERROR;
340     }
341     if (!i) {
342     return TCL_ERROR;
343     }
344     if ( (InstanceKind(i) != REAL_ATOM_INST)
345     && (InstanceKind(i)!= REAL_CONSTANT_INST) ) {
346     /* We may soon do booleans also */
347     Tcl_AppendResult(interp,"At the moment only real atoms ",
348     "are allowed in relations",(char *)NULL);
349     return TCL_ERROR;
350     }
351     nrels = RelationsCount(i);
352     for (c=1;c<=nrels;c++) { /* the "{ }" is for making proper list elems */
353     char *tmp;
354     rel_inst = RelationsForAtom(i,c);
355     rel = GetInstanceRelationOnly(rel_inst);
356     Tcl_AppendResult(interp,"{",(char *)NULL);
357     tmp = WriteRelationString(rel_inst,NULL,NULL,NULL,relio_ascend,NULL);
358     Tcl_AppendResult(interp,tmp,(char *)NULL);
359     ascfree(tmp);
360     if (RelationIsCond(rel)) {
361     Tcl_AppendResult(interp," Conditional Relation",(char *)NULL);
362     }
363     Tcl_AppendResult(interp,"} ",(char *)NULL);
364     }
365     return TCL_OK;
366     }

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