← Back to branch summary

~ubuntu-branches/ubuntu/lucid/graphviz/lucid-security

« back to all changes in this revision

Viewing changes to tcldgr/dgr.c

  • Committer: Bazaar Package Importer
  • Author(s): Stephen M Moraco
  • Date: 2002-02-05 18:52:12 UTC
  • Revision ID: james.westby@ubuntu.com-20020205185212-8i04c70te00rc40y
Tags: upstream-1.7.16
Import upstream version 1.7.16

Show diffs side-by-side

added added

removed removed

Lines of Context:
tcldgr/dgr.c
 
1
/*
 
2
 * Tcl extension for Dynamic Graphs by John Ellson (ellson@lucent.com)
 
3
 * 
 
4
 * Builds on libincr + libgraph by Stephen North (north@research.att.com)
 
5
 */
 
6
 
 
7
#include "dgr.h"
 
8
 
 
9
#ifdef DMALLOC
 
10
#include "dmalloc.h"
 
11
#endif
 
12
 
 
13
/* FIXME - not thread safe */
 
14
dgrInterp_t dgrInterp;
 
15
 
 
16
static int
 
17
dgnew_cmd(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
 
18
{
 
19
        dgrInterp_t             *dg = (dgrInterp_t *)clientData;
 
20
        Agraph_t                *g;
 
21
        Agsym_t                 *sym;
 
22
        Agdesc_t                kind;
 
23
        char                    c;
 
24
        int                     i, length;
 
25
 
 
26
        if ((argc < 2)) {
 
27
                Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
 
28
                        " graphtype ?graphname? ?attributename attributevalue? ?...?\"",
 
29
                        (char *) NULL);
 
30
                return TCL_ERROR;
 
31
        }
 
32
        c = argv[1][0];
 
33
        length = strlen(argv[1]);
 
34
        /* string matching order is important when leading chars match.
 
35
                The shorter string must be tested first. */
 
36
        if ((c == 'd') && (strncmp(argv[1], "digraph", length) == 0)) {
 
37
                kind = Agdirected;
 
38
        } else if ((c == 'd') && (strncmp(argv[1], "digraphstrict", length) == 0)) {
 
39
                kind = Agstrictdirected;
 
40
        } else if ((c == 'g') && (strncmp(argv[1], "graph", length) == 0)) {
 
41
                kind = Agundirected;
 
42
        } else if ((c == 'g') && (strncmp(argv[1], "graphstrict", length) == 0)) {
 
43
                kind = Agstrictundirected;
 
44
        } else if ((c == 's') && (strncmp(argv[1], "strictgraph", length) == 0)) {
 
45
                kind = Agstrictundirected;
 
46
        } else if ((c == 's') && (strncmp(argv[1], "strictdigraph", length) == 0)) {
 
47
                kind = Agstrictdirected;
 
48
        } else {
 
49
                Tcl_AppendResult(interp, "bad graphtype \"", argv[1],
 
50
                        "\": must be one of:",
 
51
                        "\n\tdigraph, strictdigraph, graph, strictgraph.",
 
52
                        (char *) NULL);
 
53
                return TCL_ERROR;
 
54
        }
 
55
        i = 2;
 
56
        if (argc % 2) {
 
57
                /* if odd number of args then argv[2] is name */
 
58
                g = agopen(argv[2], kind, &gdisc);
 
59
                i++;
 
60
        } else {
 
61
                g = agopen((char *) NULL, kind, &gdisc);
 
62
        }
 
63
        for (; i < argc; i = i + 2) {
 
64
                if (!(sym = (Agsym_t *) agattrsym(g, argv[i]))) {
 
65
                        sym = agattr(g, AGRAPH, argv[i], "");
 
66
                }
 
67
                agxset(g, sym, argv[i + 1]);
 
68
        }
 
69
        dg_gpstruct_init (dg, g);
 
70
        return TCL_OK;
 
71
}
 
72
 
 
73
static int 
 
74
dgread_cmd(ClientData clientData, Tcl_Interp * interp, int argc, char *argv[])
 
75
{
 
76
        dgrInterp_t       *dg = (dgrInterp_t *)clientData;
 
77
        Agraph_t           *g;
 
78
 
 
79
/* TCL_CHANNELS are available in tcl7.5 and later */
 
80
#ifdef TCL_CHANNELS
 
81
        int                                     mode;
 
82
        Tcl_Channel      f;
 
83
#else
 
84
        FILE               *f;
 
85
#endif
 
86
 
 
87
        /* first use determines mode */
 
88
        if (dg->object_commands == -1) {
 
89
                dg->object_commands = 1;
 
90
                Tcl_DeleteCommand(interp, "dg");
 
91
        }
 
92
 
 
93
        if (argc < 2) {
 
94
                Tcl_AppendResult(interp, "wrong # args: should be \"",
 
95
                        argv[0], " fileHandle\"", (char *) NULL);
 
96
                return TCL_ERROR;
 
97
        }
 
98
 
 
99
#ifdef TCL_CHANNELS
 
100
        f = Tcl_GetChannel(interp, argv[1], &mode);
 
101
        if (f == (Tcl_Channel) NULL) {
 
102
                Tcl_AppendResult(interp, "unable to open channel: ",
 
103
                        argv[1], (char *) NULL);
 
104
                return TCL_ERROR;
 
105
        }
 
106
#else
 
107
        if (Tcl_GetOpenFile(interp, argv[1], 0, 0, &f) != TCL_OK) {
 
108
                Tcl_AppendResult(interp, "failed to find open file: ",
 
109
                        argv[1], (char *) NULL);
 
110
                return TCL_ERROR;
 
111
        }
 
112
#endif
 
113
 
 
114
        gdisc.io = &file_iodisc;
 
115
 
 
116
        if (!(g = agconcat((Agraph_t *) NULL, f, &gdisc))) {
 
117
                Tcl_AppendResult(interp, "failure reading file: ",
 
118
                        argv[1], (char *) NULL);
 
119
                return TCL_ERROR;
 
120
        }
 
121
 
 
122
        dg_gpfromdot_init(dg, g);
 
123
        dg_gpstruct_init(dg, g);
 
124
        return TCL_OK;
 
125
}
 
126
 
 
127
static int 
 
128
dgstring_cmd(ClientData clientData, Tcl_Interp * interp, int argc, char *argv[])
 
129
{
 
130
        dgrInterp_t        *dg = (dgrInterp_t *)clientData;
 
131
        Agraph_t           *g;
 
132
        char               *s;
 
133
 
 
134
        /* first use determines mode */
 
135
        if (dg->object_commands == -1) {
 
136
                dg->object_commands = 1;
 
137
                Tcl_DeleteCommand(interp, "dg");
 
138
        }
 
139
 
 
140
        if (argc < 2) {
 
141
                Tcl_AppendResult(interp, "wrong # args: should be \"",
 
142
                        argv[0], " dot_string\"", (char *) NULL);
 
143
                return TCL_ERROR;
 
144
        }
 
145
 
 
146
        gdisc.io = &string_iodisc;
 
147
 
 
148
        /* s gets modified to point to 8K blocks in argv[1] */
 
149
        s = argv[1];
 
150
        if (!(g = agconcat((Agraph_t *) NULL, &s, &gdisc))) {
 
151
                Tcl_AppendResult(interp, "failure reading string: ",
 
152
                        argv[1], (char *) NULL);
 
153
                return TCL_ERROR;
 
154
        }
 
155
 
 
156
        dg_gpfromdot_init(dg, g);
 
157
        dg_gpstruct_init(dg, g);
 
158
        return TCL_OK;
 
159
}
 
160
 
 
161
/*
 
162
 * dgreset is intended for regression test use only.  It resets the handle
 
163
 * tables so that we get predictable handles that are independent of any
 
164
 * previous tests.
 
165
 * 
 
166
 * dgreset will return an error if handles in the old tables are still in use
 
167
 */
 
168
static int
 
169
dgreset_cmd(ClientData clientData, Tcl_Interp * interp, int argc, char *argv[])
 
170
{
 
171
        dgrInterp_t *dg = (dgrInterp_t *)clientData;
 
172
 
 
173
        if (tclhandleReset(dg->graphTable, 10) == TCL_ERROR) {
 
174
                Tcl_AppendResult(interp, "graph handles still in use", (char *) NULL);
 
175
                return TCL_ERROR;
 
176
        }
 
177
        if (tclhandleReset(dg->nodeTable, 100) == TCL_ERROR) {
 
178
                Tcl_AppendResult(interp, "node handles still in use", (char *) NULL);
 
179
                return TCL_ERROR;
 
180
        }
 
181
        if (tclhandleReset(dg->edgeTable, 100) == TCL_ERROR) {
 
182
                Tcl_AppendResult(interp, "edge handles still in use", (char *) NULL);
 
183
                return TCL_ERROR;
 
184
        }
 
185
        return TCL_OK;
 
186
}
 
187
 
 
188
static int
 
189
dg_cmd(ClientData clientData, Tcl_Interp * interp, int argc, char *argv[])
 
190
{
 
191
        char            c;
 
192
        dgrInterp_t *dg = (dgrInterp_t *)clientData;
 
193
 
 
194
        /* first use determines mode */
 
195
        if (dg->object_commands == -1) {
 
196
                dg->object_commands = 0;
 
197
                Tcl_DeleteCommand(interp, "dgnew");
 
198
                Tcl_DeleteCommand(interp, "dgread");
 
199
                Tcl_DeleteCommand(interp, "dgstring");
 
200
        }
 
201
 
 
202
        if ((argc < 2) || strlen(argv[1]) < 3) {
 
203
                Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
 
204
                        "\"method ...\"",  "where method is one of:",
 
205
                        "\n\tread, graph, digraph, strictgraph, strictdigraph,",
 
206
                        "\n\t<graphhandle>, <nodehandle>, <edgehandle>.", (char *) NULL);
 
207
                return TCL_ERROR;
 
208
        }
 
209
        c = argv[1][2];
 
210
        if (c == 'N') {
 
211
                return nodecmd(clientData, interp, argc-1, &argv[1]);
 
212
        } else if (c == 'E') {
 
213
                return edgecmd(clientData, interp, argc-1, &argv[1]);
 
214
        } else if (c == 'G') {
 
215
                return graphcmd(clientData, interp, argc-1, &argv[1]);
 
216
        } else if (strncmp(argv[1], "new", 3) == 0) {
 
217
                return dgnew_cmd(clientData, interp, argc-1, &argv[1]);
 
218
        } else if (strncmp(argv[1], "read", 4) == 0) {
 
219
                return dgread_cmd(clientData, interp, argc-1, &argv[1]);
 
220
        } else if (strncmp(argv[1], "string", 6) == 0) {
 
221
                return dgstring_cmd(clientData, interp, argc-1, &argv[1]);
 
222
        } 
 
223
        Tcl_AppendResult(interp, "invalid method: ", argv[1], (char *) NULL);
 
224
        return TCL_ERROR;
 
225
}
 
226
 
 
227
int 
 
228
Tcldgr_Init(Tcl_Interp * interp)
 
229
{
 
230
        dgrInterp_t *dg = &dgrInterp;
 
231
 
 
232
#ifdef USE_TCL_STUBS
 
233
        if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
 
234
                return TCL_ERROR;
 
235
        }
 
236
#else
 
237
        if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 0) == NULL) {
 
238
                return TCL_ERROR;
 
239
        }
 
240
#endif
 
241
        if (Tcl_PkgProvide(interp, "Tcldgr", VERSION) != TCL_OK) {
 
242
                return TCL_ERROR;
 
243
        }
 
244
 
 
245
/* FIXME - this is what we want
 
246
 *      dg = (dgrInterp_t *)Tcl_Alloc(sizeof(dgrInterp_t));
 
247
 */
 
248
 
 
249
        dg->object_commands = -1;
 
250
        dg->graphTable = tclhandleInit("dgG",sizeof(dgGraph_t), 10);
 
251
        dg->nodeTable = tclhandleInit("dgN",sizeof(Agnode_t *), 100);
 
252
        dg->edgeTable = tclhandleInit("dgE",sizeof(Agedge_t *), 100);
 
253
        dg->interp = interp;
 
254
 
 
255
        Tcl_CreateCommand(interp, "dg", dg_cmd, (ClientData)dg,
 
256
                (Tcl_CmdDeleteProc *) NULL);
 
257
        Tcl_CreateCommand(interp, "dgnew", dgnew_cmd, (ClientData)dg,
 
258
                (Tcl_CmdDeleteProc *) NULL);
 
259
        Tcl_CreateCommand(interp, "dgread", dgread_cmd, (ClientData)dg,
 
260
                (Tcl_CmdDeleteProc *) NULL);
 
261
        Tcl_CreateCommand(interp, "dgstring", dgstring_cmd, (ClientData)dg,
 
262
                (Tcl_CmdDeleteProc *) NULL);
 
263
        Tcl_CreateCommand(interp, "dgreset", dgreset_cmd, (ClientData)dg,
 
264
                (Tcl_CmdDeleteProc *) NULL);
 
265
 
 
266
        return TCL_OK;
 
267
}
 
268
 
 
269
int 
 
270
Tcldgr_SafeInit(Tcl_Interp * interp)
 
271
{
 
272
        return Tcldgr_Init(interp);
 
273
}