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

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

Parent Directory Parent Directory | Revision Log Revision Log


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

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