Graphviz 13.0.0~dev.20250424.1043
Loading...
Searching...
No Matches
tcldot.c
Go to the documentation of this file.
1/*************************************************************************
2 * Copyright (c) 2011 AT&T Intellectual Property
3 * All rights reserved. This program and the accompanying materials
4 * are made available under the terms of the Eclipse Public License v1.0
5 * which accompanies this distribution, and is available at
6 * https://www.eclipse.org/legal/epl-v10.html
7 *
8 * Contributors: Details at https://graphviz.org
9 *************************************************************************/
10
11#include "tcldot.h"
12#include "../tcl-compat.h"
13#include <cgraph/rdr.h>
14#include <stdlib.h>
15#include <string.h>
16#include <tcl.h>
17#include <util/alloc.h>
18
19static int dotnew_internal(ClientData clientData, Tcl_Interp *interp, int argc,
20 char *argv[]) {
21 ictx_t *ictx = (ictx_t *)clientData;
22 Agraph_t *g;
23 int i;
24 Agdesc_t kind;
25
26 if ((argc < 2)) {
27 Tcl_AppendResult(
28 interp, "wrong # args: should be \"", argv[0],
29 " graphtype ?graphname? ?attributename attributevalue? ?...?\"", NULL);
30 return TCL_ERROR;
31 }
32 if (strcmp("digraph", argv[1]) == 0) {
33 kind = Agdirected;
34 } else if (strcmp("digraphstrict", argv[1]) == 0) {
35 kind = Agstrictdirected;
36 } else if (strcmp("graph", argv[1]) == 0) {
37 kind = Agundirected;
38 } else if (strcmp("graphstrict", argv[1]) == 0) {
39 kind = Agstrictundirected;
40 } else {
41 Tcl_AppendResult(interp, "bad graphtype \"", argv[1], "\": must be one of:",
42 "\n\tdigraph, digraphstrict, graph, graphstrict.", NULL);
43 return TCL_ERROR;
44 }
45 if (argc % 2) {
46 /* if odd number of args then argv[2] is name */
47 g = agopen(argv[2], kind, (Agdisc_t *)ictx);
48 i = 3;
49 } else {
50 /* else use handle as name */
51#if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 4
52 char *name = gv_strdup(Tcl_GetStringResult(interp));
53 g = agopen(name, kind, (Agdisc_t *)ictx);
54 free(name);
55#else
56 g = agopen(Tcl_GetStringResult(interp), kind, (Agdisc_t *)ictx);
57#endif
58 i = 2;
59 }
60 if (!g) {
61 Tcl_AppendResult(interp, "\nFailure to open graph.", NULL);
62 return TCL_ERROR;
63 }
64 setgraphattributes(g, &argv[i], (Tcl_Size)(argc - i));
65 Tcl_AppendResult(interp, obj2cmd(g), NULL);
66
67 return TCL_OK;
68}
69
70static int dotnew(ClientData clientData, Tcl_Interp *interp, int argc,
71 const char *argv[]) {
72 char **argv_copy = tcldot_argv_dup(argc, argv);
73 int rc = dotnew_internal(clientData, interp, argc, argv_copy);
74 tcldot_argv_free(argc, argv_copy);
75 return rc;
76}
77
78static int dotread(ClientData clientData, Tcl_Interp *interp, int argc,
79 const char *argv[]) {
80 Agraph_t *g;
81 Tcl_Channel channel;
82 int mode;
83 ictx_t *ictx = (ictx_t *)clientData;
84
85 ictx->myioDisc.afread =
86 myiodisc_afread; /* replace afread to use Tcl Channels */
87
88 if (argc < 2) {
89 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
90 " fileHandle\"", NULL);
91 return TCL_ERROR;
92 }
93 channel = Tcl_GetChannel(interp, argv[1], &mode);
94 if (channel == NULL || !(mode & TCL_READABLE)) {
95 Tcl_AppendResult(interp, "\nChannel \"", argv[1], "\"", "is unreadable.",
96 NULL);
97 return TCL_ERROR;
98 }
99 /*
100 * read a graph from the channel, the channel is left open
101 * ready to read the first line after the last line of
102 * a properly parsed graph. If the graph doesn't parse
103 * during reading then the channel will be left at EOF
104 */
105 g = agread((FILE *)channel, (Agdisc_t *)clientData);
106 if (!g) {
107 Tcl_AppendResult(interp, "\nFailure to read graph \"", argv[1], "\"", NULL);
108 if (agerrors()) {
109 Tcl_AppendResult(interp, " because of syntax errors.", NULL);
110 }
111 return TCL_ERROR;
112 }
113 if (agerrors()) {
114 Tcl_AppendResult(interp, "\nSyntax errors in file \"", argv[1], " \"",
115 NULL);
116 return TCL_ERROR;
117 }
118 Tcl_AppendResult(interp, obj2cmd(g), NULL);
119 return TCL_OK;
120}
121
122static int dotstring(ClientData clientData, Tcl_Interp *interp, int argc,
123 const char *argv[]) {
124 Agraph_t *g;
125 ictx_t *ictx = (ictx_t *)clientData;
126 rdr_t rdr;
127
128 if (argc < 2) {
129 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " string\"",
130 NULL);
131 return TCL_ERROR;
132 }
133
134 ictx->myioDisc.afread =
135 myiodisc_memiofread; /* replace afread to use memory range */
136 rdr.data = argv[1];
137 rdr.len = strlen(rdr.data);
138 rdr.cur = 0;
139
140 /* agmemread() is broken for our use because it replaces the id disc */
141 g = agread(&rdr, (Agdisc_t *)clientData);
142 if (!g) {
143 Tcl_AppendResult(interp, "\nFailure to read string \"", argv[1], "\"",
144 NULL);
145 if (agerrors()) {
146 Tcl_AppendResult(interp, " because of syntax errors.", NULL);
147 }
148 return TCL_ERROR;
149 }
150 if (agerrors()) {
151 Tcl_AppendResult(interp, "\nSyntax errors in string \"", argv[1], " \"",
152 NULL);
153 return TCL_ERROR;
154 }
155 Tcl_AppendResult(interp, obj2cmd(g), NULL);
156 return TCL_OK;
157}
158
159int Tcldot_Init(Tcl_Interp *interp);
160int Tcldot_Init(Tcl_Interp *interp) {
161 ictx_t *ictx = calloc(1, sizeof(ictx_t));
162 if (!ictx)
163 return TCL_ERROR;
164
165 ictx->interp = interp;
166 /* build disciplines dynamically so we can selectively replace functions */
167
168 ictx->myioDisc.afread =
169 NULL; /* set in dotread() or dotstring() according to need */
170 ictx->myioDisc.putstr = AgIoDisc.putstr; /* no change */
171 ictx->myioDisc.flush = AgIoDisc.flush; /* no change */
172
173 ictx->mydisc.id = &myiddisc; /* complete replacement */
174 ictx->mydisc.io = &(ictx->myioDisc); /* change parts */
175
176 ictx->ctr = 1; /* init to first odd number, increment by 2 */
177
178#ifdef USE_TCL_STUBS
179 if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
180 return TCL_ERROR;
181 }
182#else
183 if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 0) == NULL) {
184 return TCL_ERROR;
185 }
186#endif
187 // inter-release Graphviz versions have a number including '~dev.' that does
188 // not comply with TCL version number rules, so replace this with 'b'
189 char adjusted_version[sizeof(PACKAGE_VERSION)] = PACKAGE_VERSION;
190 char *tilde_dev = strstr(adjusted_version, "~dev.");
191 if (tilde_dev != NULL) {
192 *tilde_dev = 'b';
193 memmove(tilde_dev + 1, tilde_dev + strlen("~dev."),
194 strlen(tilde_dev + strlen("~dev.")) + 1);
195 }
196 if (Tcl_PkgProvide(interp, "Tcldot", adjusted_version) != TCL_OK) {
197 return TCL_ERROR;
198 }
199
200#ifdef HAVE_LIBGD
201 Gdtclft_Init(interp);
202#endif
203
204 /* create a GraphViz Context and pass a pointer to it in clientdata */
205 ictx->gvc = gvContextPlugins(lt_preloaded_symbols, DEMAND_LOADING);
206
207 Tcl_CreateCommand(interp, "dotnew", dotnew, ictx, free);
208 Tcl_CreateCommand(interp, "dotread", dotread, ictx, NULL);
209 Tcl_CreateCommand(interp, "dotstring", dotstring, ictx, NULL);
210
211 return TCL_OK;
212}
213
214int Tcldot_SafeInit(Tcl_Interp *interp);
215int Tcldot_SafeInit(Tcl_Interp *interp) { return Tcldot_Init(interp); }
216
217int Tcldot_builtin_Init(Tcl_Interp *interp);
218int Tcldot_builtin_Init(Tcl_Interp *interp) { return Tcldot_Init(interp); }
Memory allocation wrappers that exit on failure.
static char * gv_strdup(const char *original)
Definition alloc.h:101
mode
Definition cvtgxl.c:33
lt_symlist_t lt_preloaded_symbols[]
Tcl_AppInitProc Gdtclft_Init
Definition gdtclft.c:42
void free(void *)
node NULL
Definition grammar.y:163
Agiodisc_t AgIoDisc
Definition io.c:39
int agerrors(void)
Definition agerror.c:181
Agdesc_t Agundirected
undirected
Definition graph.c:276
Agdesc_t Agstrictundirected
strict undirected
Definition graph.c:277
Agdesc_t Agstrictdirected
strict directed. A strict graph cannot have multi-edges or self-arcs.
Definition graph.c:275
Agraph_t * agopen(char *name, Agdesc_t desc, Agdisc_t *disc)
creates a new graph with the given name and kind
Definition graph.c:44
Agraph_t * agread(void *chan, Agdisc_t *disc)
constructs a new graph
Definition grammar.c:2300
Agdesc_t Agdirected
directed
Definition graph.c:274
GVC_t * gvContextPlugins(const lt_symlist_t *builtins, int demand_loading)
Definition gvc.c:35
graph descriptor
Definition cgraph.h:284
user's discipline
Definition cgraph.h:336
Agiddisc_t * id
Definition cgraph.h:337
Agiodisc_t * io
Definition cgraph.h:338
int(* afread)(void *chan, char *buf, int bufsize)
Definition cgraph.h:327
int(* flush)(void *chan)
Definition cgraph.h:329
int(* putstr)(void *chan, const char *str)
Definition cgraph.h:328
graph or subgraph
Definition cgraph.h:424
Tcl_Interp * interp
Definition tcldot.h:29
uint64_t ctr
Definition tcldot.h:28
Agdisc_t mydisc
Definition tcldot.h:26
Agiodisc_t myioDisc
Definition tcldot.h:27
GVC_t * gvc
Definition tcldot.h:30
Definition rdr.h:10
size_t cur
Definition rdr.h:13
const char * data
Definition rdr.h:11
size_t len
Definition rdr.h:12
#define Tcl_Size
Definition tcl-compat.h:33
Agiddisc_t myiddisc
Definition tcldot-id.c:92
int myiodisc_memiofread(void *chan, char *buf, int bufsize)
Definition tcldot-io.c:89
int myiodisc_afread(void *channel, char *ubuf, int n)
Definition tcldot-io.c:32
void setgraphattributes(Agraph_t *g, char *argv[], Tcl_Size argc)
char * obj2cmd(void *obj)
Definition tcldot-util.c:64
void tcldot_argv_free(int argc, char *argv[])
free the strings pointed to by argv
char ** tcldot_argv_dup(int argc, const char *argv[])
duplicate the strings pointed to by argv as non-const strings
int Tcldot_SafeInit(Tcl_Interp *interp)
Definition tcldot.c:215
int Tcldot_Init(Tcl_Interp *interp)
Definition tcldot.c:160
int Tcldot_builtin_Init(Tcl_Interp *interp)
Definition tcldot.c:218
static int dotstring(ClientData clientData, Tcl_Interp *interp, int argc, const char *argv[])
Definition tcldot.c:122
static int dotnew_internal(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
Definition tcldot.c:19
static int dotread(ClientData clientData, Tcl_Interp *interp, int argc, const char *argv[])
Definition tcldot.c:78
static int dotnew(ClientData clientData, Tcl_Interp *interp, int argc, const char *argv[])
Definition tcldot.c:70
#define Tcl_GetStringResult(interp)
Definition tclpathplan.c:44