GDTCLFT = $(top_srcdir)/tclpkg/gdtclft/gdtclft.c
endif
-libtcldot_la_SOURCES = tcldot.c no_builtins.c $(GDTCLFT)
+libtcldot_la_SOURCES = tcldot.c tcldot-graphcmd.c tcldot-nodecmd.c tcldot-edgecmd.c tcldot-util.c no_builtins.c $(GDTCLFT)
libtcldot_la_CPPFLAGS = $(AM_CPPFLAGS) -DDEMAND_LOADING=1
libtcldot_la_LDFLAGS = -no-undefined
libtcldot_la_LIBADD += $(LIBGEN_LIBS) $(MATH_LIBS)
-libtcldot_builtin_la_SOURCES = tcldot.c tcldot_builtins.c $(GDTCLFT)
+libtcldot_builtin_la_SOURCES = tcldot.c tcldot-graphcmd.c tcldot-nodecmd.c tcldot-edgecmd.c tcldot-util.c tcldot_builtins.c $(GDTCLFT)
libtcldot_builtin_la_CPPFLAGS = $(AM_CPPFLAGS) -DDEMAND_LOADING=1
libtcldot_builtin_la_LDFLAGS =
--- /dev/null
+/* $Id$ $Revision$ */
+/* vim:set shiftwidth=4 ts=8: */
+
+/*************************************************************************
+ * Copyright (c) 2011 AT&T Intellectual Property
+ * All rights reserved. This program and the accompanying materials
+ * are made available under the terms of the Eclipse Public License v1.0
+ * which accompanies this distribution, and is available at
+ * http://www.eclipse.org/legal/epl-v10.html
+ *
+ * Contributors: See CVS logs. Details at http://www.graphviz.org/
+ *************************************************************************/
+
+#include "tcldot.h"
+
+int edgecmd(ClientData clientData, Tcl_Interp * interp,
+#ifndef TCLOBJ
+ int argc, char *argv[]
+#else /* TCLOBJ */
+ int argc, Tcl_Obj * CONST objv[]
+#endif /* TCLOBJ */
+ )
+{
+ char c, buf[16], *s, **argv2;
+ int i, j, length, argc2;
+ Agraph_t *g;
+ Agedge_t **ep, *e;
+ Agsym_t *a;
+ mycontext_t *mycontext = (mycontext_t *)clientData;
+ GVC_t *gvc = mycontext->gvc;
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], "\" option ?arg arg ...?",
+ NULL);
+ return TCL_ERROR;
+ }
+ if (!(ep = (Agedge_t **) tclhandleXlate(mycontext->edgeTblPtr, argv[0]))) {
+ Tcl_AppendResult(interp, " \"", argv[0], "\"", NULL);
+ return TCL_ERROR;
+ }
+ e = *ep;
+ g = agraphof(agtail(e));
+
+ c = argv[1][0];
+ length = strlen(argv[1]);
+
+ if ((c == 'd') && (strncmp(argv[1], "delete", length) == 0)) {
+#ifndef WITH_CGRAPH
+ tclhandleFreeIndex(mycontext->edgeTblPtr, AGID(e));
+ Tcl_DeleteCommand(interp, argv[0]);
+#endif
+ agdelete(g, e);
+ reset_layout(gvc, g);
+ return TCL_OK;
+
+ } else if ((c == 'l')
+ && (strncmp(argv[1], "listattributes", length) == 0)) {
+ listEdgeAttrs (interp, g);
+ return TCL_OK;
+
+ } else if ((c == 'l') && (strncmp(argv[1], "listnodes", length) == 0)) {
+ tclhandleString(mycontext->nodeTblPtr, buf, AGID(agtail(e)));
+ Tcl_AppendElement(interp, buf);
+ tclhandleString(mycontext->nodeTblPtr, buf, AGID(aghead(e)));
+ Tcl_AppendElement(interp, buf);
+ return TCL_OK;
+
+ } else if ((c == 'q')
+ && (strncmp(argv[1], "queryattributes", length) == 0)) {
+ for (i = 2; i < argc; i++) {
+ if (Tcl_SplitList
+ (interp, argv[i], &argc2,
+ (CONST84 char ***) &argv2) != TCL_OK)
+ return TCL_ERROR;
+ for (j = 0; j < argc2; j++) {
+ if ((a = agfindedgeattr(g, argv2[j]))) {
+#ifndef WITH_CGRAPH
+ Tcl_AppendElement(interp, agxget(e, a->index));
+#else
+ Tcl_AppendElement(interp, agxget(e, a));
+#endif
+ } else {
+ Tcl_AppendResult(interp, " No attribute named \"",
+ argv2[j], "\"", NULL);
+ return TCL_ERROR;
+ }
+ }
+ Tcl_Free((char *) argv2);
+ }
+ return TCL_OK;
+
+ } else if ((c == 'q')
+ && (strncmp(argv[1], "queryattributevalues", length) ==
+ 0)) {
+ for (i = 2; i < argc; i++) {
+ if (Tcl_SplitList
+ (interp, argv[i], &argc2,
+ (CONST84 char ***) &argv2) != TCL_OK)
+ return TCL_ERROR;
+ for (j = 0; j < argc2; j++) {
+ if ((a = agfindedgeattr(g, argv2[j]))) {
+ Tcl_AppendElement(interp, argv2[j]);
+#ifndef WITH_CGRAPH
+ Tcl_AppendElement(interp, agxget(e, a->index));
+#else
+ Tcl_AppendElement(interp, agxget(e, a));
+#endif
+ } else {
+ Tcl_AppendResult(interp, " No attribute named \"", argv2[j], "\"", NULL);
+ return TCL_ERROR;
+ }
+ }
+ Tcl_Free((char *) argv2);
+ }
+ return TCL_OK;
+
+ } else if ((c == 's')
+ && (strncmp(argv[1], "setattributes", length) == 0)) {
+ if (argc == 3) {
+ if (Tcl_SplitList
+ (interp, argv[2], &argc2,
+ (CONST84 char ***) &argv2) != TCL_OK)
+ return TCL_ERROR;
+ if ((argc2 == 0) || (argc2 % 2)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ "\" setattributes attributename attributevalue ?attributename attributevalue? ?...?",
+ NULL);
+ Tcl_Free((char *) argv2);
+ return TCL_ERROR;
+ }
+ setedgeattributes(agroot(g), e, argv2, argc2);
+ Tcl_Free((char *) argv2);
+ } else {
+ if ((argc < 4) || (argc % 2)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0],
+ "\" setattributes attributename attributevalue ?attributename attributevalue? ?...?",
+ NULL);
+ return TCL_ERROR;
+ }
+ setedgeattributes(agroot(g), e, &argv[2], argc - 2);
+ }
+ reset_layout(gvc, g);
+ return TCL_OK;
+
+ } else if ((c == 's') && (strncmp(argv[1], "showname", length) == 0)) {
+ if (agisdirected(g))
+ s = "->";
+ else
+ s = "--";
+ Tcl_AppendResult(interp,
+ agnameof(agtail(e)), s, agnameof(aghead(e)), NULL);
+ return TCL_OK;
+
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be one of:",
+ "\n\tdelete, listattributes, listnodes,",
+ "\n\tueryattributes, queryattributevalues,",
+ "\n\tsetattributes, showname", NULL);
+ return TCL_ERROR;
+ }
+}
--- /dev/null
+/* $Id$ $Revision$ */
+/* vim:set shiftwidth=4 ts=8: */
+
+/*************************************************************************
+ * Copyright (c) 2011 AT&T Intellectual Property
+ * All rights reserved. This program and the accompanying materials
+ * are made available under the terms of the Eclipse Public License v1.0
+ * which accompanies this distribution, and is available at
+ * http://www.eclipse.org/legal/epl-v10.html
+ *
+ * Contributors: See CVS logs. Details at http://www.graphviz.org/
+ *************************************************************************/
+
+#include "tcldot.h"
+
+int graphcmd(ClientData clientData, Tcl_Interp * interp,
+#ifndef TCLOBJ
+ int argc, char *argv[]
+#else
+ int argc, Tcl_Obj * CONST objv[]
+#endif
+ )
+{
+
+ Agraph_t *g, **gp, *sg, **sgp;
+ Agnode_t **np, *n, *tail, *head;
+ Agedge_t **ep, *e;
+ Agsym_t *a;
+ char c, buf[256], **argv2;
+ int i, j, length, argc2, rc;
+ unsigned long id;
+ mycontext_t *mycontext = (mycontext_t *)clientData;
+ GVC_t *gvc = mycontext->gvc;
+ GVJ_t *job = gvc->job;
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " option ?arg arg ...?\"",
+ NULL);
+ return TCL_ERROR;
+ }
+ if (!(gp = (Agraph_t **) tclhandleXlate(mycontext->graphTblPtr, argv[0]))) {
+ Tcl_AppendResult(interp, " \"", argv[0], "\"", NULL);
+ return TCL_ERROR;
+ }
+
+ g = *gp;
+
+ c = argv[1][0];
+ length = strlen(argv[1]);
+
+ if ((c == 'a') && (strncmp(argv[1], "addedge", length) == 0)) {
+ if ((argc < 4) || (argc % 2)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " addedge tail head ?attributename attributevalue? ?...?\"",
+ NULL);
+ return TCL_ERROR;
+ }
+ if (!(np = (Agnode_t **) tclhandleXlate(mycontext->nodeTblPtr, argv[2]))) {
+ if (!(tail = agfindnode(g, argv[2]))) {
+ Tcl_AppendResult(interp, "Tail node \"", argv[2],
+ "\" not found.", NULL);
+ return TCL_ERROR;
+ }
+ } else {
+ tail = *np;
+ if (agroot(g) != agroot(agraphof(tail))) {
+ Tcl_AppendResult(interp, "Node ", argv[2],
+ " is not in the graph.", NULL);
+ return TCL_ERROR;
+ }
+ }
+ if (!(np = (Agnode_t **) tclhandleXlate(mycontext->nodeTblPtr, argv[3]))) {
+ if (!(head = agfindnode(g, argv[3]))) {
+ Tcl_AppendResult(interp, "Head node \"", argv[3],
+ "\" not found.", NULL);
+ return TCL_ERROR;
+ }
+ } else {
+ head = *np;
+ if (agroot(g) != agroot(agraphof(head))) {
+ Tcl_AppendResult(interp, "Node ", argv[3],
+ " is not in the graph.", NULL);
+ return TCL_ERROR;
+ }
+ }
+#ifdef WITH_CGRAPH
+ e = agedge(g, tail, head, NULL, 1);
+#else
+ e = agedge(g, tail, head);
+#endif
+ if (!(ep = (Agedge_t **) tclhandleXlateIndex(mycontext->edgeTblPtr, AGID(e))) || *ep != e) {
+ ep = (Agedge_t **) tclhandleAlloc(mycontext->edgeTblPtr, Tcl_GetStringResult(interp), &id);
+ *ep = e;
+ AGID(e) = id;
+#ifndef TCLOBJ
+ Tcl_CreateCommand(interp, Tcl_GetStringResult(interp), edgecmd,
+ (ClientData) mycontext, (Tcl_CmdDeleteProc *) NULL);
+#else /* TCLOBJ */
+ Tcl_CreateObjCommand(interp, Tcl_GetStringResult(interp), edgecmd,
+ (ClientData) mycontext, (Tcl_CmdDeleteProc *) NULL);
+#endif /* TCLOBJ */
+ } else {
+ tclhandleString(mycontext->edgeTblPtr, Tcl_GetStringResult(interp), AGID(e));
+ }
+ setedgeattributes(agroot(g), e, &argv[4], argc - 4);
+ reset_layout(gvc, g);
+ return TCL_OK;
+
+ } else if ((c == 'a') && (strncmp(argv[1], "addnode", length) == 0)) {
+ if (argc % 2) {
+ /* if odd number of args then argv[2] is name */
+#ifdef WITH_CGRAPH
+ n = agnode(g, argv[2], 1);
+#else
+ n = agnode(g, argv[2]);
+ if (!(np = (Agnode_t **) tclhandleXlateIndex(mycontext->nodeTblPtr, AGID(n))) || *np != n) {
+ np = (Agnode_t **) tclhandleAlloc(mycontext->nodeTblPtr, Tcl_GetStringResult(interp), &id);
+ *np = n;
+ AGID(n) = id;
+#ifndef TCLOBJ
+ Tcl_CreateCommand(interp, Tcl_GetStringResult(interp), nodecmd,
+ (ClientData) mycontext, (Tcl_CmdDeleteProc *) NULL);
+#else /* TCLOBJ */
+ Tcl_CreateObjCommand(interp, Tcl_GetStringResult(interp), nodecmd,
+ (ClientData) mycontext, (Tcl_CmdDeleteProc *) NULL);
+#endif /* TCLOBJ */
+ } else {
+ tclhandleString(mycontext->nodeTblPtr, Tcl_GetStringResult(interp), AGID(n));
+ }
+#endif
+ i = 3;
+ } else {
+ /* else use handle as name */
+#ifdef WITH_CGRAPH
+ n = agnode(g, Tcl_GetStringResult(interp), 1);
+#else
+ np = (Agnode_t **) tclhandleAlloc(mycontext->nodeTblPtr, Tcl_GetStringResult(interp), &id);
+ n = agnode(g, Tcl_GetStringResult(interp));
+ *np = n;
+ AGID(n) = id;
+#ifndef TCLOBJ
+ Tcl_CreateCommand(interp, Tcl_GetStringResult(interp), nodecmd,
+ (ClientData) mycontext, (Tcl_CmdDeleteProc *) NULL);
+#else /* TCLOBJ */
+ Tcl_CreateObjCommand(interp, Tcl_GetStringResult(interp), nodecmd,
+ (ClientData) mycontext, (Tcl_CmdDeleteProc *) NULL);
+#endif /* TCLOBJ */
+#endif
+ i = 2;
+ }
+#ifdef WITH_CGRAPH
+ np = (Agnode_t **)tclhandleXlateIndex(mycontext->nodeTblPtr, AGID(n));
+ *np = n;
+#endif
+ setnodeattributes(agroot(g), n, &argv[i], argc - i);
+ reset_layout(gvc, g);
+ return TCL_OK;
+
+ } else if ((c == 'a')
+ && (strncmp(argv[1], "addsubgraph", length) == 0)) {
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ "\" addsubgraph ?name? ?attributename attributevalue? ?...?",
+ NULL);
+ }
+ if (argc % 2) {
+ /* if odd number of args then argv[2] is name */
+#ifdef WITH_CGRAPH
+ sg = agsubg(g, argv[2], 1);
+#else
+ sg = agsubg(g, argv[2]);
+ if (! (sgp = (Agraph_t **) tclhandleXlateIndex(mycontext->graphTblPtr, AGID(sg))) || *sgp != sg) {
+ sgp = (Agraph_t **) tclhandleAlloc(mycontext->graphTblPtr, Tcl_GetStringResult(interp), &id);
+ *sgp = sg;
+ AGID(sg) = id;
+#ifndef TCLOBJ
+ Tcl_CreateCommand(interp, Tcl_GetStringResult(interp), graphcmd,
+ (ClientData) mycontext, (Tcl_CmdDeleteProc *) NULL);
+#else
+ Tcl_CreateObjCommand(interp, Tcl_GetStringResult(interp), graphcmd,
+ (ClientData) mycontext, (Tcl_CmdDeleteProc *) NULL);
+#endif
+ } else {
+ tclhandleString(mycontext->graphTblPtr, Tcl_GetStringResult(interp), AGID(sg));
+ }
+#endif
+ i = 3;
+ } else {
+ /* else use handle as name */
+#ifdef WITH_CGRAPH
+ sg = agsubg(g, Tcl_GetStringResult(interp), 1);
+#else
+ sgp = (Agraph_t **) tclhandleAlloc(mycontext->graphTblPtr, Tcl_GetStringResult(interp), &id);
+ sg = agsubg(g, Tcl_GetStringResult(interp));
+ *sgp = sg;
+ AGID(sg) = id;
+#ifndef TCLOBJ
+ Tcl_CreateCommand(interp, Tcl_GetStringResult(interp), graphcmd,
+ (ClientData) mycontext, (Tcl_CmdDeleteProc *) NULL);
+#else
+ Tcl_CreateObjCommand(interp, Tcl_GetStringResult(interp), graphcmd,
+ (ClientData) mycontext, (Tcl_CmdDeleteProc *) NULL);
+#endif
+#endif
+ i = 2;
+ }
+#ifdef WITH_CGRAPH
+ sgp = (Agraph_t **)tclhandleXlateIndex(mycontext->graphTblPtr, AGID(sg));
+ *sgp = sg;
+#endif
+ setgraphattributes(sg, &argv[i], argc - i);
+ reset_layout(gvc, g);
+ return TCL_OK;
+
+ } else if ((c == 'c') && (strncmp(argv[1], "countnodes", length) == 0)) {
+ sprintf(buf, "%d", agnnodes(g));
+ Tcl_AppendResult(interp, buf, NULL);
+ return TCL_OK;
+
+ } else if ((c == 'c') && (strncmp(argv[1], "countedges", length) == 0)) {
+ sprintf(buf, "%d", agnedges(g));
+ Tcl_AppendResult(interp, buf, NULL);
+ return TCL_OK;
+
+ } else if ((c == 'd') && (strncmp(argv[1], "delete", length) == 0)) {
+ reset_layout(gvc, g);
+#ifndef WITH_CGRAPH
+ deleteNodes(mycontext, g);
+ deleteGraph(mycontext, g);
+#else
+ deleteNodes(g);
+ deleteGraph(g);
+#endif
+ return TCL_OK;
+
+ } else if ((c == 'f') && (strncmp(argv[1], "findedge", length) == 0)) {
+ if (argc < 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " findedge tailnodename headnodename\"", NULL);
+ return TCL_ERROR;
+ }
+ if (!(tail = agfindnode(g, argv[2]))) {
+ Tcl_AppendResult(interp, "Tail node \"", argv[2], "\" not found.", NULL);
+ return TCL_ERROR;
+ }
+ if (!(head = agfindnode(g, argv[3]))) {
+ Tcl_AppendResult(interp, "Head node \"", argv[3], "\" not found.", NULL);
+ return TCL_ERROR;
+ }
+ if (!(e = agfindedge(g, tail, head))) {
+ Tcl_AppendResult(interp, "Edge \"", argv[2], " - ", argv[3], "\" not found.", NULL);
+ return TCL_ERROR;
+ }
+ tclhandleString(mycontext->edgeTblPtr, buf, AGID(e));
+ Tcl_AppendElement(interp, buf);
+ return TCL_OK;
+
+ } else if ((c == 'f') && (strncmp(argv[1], "findnode", length) == 0)) {
+ if (argc < 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " findnode nodename\"", NULL);
+ return TCL_ERROR;
+ }
+ if (!(n = agfindnode(g, argv[2]))) {
+ Tcl_AppendResult(interp, "Node not found.", NULL);
+ return TCL_ERROR;
+ }
+ tclhandleString(mycontext->nodeTblPtr, buf, AGID(n));
+ Tcl_AppendResult(interp, buf, NULL);
+ return TCL_OK;
+
+ } else if ((c == 'l')
+ && (strncmp(argv[1], "layoutedges", length) == 0)) {
+ g = agroot(g);
+ if (!GD_drawing(g))
+ tcldot_layout(gvc, g, (argc > 2) ? argv[2] : NULL);
+ return TCL_OK;
+
+ } else if ((c == 'l')
+ && (strncmp(argv[1], "layoutnodes", length) == 0)) {
+ g = agroot(g);
+ if (!GD_drawing(g))
+ tcldot_layout(gvc, g, (argc > 2) ? argv[2] : NULL);
+ return TCL_OK;
+
+ } else if ((c == 'l')
+ && (strncmp(argv[1], "listattributes", length) == 0)) {
+ listGraphAttrs(interp, g);
+ return TCL_OK;
+
+ } else if ((c == 'l')
+ && (strncmp(argv[1], "listedgeattributes", length) == 0)) {
+ listEdgeAttrs (interp, g);
+ return TCL_OK;
+
+ } else if ((c == 'l')
+ && (strncmp(argv[1], "listnodeattributes", length) == 0)) {
+ listNodeAttrs (interp, g);
+ return TCL_OK;
+
+ } else if ((c == 'l') && (strncmp(argv[1], "listedges", length) == 0)) {
+ for (n = agfstnode(g); n; n = agnxtnode(g, n)) {
+ for (e = agfstout(g, n); e; e = agnxtout(g, e)) {
+ tclhandleString(mycontext->edgeTblPtr, buf, AGID(e));
+ Tcl_AppendElement(interp, buf);
+ }
+ }
+ return TCL_OK;
+
+ } else if ((c == 'l') && (strncmp(argv[1], "listnodes", length) == 0)) {
+ for (n = agfstnode(g); n; n = agnxtnode(g, n)) {
+ tclhandleString(mycontext->nodeTblPtr, buf, AGID(n));
+ Tcl_AppendElement(interp, buf);
+ }
+ return TCL_OK;
+
+ } else if ((c == 'l')
+ && (strncmp(argv[1], "listnodesrev", length) == 0)) {
+ for (n = aglstnode(g); n; n = agprvnode(g, n)) {
+ tclhandleString(mycontext->nodeTblPtr, buf, AGID(n));
+ Tcl_AppendElement(interp, buf);
+ }
+ return TCL_OK;
+
+ } else if ((c == 'l')
+ && (strncmp(argv[1], "listsubgraphs", length) == 0)) {
+#ifdef WITH_CGRAPH
+ for (sg = agfstsubg(g); sg; sg = agnxtsubg(sg)) {
+ tclhandleString(mycontext->graphTblPtr, buf, AGID(sg));
+ Tcl_AppendElement(interp, buf);
+ }
+#else
+ if (g->meta_node) {
+ for (e = agfstout(g->meta_node->graph, g->meta_node); e;
+ e = agnxtout(g->meta_node->graph, e)) {
+ sg = agusergraph(aghead(e));
+ tclhandleString(mycontext->graphTblPtr, buf, AGID(sg));
+ Tcl_AppendElement(interp, buf);
+ }
+ }
+#endif
+ return TCL_OK;
+
+ } else if ((c == 'q')
+ && (strncmp(argv[1], "queryattributes", length) == 0)) {
+ for (i = 2; i < argc; i++) {
+ if (Tcl_SplitList
+ (interp, argv[i], &argc2,
+ (CONST84 char ***) &argv2) != TCL_OK)
+ return TCL_ERROR;
+ for (j = 0; j < argc2; j++) {
+ if ((a = agfindgraphattr(g, argv2[j]))) {
+#ifndef WITH_CGRAPH
+ Tcl_AppendElement(interp, agxget(g, a->index));
+#else
+ Tcl_AppendElement(interp, agxget(g, a));
+#endif
+ } else {
+ Tcl_AppendResult(interp, " No attribute named \"", argv2[j], "\"", NULL);
+ return TCL_ERROR;
+ }
+ }
+ Tcl_Free((char *) argv2);
+ }
+ return TCL_OK;
+
+ } else if ((c == 'q')
+ && (strncmp(argv[1], "queryattributevalues", length) ==
+ 0)) {
+ for (i = 2; i < argc; i++) {
+ if (Tcl_SplitList
+ (interp, argv[i], &argc2,
+ (CONST84 char ***) &argv2) != TCL_OK)
+ return TCL_ERROR;
+ for (j = 0; j < argc2; j++) {
+ if ((a = agfindgraphattr(g, argv2[j]))) {
+ Tcl_AppendElement(interp, argv2[j]);
+#ifndef WITH_CGRAPH
+ Tcl_AppendElement(interp, agxget(g, a->index));
+#else
+ Tcl_AppendElement(interp, agxget(g, a));
+#endif
+ } else {
+ Tcl_AppendResult(interp, " No attribute named \"", argv2[j], "\"", NULL);
+ return TCL_ERROR;
+ }
+ }
+ Tcl_Free((char *) argv2);
+ }
+ return TCL_OK;
+
+ } else if ((c == 'q')
+ && (strncmp(argv[1], "queryedgeattributes", length) == 0)) {
+ for (i = 2; i < argc; i++) {
+ if (Tcl_SplitList
+ (interp, argv[i], &argc2,
+ (CONST84 char ***) &argv2) != TCL_OK)
+ return TCL_ERROR;
+ for (j = 0; j < argc2; j++) {
+ if ((a = agfindedgeattr(g, argv2[j]))) {
+#ifndef WITH_CGRAPH
+ Tcl_AppendElement(interp, agxget(g->proto->e, a->index));
+#else
+ Tcl_AppendElement(interp, agxget(g, a));
+#endif
+ } else {
+ Tcl_AppendResult(interp, " No attribute named \"", argv2[j], "\"", NULL);
+ return TCL_ERROR;
+ }
+ }
+ Tcl_Free((char *) argv2);
+ }
+ return TCL_OK;
+
+ } else if ((c == 'q')
+ && (strncmp(argv[1], "queryedgeattributevalues", length) == 0)) {
+ for (i = 2; i < argc; i++) {
+ if (Tcl_SplitList
+ (interp, argv[i], &argc2,
+ (CONST84 char ***) &argv2) != TCL_OK)
+ return TCL_ERROR;
+ for (j = 0; j < argc2; j++) {
+ if ((a = agfindedgeattr(g, argv2[j]))) {
+ Tcl_AppendElement(interp, argv2[j]);
+#ifndef WITH_CGRAPH
+ Tcl_AppendElement(interp, agxget(g->proto->e, a->index));
+#else
+ Tcl_AppendElement(interp, agxget(g, a));
+#endif
+ } else {
+ Tcl_AppendResult(interp, " No attribute named \"",
+ argv2[j], "\"", NULL);
+ return TCL_ERROR;
+ }
+ }
+ Tcl_Free((char *) argv2);
+ }
+ return TCL_OK;
+
+ } else if ((c == 'q')
+ && (strncmp(argv[1], "querynodeattributes", length) == 0)) {
+ for (i = 2; i < argc; i++) {
+ if (Tcl_SplitList
+ (interp, argv[i], &argc2,
+ (CONST84 char ***) &argv2) != TCL_OK)
+ return TCL_ERROR;
+ for (j = 0; j < argc2; j++) {
+ if ((a = agfindnodeattr(g, argv2[j]))) {
+#ifndef WITH_CGRAPH
+ Tcl_AppendElement(interp, agxget(g->proto->n, a->index));
+#else
+ Tcl_AppendElement(interp, agxget(g, a));
+#endif
+ } else {
+ Tcl_AppendResult(interp, " No attribute named \"",
+ argv2[j], "\"", NULL);
+ return TCL_ERROR;
+ }
+ }
+ Tcl_Free((char *) argv2);
+ }
+ return TCL_OK;
+
+ } else if ((c == 'q')
+ && (strncmp(argv[1], "querynodeattributevalues", length) ==
+ 0)) {
+ for (i = 2; i < argc; i++) {
+ if (Tcl_SplitList
+ (interp, argv[i], &argc2,
+ (CONST84 char ***) &argv2) != TCL_OK)
+ return TCL_ERROR;
+ for (j = 0; j < argc2; j++) {
+ if ((a = agfindnodeattr(g, argv2[j]))) {
+ Tcl_AppendElement(interp, argv2[j]);
+#ifndef WITH_CGRAPH
+ Tcl_AppendElement(interp, agxget(g->proto->n, a->index));
+#else
+ Tcl_AppendElement(interp, agxget(g, a));
+#endif
+ } else {
+ Tcl_AppendResult(interp, " No attribute named \"", argv2[j], "\"", NULL);
+ return TCL_ERROR;
+ }
+ }
+ Tcl_Free((char *) argv2);
+ }
+ return TCL_OK;
+
+ } else if ((c == 'r') && (strncmp(argv[1], "render", length) == 0)) {
+ char *canvas;
+
+ if (argc < 3) {
+ canvas = "$c";
+ } else {
+ canvas = argv[2];
+#if 0 /* not implemented */
+ if (argc < 4) {
+ tkgendata.eval = FALSE;
+ } else {
+ if ((Tcl_GetBoolean(interp, argv[3], &tkgendata.eval)) !=
+ TCL_OK) {
+ Tcl_AppendResult(interp, " Invalid boolean: \"",
+ argv[3], "\"", NULL);
+ return TCL_ERROR;
+ }
+ }
+#endif
+ }
+ rc = gvjobs_output_langname(gvc, "tk");
+ if (rc == NO_SUPPORT) {
+ Tcl_AppendResult(interp, " Format: \"tk\" not recognized.\n", NULL);
+ return TCL_ERROR;
+ }
+
+ gvc->write_fn = Tcldot_string_writer;
+ job = gvc->job;
+ job->imagedata = canvas;
+ job->context = (void *)interp;
+ job->external_context = TRUE;
+ job->output_file = stdout;
+
+ /* make sure that layout is done */
+ g = agroot(g);
+ if (!GD_drawing(g) || argc > 3)
+ tcldot_layout (gvc, g, (argc > 3) ? argv[3] : NULL);
+
+ /* render graph TK canvas commands */
+ gvc->common.viewNum = 0;
+ gvRenderJobs(gvc, g);
+ gvrender_end_job(job);
+ gvdevice_finalize(job);
+ fflush(job->output_file);
+ gvjobs_delete(gvc);
+ return TCL_OK;
+
+#if HAVE_LIBGD
+ } else if ((c == 'r') && (strncmp(argv[1], "rendergd", length) == 0)) {
+ void **hdl;
+
+ if (argc < 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " rendergd gdhandle ?DOT|NEATO|TWOPI|FDP|CIRCO?\"", NULL);
+ return TCL_ERROR;
+ }
+ rc = gvjobs_output_langname(gvc, "gd:gd:gd");
+ if (rc == NO_SUPPORT) {
+ Tcl_AppendResult(interp, " Format: \"gd\" not recognized.\n", NULL);
+ return TCL_ERROR;
+ }
+ job = gvc->job;
+
+ if (! (hdl = tclhandleXlate(GDHandleTable, argv[2]))) {
+ Tcl_AppendResult(interp, "GD Image not found.", NULL);
+ return TCL_ERROR;
+ }
+ job->context = *hdl;
+ job->external_context = TRUE;
+
+ /* make sure that layout is done */
+ g = agroot(g);
+ if (!GD_drawing(g) || argc > 4)
+ tcldot_layout(gvc, g, (argc > 4) ? argv[4] : NULL);
+
+ gvc->common.viewNum = 0;
+ gvRenderJobs(gvc, g);
+ gvrender_end_job(job);
+ gvdevice_finalize(job);
+ fflush(job->output_file);
+ gvjobs_delete(gvc);
+ Tcl_AppendResult(interp, argv[2], NULL);
+ return TCL_OK;
+#endif
+
+ } else if ((c == 's')
+ && (strncmp(argv[1], "setattributes", length) == 0)) {
+ if (argc == 3) {
+ if (Tcl_SplitList
+ (interp, argv[2], &argc2,
+ (CONST84 char ***) &argv2) != TCL_OK)
+ return TCL_ERROR;
+ if ((argc2 == 0) || (argc2 % 2)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ "\" setattributes attributename attributevalue ?attributename attributevalue? ?...?",
+ NULL);
+ Tcl_Free((char *) argv2);
+ return TCL_ERROR;
+ }
+ setgraphattributes(g, argv2, argc2);
+ Tcl_Free((char *) argv2);
+ reset_layout(gvc, g);
+ }
+ if (argc == 4 && strcmp(argv[2], "viewport") == 0) {
+ /* special case to allow viewport to be set without resetting layout */
+ setgraphattributes(g, &argv[2], argc - 2);
+ } else {
+ if ((argc < 4) || (argc % 2)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ "\" setattributes attributename attributevalue ?attributename attributevalue? ?...?",
+ NULL);
+ return TCL_ERROR;
+ }
+ setgraphattributes(g, &argv[2], argc - 2);
+ reset_layout(gvc, g);
+ }
+ return TCL_OK;
+
+ } else if ((c == 's')
+ && (strncmp(argv[1], "setedgeattributes", length) == 0)) {
+ if (argc == 3) {
+ if (Tcl_SplitList
+ (interp, argv[2], &argc2,
+ (CONST84 char ***) &argv2) != TCL_OK)
+ return TCL_ERROR;
+ if ((argc2 == 0) || (argc2 % 2)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ "\" setedgeattributes attributename attributevalue ?attributename attributevalue? ?...?",
+ NULL);
+ Tcl_Free((char *) argv2);
+ return TCL_ERROR;
+ }
+#ifndef WITH_CGRAPH
+ setedgeattributes(g, g->proto->e, argv2, argc2);
+#else
+ setedgeattributes(g, NULL, argv2, argc2);
+#endif
+ Tcl_Free((char *) argv2);
+ } else {
+ if ((argc < 4) || (argc % 2)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ "\" setedgeattributes attributename attributevalue ?attributename attributevalue? ?...?",
+ NULL);
+ }
+#ifndef WITH_CGRAPH
+ setedgeattributes(g, g->proto->e, &argv[2], argc - 2);
+#else
+ setedgeattributes(g, NULL, &argv[2], argc - 2);
+#endif
+ }
+ reset_layout(gvc, g);
+ return TCL_OK;
+
+ } else if ((c == 's')
+ && (strncmp(argv[1], "setnodeattributes", length) == 0)) {
+ if (argc == 3) {
+ if (Tcl_SplitList
+ (interp, argv[2], &argc2,
+ (CONST84 char ***) &argv2) != TCL_OK)
+ return TCL_ERROR;
+ if ((argc2 == 0) || (argc2 % 2)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ "\" setnodeattributes attributename attributevalue ?attributename attributevalue? ?...?",
+ NULL);
+ Tcl_Free((char *) argv2);
+ return TCL_ERROR;
+ }
+#ifndef WITH_CGRAPH
+ setnodeattributes(g, g->proto->n, argv2, argc2);
+#else
+ setnodeattributes(g, NULL, argv2, argc2);
+#endif
+ Tcl_Free((char *) argv2);
+ } else {
+ if ((argc < 4) || (argc % 2)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ "\" setnodeattributes attributename attributevalue ?attributename attributevalue? ?...?",
+ NULL);
+ }
+#ifndef WITH_CGRAPH
+ setnodeattributes(g, g->proto->n, &argv[2], argc - 2);
+#else
+ setnodeattributes(g, NULL, &argv[2], argc - 2);
+#endif
+ }
+ reset_layout(gvc, g);
+ return TCL_OK;
+
+ } else if ((c == 's') && (strncmp(argv[1], "showname", length) == 0)) {
+ Tcl_SetResult(interp, agnameof(g), TCL_STATIC);
+ return TCL_OK;
+
+ } else if ((c == 'w') && (strncmp(argv[1], "write", length) == 0)) {
+ g = agroot(g);
+ if (argc < 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " write fileHandle ?language ?DOT|NEATO|TWOPI|FDP|CIRCO|NOP??\"",
+ NULL);
+ return TCL_ERROR;
+ }
+
+ /* process lang first to create job */
+ if (argc < 4) {
+ i = gvjobs_output_langname(gvc, "dot");
+ } else {
+ i = gvjobs_output_langname(gvc, argv[3]);
+ }
+ if (i == NO_SUPPORT) {
+ const char *s = gvplugin_list(gvc, API_render, argv[3]);
+ Tcl_AppendResult(interp, "Bad langname: \"", argv[3], "\". Use one of:", s, NULL);
+ return TCL_ERROR;
+ }
+
+ gvc->write_fn = Tcldot_channel_writer;
+ job = gvc->job;
+
+ /* populate new job struct with output language and output file data */
+ job->output_lang = gvrender_select(job, job->output_langname);
+
+// if (Tcl_GetOpenFile (interp, argv[2], 1, 1, &outfp) != TCL_OK)
+// return TCL_ERROR;
+// job->output_file = (FILE *)outfp;
+
+ {
+ Tcl_Channel chan;
+ int mode;
+
+ chan = Tcl_GetChannel(interp, argv[2], &mode);
+
+ if (!chan) {
+ Tcl_AppendResult(interp, "Channel not open: \"", argv[2], NULL);
+ return TCL_ERROR;
+ }
+ if (!(mode & TCL_WRITABLE)) {
+ Tcl_AppendResult(interp, "Channel not writable: \"", argv[2], NULL);
+ return TCL_ERROR;
+ }
+ job->output_file = (FILE *)chan;
+ }
+ job->output_filename = NULL;
+
+ /* make sure that layout is done - unless canonical output */
+ if ((!GD_drawing(g) || argc > 4) && !(job->flags & LAYOUT_NOT_REQUIRED)) {
+ tcldot_layout(gvc, g, (argc > 4) ? argv[4] : NULL);
+ }
+
+ gvc->common.viewNum = 0;
+ gvRenderJobs(gvc, g);
+ gvdevice_finalize(job);
+// fflush(job->output_file);
+ gvjobs_delete(gvc);
+ return TCL_OK;
+
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be one of:",
+ "\n\taddedge, addnode, addsubgraph, countedges, countnodes,",
+ "\n\tlayout, listattributes, listedgeattributes, listnodeattributes,",
+ "\n\tlistedges, listnodes, listsubgraphs, render, rendergd,",
+ "\n\tqueryattributes, queryedgeattributes, querynodeattributes,",
+ "\n\tqueryattributevalues, queryedgeattributevalues, querynodeattributevalues,",
+ "\n\tsetattributes, setedgeattributes, setnodeattributes,",
+ "\n\tshowname, write.", NULL);
+ return TCL_ERROR;
+ }
+} /* graphcmd */
--- /dev/null
+/* $Id$ $Revision$ */
+/* vim:set shiftwidth=4 ts=8: */
+
+/*************************************************************************
+ * Copyright (c) 2011 AT&T Intellectual Property
+ * All rights reserved. This program and the accompanying materials
+ * are made available under the terms of the Eclipse Public License v1.0
+ * which accompanies this distribution, and is available at
+ * http://www.eclipse.org/legal/epl-v10.html
+ *
+ * Contributors: See CVS logs. Details at http://www.graphviz.org/
+ *************************************************************************/
+
+#include "tcldot.h"
+
+int nodecmd(ClientData clientData, Tcl_Interp * interp,
+#ifndef TCLOBJ
+ int argc, char *argv[]
+#else /* TCLOBJ */
+ int argc, Tcl_Obj * CONST objv[]
+#endif /* TCLOBJ */
+ )
+{
+ unsigned long id;
+ char c, buf[16], **argv2;
+ int i, j, length, argc2;
+ Agraph_t *g;
+ Agnode_t **np, *n, *head;
+ Agedge_t **ep, *e;
+ Agsym_t *a;
+ mycontext_t *mycontext = (mycontext_t *)clientData;
+ GVC_t *gvc = mycontext->gvc;
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " option ?arg arg ...?\"",
+ NULL);
+ return TCL_ERROR;
+ }
+ if (!(np = (Agnode_t **) tclhandleXlate(mycontext->nodeTblPtr, argv[0]))) {
+ Tcl_AppendResult(interp, " \"", argv[0], "\"", NULL);
+ return TCL_ERROR;
+ }
+ n = *np;
+ g = agraphof(n);
+
+ c = argv[1][0];
+ length = strlen(argv[1]);
+
+
+ if ((c == 'a') && (strncmp(argv[1], "addedge", length) == 0)) {
+ if ((argc < 3) || (!(argc % 2))) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0],
+ " addedge head ?attributename attributevalue? ?...?\"",
+ NULL);
+ return TCL_ERROR;
+ }
+ if (!(np = (Agnode_t **) tclhandleXlate(mycontext->nodeTblPtr, argv[2]))) {
+ if (!(head = agfindnode(g, argv[2]))) {
+ Tcl_AppendResult(interp, "Head node \"", argv[2],
+ "\" not found.", NULL);
+ return TCL_ERROR;
+ }
+ } else {
+ head = *np;
+ if (agroot(g) != agroot(agraphof(head))) {
+ Tcl_AppendResult(interp, "Nodes ", argv[0], " and ",
+ argv[2], " are not in the same graph.",
+ NULL);
+ return TCL_ERROR;
+ }
+ }
+#ifdef WITH_CGRAPH
+ e = agedge(g, n, head, NULL, 1);
+#else
+ e = agedge(g, n, head);
+#endif
+ if (!
+ (ep = (Agedge_t **) tclhandleXlateIndex(mycontext->edgeTblPtr, AGID(e)))
+ || *ep != e) {
+ ep = (Agedge_t **) tclhandleAlloc(mycontext->edgeTblPtr, Tcl_GetStringResult(interp),
+ &id);
+ *ep = e;
+ AGID(e) = id;
+#ifndef TCLOBJ
+ Tcl_CreateCommand(interp, Tcl_GetStringResult(interp), edgecmd,
+ (ClientData) mycontext,
+ (Tcl_CmdDeleteProc *) NULL);
+#else /* TCLOBJ */
+ Tcl_CreateObjCommand(interp, Tcl_GetStringResult(interp), edgecmd,
+ (ClientData) mycontext,
+ (Tcl_CmdDeleteProc *) NULL);
+#endif /* TCLOBJ */
+ } else {
+ tclhandleString(mycontext->edgeTblPtr, Tcl_GetStringResult(interp), AGID(e));
+ }
+ setedgeattributes(agroot(g), e, &argv[3], argc - 3);
+ reset_layout(gvc, g);
+ return TCL_OK;
+
+ } else if ((c == 'd') && (strncmp(argv[1], "delete", length) == 0)) {
+#ifndef WITH_CGRAPH
+ deleteEdges(mycontext, g, n);
+ tclhandleFreeIndex(mycontext->nodeTblPtr, AGID(n));
+ Tcl_DeleteCommand(interp, argv[0]);
+#else
+ deleteEdges(g, n);
+#endif
+ agdelete(g, n);
+ reset_layout(gvc, g);
+ return TCL_OK;
+
+ } else if ((c == 'f') && (strncmp(argv[1], "findedge", length) == 0)) {
+ if (argc < 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " findedge headnodename\"",
+ NULL);
+ return TCL_ERROR;
+ }
+ if (!(head = agfindnode(g, argv[2]))) {
+ Tcl_AppendResult(interp, "Head node \"", argv[2],
+ "\" not found.", NULL);
+ return TCL_ERROR;
+ }
+ if (!(e = agfindedge(g, n, head))) {
+ tclhandleString(mycontext->nodeTblPtr, buf, AGID(head));
+ Tcl_AppendResult(interp, "Edge \"", argv[0],
+ " - ", buf, "\" not found.", NULL);
+ return TCL_ERROR;
+ }
+ tclhandleString(mycontext->edgeTblPtr, buf, AGID(e));
+ Tcl_AppendElement(interp, buf);
+ return TCL_OK;
+
+ } else if ((c == 'l')
+ && (strncmp(argv[1], "listattributes", length) == 0)) {
+ listNodeAttrs (interp, g);
+ return TCL_OK;
+
+ } else if ((c == 'l') && (strncmp(argv[1], "listedges", length) == 0)) {
+ for (e = agfstedge(g, n); e; e = agnxtedge(g, e, n)) {
+ tclhandleString(mycontext->edgeTblPtr, buf, AGID(e));
+ Tcl_AppendElement(interp, buf);
+ }
+ return TCL_OK;
+
+ } else if ((c == 'l')
+ && (strncmp(argv[1], "listinedges", length) == 0)) {
+ for (e = agfstin(g, n); e; e = agnxtin(g, e)) {
+ tclhandleString(mycontext->edgeTblPtr, buf, AGID(e));
+ Tcl_AppendElement(interp, buf);
+ }
+ return TCL_OK;
+
+ } else if ((c == 'l')
+ && (strncmp(argv[1], "listoutedges", length) == 0)) {
+ for (e = agfstout(g, n); e; e = agnxtout(g, e)) {
+ tclhandleString(mycontext->edgeTblPtr, buf, AGID(e));
+ Tcl_AppendElement(interp, buf);
+ }
+ return TCL_OK;
+
+ } else if ((c == 'q')
+ && (strncmp(argv[1], "queryattributes", length) == 0)) {
+ for (i = 2; i < argc; i++) {
+ if (Tcl_SplitList
+ (interp, argv[i], &argc2,
+ (CONST84 char ***) &argv2) != TCL_OK)
+ return TCL_ERROR;
+ for (j = 0; j < argc2; j++) {
+ if ((a = agfindnodeattr(g, argv2[j]))) {
+#ifndef WITH_CGRAPH
+ Tcl_AppendElement(interp, agxget(n, a->index));
+#else
+ Tcl_AppendElement(interp, agxget(n, a));
+#endif
+ } else {
+ Tcl_AppendResult(interp, " No attribute named \"",
+ argv2[j], "\"", NULL);
+ return TCL_ERROR;
+ }
+ }
+ Tcl_Free((char *) argv2);
+ }
+ return TCL_OK;
+
+ } else if ((c == 'q')
+ && (strncmp(argv[1], "queryattributevalues", length) ==
+ 0)) {
+ for (i = 2; i < argc; i++) {
+ if (Tcl_SplitList
+ (interp, argv[i], &argc2,
+ (CONST84 char ***) &argv2) != TCL_OK)
+ return TCL_ERROR;
+ for (j = 0; j < argc2; j++) {
+ if ((a = agfindnodeattr(g, argv2[j]))) {
+ Tcl_AppendElement(interp, argv2[j]);
+#ifndef WITH_CGRAPH
+ Tcl_AppendElement(interp, agxget(n, a->index));
+#else
+ Tcl_AppendElement(interp, agxget(n, a));
+#endif
+ } else {
+ Tcl_AppendResult(interp, " No attribute named \"",
+ argv2[j], "\"", NULL);
+ return TCL_ERROR;
+ }
+ }
+ Tcl_Free((char *) argv2);
+ }
+ return TCL_OK;
+
+ } else if ((c == 's')
+ && (strncmp(argv[1], "setattributes", length) == 0)) {
+ g = agroot(g);
+ if (argc == 3) {
+ if (Tcl_SplitList
+ (interp, argv[2], &argc2,
+ (CONST84 char ***) &argv2) != TCL_OK)
+ return TCL_ERROR;
+ if ((argc2 == 0) || (argc2 % 2)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0],
+ "\" setattributes attributename attributevalue ?attributename attributevalue? ?...?",
+ NULL);
+ Tcl_Free((char *) argv2);
+ return TCL_ERROR;
+ }
+ setnodeattributes(g, n, argv2, argc2);
+ Tcl_Free((char *) argv2);
+ } else {
+ if ((argc < 4) || (argc % 2)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0],
+ "\" setattributes attributename attributevalue ?attributename attributevalue? ?...?",
+ NULL);
+ return TCL_ERROR;
+ }
+ setnodeattributes(g, n, &argv[2], argc - 2);
+ }
+ reset_layout(gvc, g);
+ return TCL_OK;
+
+ } else if ((c == 's') && (strncmp(argv[1], "showname", length) == 0)) {
+ Tcl_SetResult(interp, agnameof(n), TCL_STATIC);
+ return TCL_OK;
+
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be one of:",
+ "\n\taddedge, listattributes, listedges, listinedges,",
+ "\n\tlistoutedges, queryattributes, queryattributevalues,",
+ "\n\tsetattributes, showname.", NULL);
+ return TCL_ERROR;
+ }
+}
--- /dev/null
+/* $Id$ $Revision$ */
+/* vim:set shiftwidth=4 ts=8: */
+
+/*************************************************************************
+ * Copyright (c) 2011 AT&T Intellectual Property
+ * All rights reserved. This program and the accompanying materials
+ * are made available under the terms of the Eclipse Public License v1.0
+ * which accompanies this distribution, and is available at
+ * http://www.eclipse.org/legal/epl-v10.html
+ *
+ * Contributors: See CVS logs. Details at http://www.graphviz.org/
+ *************************************************************************/
+
+
+#include "tcldot.h"
+
+size_t Tcldot_string_writer(GVJ_t *job, const char *s, size_t len)
+{
+ Tcl_AppendResult((Tcl_Interp*)(job->context), s, NULL);
+ return len;
+}
+
+size_t Tcldot_channel_writer(GVJ_t *job, const char *s, size_t len)
+{
+ return Tcl_Write((Tcl_Channel)(job->output_file), s, len);
+}
+
+void reset_layout(GVC_t *gvc, Agraph_t * sg)
+{
+ Agraph_t *g = agroot(sg);
+
+ if (GD_drawing(g)) { /* only cleanup once between layouts */
+ gvFreeLayout(gvc, g);
+ GD_drawing(g) = NULL;
+ }
+}
+
+#ifdef WITH_CGRAPH
+void deleteEdges(Agraph_t * g, Agnode_t * n)
+{
+ Agedge_t *e, *e1;
+
+ e = agfstedge(g, n);
+ while (e) {
+ e1 = agnxtedge(g, e, n);
+ agdelete(agroot(g), e);
+ e = e1;
+ }
+}
+
+void deleteNodes(Agraph_t * g)
+{
+ Agnode_t *n, *n1;
+
+ n = agfstnode(g);
+ while (n) {
+ deleteEdges(agroot(g), n);
+ n1 = agnxtnode(g, n);
+ agdelete(agroot(g), n);
+ n = n1;
+ }
+}
+void deleteGraph(Agraph_t * g)
+{
+ Agraph_t *sg;
+
+ for (sg = agfstsubg (g); sg; sg = agnxtsubg (sg)) {
+ deleteGraph(sg);
+ }
+ if (g == agroot(g)) {
+ agclose(g);
+ } else {
+ agdelsubg(agroot(g), g);
+ }
+}
+#else
+void deleteEdges(mycontext_t * mycontext, Agraph_t * g, Agnode_t * n)
+{
+ Agedge_t **ep, *e, *e1;
+ char buf[16];
+
+ e = agfstedge(g, n);
+ while (e) {
+ tclhandleString(mycontext->edgeTblPtr, buf, AGID(e));
+ Tcl_DeleteCommand(mycontext->interp, buf);
+ ep = (Agedge_t **) tclhandleXlateIndex(mycontext->edgeTblPtr, AGID(e));
+ if (!ep)
+ fprintf(stderr, "Bad entry in edgeTbl\n");
+ tclhandleFreeIndex(mycontext->edgeTblPtr, AGID(e));
+ e1 = agnxtedge(g, e, n);
+ agdelete(agroot(g), e);
+ e = e1;
+ }
+}
+void deleteNodes(mycontext_t * mycontext, Agraph_t * g)
+{
+ Agnode_t **np, *n, *n1;
+ char buf[16];
+
+ n = agfstnode(g);
+ while (n) {
+ tclhandleString(mycontext->nodeTblPtr, buf, AGID(n));
+ Tcl_DeleteCommand(mycontext->interp, buf);
+ np = (Agnode_t **) tclhandleXlateIndex(mycontext->nodeTblPtr, AGID(n));
+ if (!np)
+ fprintf(stderr, "Bad entry in nodeTbl\n");
+ tclhandleFreeIndex(mycontext->nodeTblPtr, AGID(n));
+ deleteEdges(mycontext, agroot(g), n);
+ n1 = agnxtnode(g, n);
+ agdelete(agroot(g), n);
+ n = n1;
+ }
+}
+void deleteGraph(mycontext_t * mycontext, Agraph_t * g)
+{
+ Agraph_t **sgp;
+ Agedge_t *e;
+ char buf[16];
+
+ if (g->meta_node) {
+ for (e = agfstout(g->meta_node->graph, g->meta_node); e;
+ e = agnxtout(g->meta_node->graph, e)) {
+ deleteGraph(mycontext, agusergraph(aghead(e)));
+ }
+ tclhandleString(mycontext->graphTblPtr, buf, AGID(g));
+ Tcl_DeleteCommand(mycontext->interp, buf);
+ sgp = (Agraph_t **) tclhandleXlateIndex(mycontext->graphTblPtr, AGID(g));
+ if (!sgp)
+ fprintf(stderr, "Bad entry in graphTbl\n");
+ tclhandleFreeIndex(mycontext->graphTblPtr, AGID(g));
+ if (g == agroot(g)) {
+ agclose(g);
+ } else {
+ agdelete(g->meta_node->graph, g->meta_node);
+ }
+ } else {
+ fprintf(stderr, "Subgraph has no meta_node\n");
+ }
+}
+#endif
+
+void setgraphattributes(Agraph_t * g, char *argv[], int argc)
+{
+ int i;
+ Agsym_t *a;
+
+ for (i = 0; i < argc; i++) {
+ if (!(a = agfindgraphattr(agroot(g), argv[i])))
+#ifndef WITH_CGRAPH
+ a = agraphattr(agroot(g), argv[i], "");
+ agxset(g, a->index, argv[++i]);
+#else
+ a = agattr(agroot(g), AGRAPH, argv[i], "");
+ agxset(g, a, argv[++i]);
+#endif
+ }
+}
+
+void setedgeattributes(Agraph_t * g, Agedge_t * e, char *argv[], int argc)
+{
+ int i;
+ Agsym_t *a;
+
+ for (i = 0; i < argc; i++) {
+ /* silently ignore attempts to modify "key" */
+ if (strcmp(argv[i], "key") == 0) {
+ i++;
+ continue;
+ }
+ if (!(a = agfindedgeattr(g, argv[i])))
+#ifndef WITH_CGRAPH
+ a = agedgeattr(agroot(g), argv[i], "");
+ agxset(e, a->index, argv[++i]);
+#else
+ a = agattr(agroot(g), AGEDGE, argv[i], "");
+ agxset(e, a, argv[++i]);
+#endif
+ }
+}
+
+void setnodeattributes(Agraph_t * g, Agnode_t * n, char *argv[], int argc)
+{
+ int i;
+ Agsym_t *a;
+
+ for (i = 0; i < argc; i++) {
+ if (!(a = agfindnodeattr(g, argv[i])))
+#ifndef WITH_CGRAPH
+ a = agnodeattr(agroot(g), argv[i], "");
+ agxset(n, a->index, argv[++i]);
+#else
+ a = agattr(agroot(g), AGNODE, argv[i], "");
+ agxset(n, a, argv[++i]);
+#endif
+ }
+}
+
+#ifdef WITH_CGRAPH
+void listGraphAttrs (Tcl_Interp * interp, Agraph_t* g)
+{
+ Agsym_t *a = NULL;
+ while ((a = agnxtattr(g, AGRAPH, a))) {
+ Tcl_AppendElement(interp, a->name);
+ }
+}
+void listNodeAttrs (Tcl_Interp * interp, Agraph_t* g)
+{
+ Agsym_t *a = NULL;
+ while ((a = agnxtattr(g, AGNODE, a))) {
+ Tcl_AppendElement(interp, a->name);
+ }
+}
+void listEdgeAttrs (Tcl_Interp * interp, Agraph_t* g)
+{
+ Agsym_t *a = NULL;
+ while ((a = agnxtattr(g, AGEDGE, a))) {
+ Tcl_AppendElement(interp, a->name);
+ }
+}
+#else
+void listGraphAttrs (Tcl_Interp * interp, Agraph_t* g)
+{
+ int i;
+ Agsym_t *a;
+
+ for (i = 0; i < dtsize(g->univ->globattr->dict); i++) {
+ a = g->univ->globattr->list[i];
+ Tcl_AppendElement(interp, a->name);
+ }
+}
+void listNodeAttrs (Tcl_Interp * interp, Agraph_t* g)
+{
+ int i;
+ Agsym_t *a;
+
+ for (i = 0; i < dtsize(g->univ->nodeattr->dict); i++) {
+ a = g->univ->nodeattr->list[i];
+ Tcl_AppendElement(interp, a->name);
+ }
+}
+void listEdgeAttrs (Tcl_Interp * interp, Agraph_t* g)
+{
+ int i;
+ Agsym_t *a;
+
+ for (i = 0; i < dtsize(g->univ->edgeattr->dict); i++) {
+ a = g->univ->edgeattr->list[i];
+ Tcl_AppendElement(interp, a->name);
+ }
+}
+#endif
+
+void tcldot_layout(GVC_t *gvc, Agraph_t * g, char *engine)
+{
+ char buf[256];
+ Agsym_t *a;
+ int rc;
+
+ reset_layout(gvc, g); /* in case previously drawn */
+
+/* support old behaviors if engine isn't specified*/
+ if (!engine || *engine == '\0') {
+ if (agisdirected(g))
+ rc = gvlayout_select(gvc, "dot");
+ else
+ rc = gvlayout_select(gvc, "neato");
+ }
+ else {
+ if (strcasecmp(engine, "nop") == 0) {
+ Nop = 2;
+ PSinputscale = POINTS_PER_INCH;
+ rc = gvlayout_select(gvc, "neato");
+ }
+ else {
+ rc = gvlayout_select(gvc, engine);
+ }
+ if (rc == NO_SUPPORT)
+ rc = gvlayout_select(gvc, "dot");
+ }
+ if (rc == NO_SUPPORT) {
+ fprintf(stderr, "Layout type: \"%s\" not recognized. Use one of:%s\n",
+ engine, gvplugin_list(gvc, API_layout, engine));
+ return;
+ }
+ gvLayoutJobs(gvc, g);
+
+/* set bb attribute for basic layout.
+ * doesn't yet include margins, scaling or page sizes because
+ * those depend on the renderer being used. */
+ if (GD_drawing(g)->landscape)
+ sprintf(buf, "%d %d %d %d",
+ ROUND(GD_bb(g).LL.y), ROUND(GD_bb(g).LL.x),
+ ROUND(GD_bb(g).UR.y), ROUND(GD_bb(g).UR.x));
+ else
+ sprintf(buf, "%d %d %d %d",
+ ROUND(GD_bb(g).LL.x), ROUND(GD_bb(g).LL.y),
+ ROUND(GD_bb(g).UR.x), ROUND(GD_bb(g).UR.y));
+#ifndef WITH_CGRAPH
+ if (!(a = agfindgraphattr(g, "bb")))
+ a = agraphattr(g, "bb", "");
+ agxset(g, a->index, buf);
+#else
+ if (!(a = agattr(g, AGRAPH, "bb", NULL)))
+ a = agattr(g, AGRAPH, "bb", "");
+ agxset(g, a, buf);
+#endif
+}
*************************************************************************/
-/* avoid compiler warnings with template changes in Tcl8.4 */
-/* specifically just the change to Tcl_CmdProc */
-#define USE_NON_CONST
-#include <tcl.h>
-#include "render.h"
-#include "gvc.h"
-#include "gvio.h"
-#include "tclhandle.h"
+#include "tcldot.h"
-#ifndef CONST84
-#define CONST84
-#endif
-
-/* ******* not ready yet
-#if (TCL_MAJOR_VERSION > 7)
-#define TCLOBJ
-#if (TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION == 0)
-char *
-Tcl_GetString(Tcl_Obj *obj) {
- int len;
- return (Tcl_GetStringFromObj(obj, &len));
-}
-#else
-#define UTF8
-#endif
-#endif
-********* */
-
-typedef struct {
#ifdef WITH_CGRAPH
- Agdisc_t mydisc; // must be first to allow casting mydisc to mycontext
-#endif
- void *graphTblPtr, *nodeTblPtr, *edgeTblPtr;
- Tcl_Interp *interp;
- GVC_t *gvc;
-} mycontext_t;
-
-/* Globals */
-
-#if HAVE_LIBGD
-extern void *GDHandleTable;
-extern int Gdtclft_Init(Tcl_Interp *);
-#endif
-
-#ifndef WITH_CGRAPH
-#undef AGID
-#define AGID(x) ((x)->handle)
-#endif
-
-#ifdef WITH_CGRAPH
-
-// forward declaractions
-static int graphcmd(ClientData clientData, Tcl_Interp * interp,
-#ifndef TCLOBJ
- int argc, char *argv[]
-#else
- int argc, Tcl_Obj * CONST objv[]
-#endif
- );
-static int nodecmd(ClientData clientData, Tcl_Interp * interp,
-#ifndef TCLOBJ
- int argc, char *argv[]
-#else
- int argc, Tcl_Obj * CONST objv[]
-#endif
- );
-static int edgecmd(ClientData clientData, Tcl_Interp * interp,
-#ifndef TCLOBJ
- int argc, char *argv[]
-#else
- int argc, Tcl_Obj * CONST objv[]
-#endif
- );
// Agiddisc functions
static void *myiddisc_open(Agraph_t *g, Agdisc_t *disc) {
#endif // WITH_CGRAPH
-static size_t Tcldot_string_writer(GVJ_t *job, const char *s, size_t len)
-{
- Tcl_AppendResult((Tcl_Interp*)(job->context), s, NULL);
- return len;
-}
-
-static size_t Tcldot_channel_writer(GVJ_t *job, const char *s, size_t len)
-{
- return Tcl_Write((Tcl_Channel)(job->output_file), s, len);
-}
-
-static void reset_layout(GVC_t *gvc, Agraph_t * sg)
-{
- Agraph_t *g = agroot(sg);
-
- if (GD_drawing(g)) { /* only cleanup once between layouts */
- gvFreeLayout(gvc, g);
- GD_drawing(g) = NULL;
- }
-}
-
-#ifdef WITH_CGRAPH
-static void deleteEdges(Agraph_t * g, Agnode_t * n)
-{
- Agedge_t *e, *e1;
-
- e = agfstedge(g, n);
- while (e) {
- e1 = agnxtedge(g, e, n);
- agdelete(agroot(g), e);
- e = e1;
- }
-}
-
-static void deleteNodes(Agraph_t * g)
-{
- Agnode_t *n, *n1;
-
- n = agfstnode(g);
- while (n) {
- deleteEdges(agroot(g), n);
- n1 = agnxtnode(g, n);
- agdelete(agroot(g), n);
- n = n1;
- }
-}
-static void deleteGraph(Agraph_t * g)
-{
- Agraph_t *sg;
-
- for (sg = agfstsubg (g); sg; sg = agnxtsubg (sg)) {
- deleteGraph(sg);
- }
- if (g == agroot(g)) {
- agclose(g);
- } else {
- agdelsubg(agroot(g), g);
- }
-}
-#else
-static void deleteEdges(mycontext_t * mycontext, Agraph_t * g, Agnode_t * n)
-{
- Agedge_t **ep, *e, *e1;
- char buf[16];
-
- e = agfstedge(g, n);
- while (e) {
- tclhandleString(mycontext->edgeTblPtr, buf, AGID(e));
- Tcl_DeleteCommand(mycontext->interp, buf);
- ep = (Agedge_t **) tclhandleXlateIndex(mycontext->edgeTblPtr, AGID(e));
- if (!ep)
- fprintf(stderr, "Bad entry in edgeTbl\n");
- tclhandleFreeIndex(mycontext->edgeTblPtr, AGID(e));
- e1 = agnxtedge(g, e, n);
- agdelete(agroot(g), e);
- e = e1;
- }
-}
-static void deleteNodes(mycontext_t * mycontext, Agraph_t * g)
-{
- Agnode_t **np, *n, *n1;
- char buf[16];
-
- n = agfstnode(g);
- while (n) {
- tclhandleString(mycontext->nodeTblPtr, buf, AGID(n));
- Tcl_DeleteCommand(mycontext->interp, buf);
- np = (Agnode_t **) tclhandleXlateIndex(mycontext->nodeTblPtr, AGID(n));
- if (!np)
- fprintf(stderr, "Bad entry in nodeTbl\n");
- tclhandleFreeIndex(mycontext->nodeTblPtr, AGID(n));
- deleteEdges(mycontext, agroot(g), n);
- n1 = agnxtnode(g, n);
- agdelete(agroot(g), n);
- n = n1;
- }
-}
-static void deleteGraph(mycontext_t * mycontext, Agraph_t * g)
-{
- Agraph_t **sgp;
- Agedge_t *e;
- char buf[16];
-
- if (g->meta_node) {
- for (e = agfstout(g->meta_node->graph, g->meta_node); e;
- e = agnxtout(g->meta_node->graph, e)) {
- deleteGraph(mycontext, agusergraph(aghead(e)));
- }
- tclhandleString(mycontext->graphTblPtr, buf, AGID(g));
- Tcl_DeleteCommand(mycontext->interp, buf);
- sgp = (Agraph_t **) tclhandleXlateIndex(mycontext->graphTblPtr, AGID(g));
- if (!sgp)
- fprintf(stderr, "Bad entry in graphTbl\n");
- tclhandleFreeIndex(mycontext->graphTblPtr, AGID(g));
- if (g == agroot(g)) {
- agclose(g);
- } else {
- agdelete(g->meta_node->graph, g->meta_node);
- }
- } else {
- fprintf(stderr, "Subgraph has no meta_node\n");
- }
-}
-#endif
-
-static void setgraphattributes(Agraph_t * g, char *argv[], int argc)
-{
- int i;
- Agsym_t *a;
-
- for (i = 0; i < argc; i++) {
- if (!(a = agfindgraphattr(agroot(g), argv[i])))
-#ifndef WITH_CGRAPH
- a = agraphattr(agroot(g), argv[i], "");
- agxset(g, a->index, argv[++i]);
-#else
- a = agattr(agroot(g), AGRAPH, argv[i], "");
- agxset(g, a, argv[++i]);
-#endif
- }
-}
-
-static void
-setedgeattributes(Agraph_t * g, Agedge_t * e, char *argv[], int argc)
-{
- int i;
- Agsym_t *a;
-
- for (i = 0; i < argc; i++) {
- /* silently ignore attempts to modify "key" */
- if (strcmp(argv[i], "key") == 0) {
- i++;
- continue;
- }
- if (!(a = agfindedgeattr(g, argv[i])))
-#ifndef WITH_CGRAPH
- a = agedgeattr(agroot(g), argv[i], "");
- agxset(e, a->index, argv[++i]);
-#else
- a = agattr(agroot(g), AGEDGE, argv[i], "");
- agxset(e, a, argv[++i]);
-#endif
- }
-}
-
-static void
-setnodeattributes(Agraph_t * g, Agnode_t * n, char *argv[], int argc)
-{
- int i;
- Agsym_t *a;
-
- for (i = 0; i < argc; i++) {
- if (!(a = agfindnodeattr(g, argv[i])))
-#ifndef WITH_CGRAPH
- a = agnodeattr(agroot(g), argv[i], "");
- agxset(n, a->index, argv[++i]);
-#else
- a = agattr(agroot(g), AGNODE, argv[i], "");
- agxset(n, a, argv[++i]);
-#endif
- }
-}
-
-#ifdef WITH_CGRAPH
-static void listGraphAttrs (Tcl_Interp * interp, Agraph_t* g)
-{
- Agsym_t *a = NULL;
- while ((a = agnxtattr(g, AGRAPH, a))) {
- Tcl_AppendElement(interp, a->name);
- }
-}
-static void listNodeAttrs (Tcl_Interp * interp, Agraph_t* g)
-{
- Agsym_t *a = NULL;
- while ((a = agnxtattr(g, AGNODE, a))) {
- Tcl_AppendElement(interp, a->name);
- }
-}
-static void listEdgeAttrs (Tcl_Interp * interp, Agraph_t* g)
-{
- Agsym_t *a = NULL;
- while ((a = agnxtattr(g, AGEDGE, a))) {
- Tcl_AppendElement(interp, a->name);
- }
-}
-#else
-static void listGraphAttrs (Tcl_Interp * interp, Agraph_t* g)
-{
- int i;
- Agsym_t *a;
-
- for (i = 0; i < dtsize(g->univ->globattr->dict); i++) {
- a = g->univ->globattr->list[i];
- Tcl_AppendElement(interp, a->name);
- }
-}
-static void listNodeAttrs (Tcl_Interp * interp, Agraph_t* g)
-{
- int i;
- Agsym_t *a;
-
- for (i = 0; i < dtsize(g->univ->nodeattr->dict); i++) {
- a = g->univ->nodeattr->list[i];
- Tcl_AppendElement(interp, a->name);
- }
-}
-static void listEdgeAttrs (Tcl_Interp * interp, Agraph_t* g)
-{
- int i;
- Agsym_t *a;
-
- for (i = 0; i < dtsize(g->univ->edgeattr->dict); i++) {
- a = g->univ->edgeattr->list[i];
- Tcl_AppendElement(interp, a->name);
- }
-}
-#endif
-
-static int edgecmd(ClientData clientData, Tcl_Interp * interp,
-#ifndef TCLOBJ
- int argc, char *argv[]
-#else /* TCLOBJ */
- int argc, Tcl_Obj * CONST objv[]
-#endif /* TCLOBJ */
- )
-{
- char c, buf[16], *s, **argv2;
- int i, j, length, argc2;
- Agraph_t *g;
- Agedge_t **ep, *e;
- Agsym_t *a;
- mycontext_t *mycontext = (mycontext_t *)clientData;
- GVC_t *gvc = mycontext->gvc;
-
- if (argc < 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], "\" option ?arg arg ...?",
- NULL);
- return TCL_ERROR;
- }
- if (!(ep = (Agedge_t **) tclhandleXlate(mycontext->edgeTblPtr, argv[0]))) {
- Tcl_AppendResult(interp, " \"", argv[0], "\"", NULL);
- return TCL_ERROR;
- }
- e = *ep;
- g = agraphof(agtail(e));
-
- c = argv[1][0];
- length = strlen(argv[1]);
-
- if ((c == 'd') && (strncmp(argv[1], "delete", length) == 0)) {
-#ifndef WITH_CGRAPH
- tclhandleFreeIndex(mycontext->edgeTblPtr, AGID(e));
- Tcl_DeleteCommand(interp, argv[0]);
-#endif
- agdelete(g, e);
- reset_layout(gvc, g);
- return TCL_OK;
-
- } else if ((c == 'l')
- && (strncmp(argv[1], "listattributes", length) == 0)) {
- listEdgeAttrs (interp, g);
- return TCL_OK;
-
- } else if ((c == 'l') && (strncmp(argv[1], "listnodes", length) == 0)) {
- tclhandleString(mycontext->nodeTblPtr, buf, AGID(agtail(e)));
- Tcl_AppendElement(interp, buf);
- tclhandleString(mycontext->nodeTblPtr, buf, AGID(aghead(e)));
- Tcl_AppendElement(interp, buf);
- return TCL_OK;
-
- } else if ((c == 'q')
- && (strncmp(argv[1], "queryattributes", length) == 0)) {
- for (i = 2; i < argc; i++) {
- if (Tcl_SplitList
- (interp, argv[i], &argc2,
- (CONST84 char ***) &argv2) != TCL_OK)
- return TCL_ERROR;
- for (j = 0; j < argc2; j++) {
- if ((a = agfindedgeattr(g, argv2[j]))) {
-#ifndef WITH_CGRAPH
- Tcl_AppendElement(interp, agxget(e, a->index));
-#else
- Tcl_AppendElement(interp, agxget(e, a));
-#endif
- } else {
- Tcl_AppendResult(interp, " No attribute named \"",
- argv2[j], "\"", NULL);
- return TCL_ERROR;
- }
- }
- Tcl_Free((char *) argv2);
- }
- return TCL_OK;
-
- } else if ((c == 'q')
- && (strncmp(argv[1], "queryattributevalues", length) ==
- 0)) {
- for (i = 2; i < argc; i++) {
- if (Tcl_SplitList
- (interp, argv[i], &argc2,
- (CONST84 char ***) &argv2) != TCL_OK)
- return TCL_ERROR;
- for (j = 0; j < argc2; j++) {
- if ((a = agfindedgeattr(g, argv2[j]))) {
- Tcl_AppendElement(interp, argv2[j]);
-#ifndef WITH_CGRAPH
- Tcl_AppendElement(interp, agxget(e, a->index));
-#else
- Tcl_AppendElement(interp, agxget(e, a));
-#endif
- } else {
- Tcl_AppendResult(interp, " No attribute named \"", argv2[j], "\"", NULL);
- return TCL_ERROR;
- }
- }
- Tcl_Free((char *) argv2);
- }
- return TCL_OK;
-
- } else if ((c == 's')
- && (strncmp(argv[1], "setattributes", length) == 0)) {
- if (argc == 3) {
- if (Tcl_SplitList
- (interp, argv[2], &argc2,
- (CONST84 char ***) &argv2) != TCL_OK)
- return TCL_ERROR;
- if ((argc2 == 0) || (argc2 % 2)) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- "\" setattributes attributename attributevalue ?attributename attributevalue? ?...?",
- NULL);
- Tcl_Free((char *) argv2);
- return TCL_ERROR;
- }
- setedgeattributes(agroot(g), e, argv2, argc2);
- Tcl_Free((char *) argv2);
- } else {
- if ((argc < 4) || (argc % 2)) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0],
- "\" setattributes attributename attributevalue ?attributename attributevalue? ?...?",
- NULL);
- return TCL_ERROR;
- }
- setedgeattributes(agroot(g), e, &argv[2], argc - 2);
- }
- reset_layout(gvc, g);
- return TCL_OK;
-
- } else if ((c == 's') && (strncmp(argv[1], "showname", length) == 0)) {
- if (agisdirected(g))
- s = "->";
- else
- s = "--";
- Tcl_AppendResult(interp,
- agnameof(agtail(e)), s, agnameof(aghead(e)), NULL);
- return TCL_OK;
-
- } else {
- Tcl_AppendResult(interp, "bad option \"", argv[1],
- "\": must be one of:",
- "\n\tdelete, listattributes, listnodes,",
- "\n\tueryattributes, queryattributevalues,",
- "\n\tsetattributes, showname", NULL);
- return TCL_ERROR;
- }
-}
-
-static int nodecmd(ClientData clientData, Tcl_Interp * interp,
-#ifndef TCLOBJ
- int argc, char *argv[]
-#else /* TCLOBJ */
- int argc, Tcl_Obj * CONST objv[]
-#endif /* TCLOBJ */
- )
-{
- unsigned long id;
- char c, buf[16], **argv2;
- int i, j, length, argc2;
- Agraph_t *g;
- Agnode_t **np, *n, *head;
- Agedge_t **ep, *e;
- Agsym_t *a;
- mycontext_t *mycontext = (mycontext_t *)clientData;
- GVC_t *gvc = mycontext->gvc;
-
- if (argc < 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " option ?arg arg ...?\"",
- NULL);
- return TCL_ERROR;
- }
- if (!(np = (Agnode_t **) tclhandleXlate(mycontext->nodeTblPtr, argv[0]))) {
- Tcl_AppendResult(interp, " \"", argv[0], "\"", NULL);
- return TCL_ERROR;
- }
- n = *np;
- g = agraphof(n);
-
- c = argv[1][0];
- length = strlen(argv[1]);
-
-
- if ((c == 'a') && (strncmp(argv[1], "addedge", length) == 0)) {
- if ((argc < 3) || (!(argc % 2))) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0],
- " addedge head ?attributename attributevalue? ?...?\"",
- NULL);
- return TCL_ERROR;
- }
- if (!(np = (Agnode_t **) tclhandleXlate(mycontext->nodeTblPtr, argv[2]))) {
- if (!(head = agfindnode(g, argv[2]))) {
- Tcl_AppendResult(interp, "Head node \"", argv[2],
- "\" not found.", NULL);
- return TCL_ERROR;
- }
- } else {
- head = *np;
- if (agroot(g) != agroot(agraphof(head))) {
- Tcl_AppendResult(interp, "Nodes ", argv[0], " and ",
- argv[2], " are not in the same graph.",
- NULL);
- return TCL_ERROR;
- }
- }
-#ifdef WITH_CGRAPH
- e = agedge(g, n, head, NULL, 1);
-#else
- e = agedge(g, n, head);
-#endif
- if (!
- (ep = (Agedge_t **) tclhandleXlateIndex(mycontext->edgeTblPtr, AGID(e)))
- || *ep != e) {
- ep = (Agedge_t **) tclhandleAlloc(mycontext->edgeTblPtr, Tcl_GetStringResult(interp),
- &id);
- *ep = e;
- AGID(e) = id;
-#ifndef TCLOBJ
- Tcl_CreateCommand(interp, Tcl_GetStringResult(interp), edgecmd,
- (ClientData) mycontext,
- (Tcl_CmdDeleteProc *) NULL);
-#else /* TCLOBJ */
- Tcl_CreateObjCommand(interp, Tcl_GetStringResult(interp), edgecmd,
- (ClientData) mycontext,
- (Tcl_CmdDeleteProc *) NULL);
-#endif /* TCLOBJ */
- } else {
- tclhandleString(mycontext->edgeTblPtr, Tcl_GetStringResult(interp), AGID(e));
- }
- setedgeattributes(agroot(g), e, &argv[3], argc - 3);
- reset_layout(gvc, g);
- return TCL_OK;
-
- } else if ((c == 'd') && (strncmp(argv[1], "delete", length) == 0)) {
-#ifndef WITH_CGRAPH
- deleteEdges(mycontext, g, n);
- tclhandleFreeIndex(mycontext->nodeTblPtr, AGID(n));
- Tcl_DeleteCommand(interp, argv[0]);
-#else
- deleteEdges(g, n);
-#endif
- agdelete(g, n);
- reset_layout(gvc, g);
- return TCL_OK;
-
- } else if ((c == 'f') && (strncmp(argv[1], "findedge", length) == 0)) {
- if (argc < 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " findedge headnodename\"",
- NULL);
- return TCL_ERROR;
- }
- if (!(head = agfindnode(g, argv[2]))) {
- Tcl_AppendResult(interp, "Head node \"", argv[2],
- "\" not found.", NULL);
- return TCL_ERROR;
- }
- if (!(e = agfindedge(g, n, head))) {
- tclhandleString(mycontext->nodeTblPtr, buf, AGID(head));
- Tcl_AppendResult(interp, "Edge \"", argv[0],
- " - ", buf, "\" not found.", NULL);
- return TCL_ERROR;
- }
- tclhandleString(mycontext->edgeTblPtr, buf, AGID(e));
- Tcl_AppendElement(interp, buf);
- return TCL_OK;
-
- } else if ((c == 'l')
- && (strncmp(argv[1], "listattributes", length) == 0)) {
- listNodeAttrs (interp, g);
- return TCL_OK;
-
- } else if ((c == 'l') && (strncmp(argv[1], "listedges", length) == 0)) {
- for (e = agfstedge(g, n); e; e = agnxtedge(g, e, n)) {
- tclhandleString(mycontext->edgeTblPtr, buf, AGID(e));
- Tcl_AppendElement(interp, buf);
- }
- return TCL_OK;
-
- } else if ((c == 'l')
- && (strncmp(argv[1], "listinedges", length) == 0)) {
- for (e = agfstin(g, n); e; e = agnxtin(g, e)) {
- tclhandleString(mycontext->edgeTblPtr, buf, AGID(e));
- Tcl_AppendElement(interp, buf);
- }
- return TCL_OK;
-
- } else if ((c == 'l')
- && (strncmp(argv[1], "listoutedges", length) == 0)) {
- for (e = agfstout(g, n); e; e = agnxtout(g, e)) {
- tclhandleString(mycontext->edgeTblPtr, buf, AGID(e));
- Tcl_AppendElement(interp, buf);
- }
- return TCL_OK;
-
- } else if ((c == 'q')
- && (strncmp(argv[1], "queryattributes", length) == 0)) {
- for (i = 2; i < argc; i++) {
- if (Tcl_SplitList
- (interp, argv[i], &argc2,
- (CONST84 char ***) &argv2) != TCL_OK)
- return TCL_ERROR;
- for (j = 0; j < argc2; j++) {
- if ((a = agfindnodeattr(g, argv2[j]))) {
-#ifndef WITH_CGRAPH
- Tcl_AppendElement(interp, agxget(n, a->index));
-#else
- Tcl_AppendElement(interp, agxget(n, a));
-#endif
- } else {
- Tcl_AppendResult(interp, " No attribute named \"",
- argv2[j], "\"", NULL);
- return TCL_ERROR;
- }
- }
- Tcl_Free((char *) argv2);
- }
- return TCL_OK;
-
- } else if ((c == 'q')
- && (strncmp(argv[1], "queryattributevalues", length) ==
- 0)) {
- for (i = 2; i < argc; i++) {
- if (Tcl_SplitList
- (interp, argv[i], &argc2,
- (CONST84 char ***) &argv2) != TCL_OK)
- return TCL_ERROR;
- for (j = 0; j < argc2; j++) {
- if ((a = agfindnodeattr(g, argv2[j]))) {
- Tcl_AppendElement(interp, argv2[j]);
-#ifndef WITH_CGRAPH
- Tcl_AppendElement(interp, agxget(n, a->index));
-#else
- Tcl_AppendElement(interp, agxget(n, a));
-#endif
- } else {
- Tcl_AppendResult(interp, " No attribute named \"",
- argv2[j], "\"", NULL);
- return TCL_ERROR;
- }
- }
- Tcl_Free((char *) argv2);
- }
- return TCL_OK;
-
- } else if ((c == 's')
- && (strncmp(argv[1], "setattributes", length) == 0)) {
- g = agroot(g);
- if (argc == 3) {
- if (Tcl_SplitList
- (interp, argv[2], &argc2,
- (CONST84 char ***) &argv2) != TCL_OK)
- return TCL_ERROR;
- if ((argc2 == 0) || (argc2 % 2)) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0],
- "\" setattributes attributename attributevalue ?attributename attributevalue? ?...?",
- NULL);
- Tcl_Free((char *) argv2);
- return TCL_ERROR;
- }
- setnodeattributes(g, n, argv2, argc2);
- Tcl_Free((char *) argv2);
- } else {
- if ((argc < 4) || (argc % 2)) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0],
- "\" setattributes attributename attributevalue ?attributename attributevalue? ?...?",
- NULL);
- return TCL_ERROR;
- }
- setnodeattributes(g, n, &argv[2], argc - 2);
- }
- reset_layout(gvc, g);
- return TCL_OK;
-
- } else if ((c == 's') && (strncmp(argv[1], "showname", length) == 0)) {
- Tcl_SetResult(interp, agnameof(n), TCL_STATIC);
- return TCL_OK;
-
- } else {
- Tcl_AppendResult(interp, "bad option \"", argv[1],
- "\": must be one of:",
- "\n\taddedge, listattributes, listedges, listinedges,",
- "\n\tlistoutedges, queryattributes, queryattributevalues,",
- "\n\tsetattributes, showname.", NULL);
- return TCL_ERROR;
- }
-}
-
-static void tcldot_layout(GVC_t *gvc, Agraph_t * g, char *engine)
-{
- char buf[256];
- Agsym_t *a;
- int rc;
-
- reset_layout(gvc, g); /* in case previously drawn */
-
-/* support old behaviors if engine isn't specified*/
- if (!engine || *engine == '\0') {
- if (agisdirected(g))
- rc = gvlayout_select(gvc, "dot");
- else
- rc = gvlayout_select(gvc, "neato");
- }
- else {
- if (strcasecmp(engine, "nop") == 0) {
- Nop = 2;
- PSinputscale = POINTS_PER_INCH;
- rc = gvlayout_select(gvc, "neato");
- }
- else {
- rc = gvlayout_select(gvc, engine);
- }
- if (rc == NO_SUPPORT)
- rc = gvlayout_select(gvc, "dot");
- }
- if (rc == NO_SUPPORT) {
- fprintf(stderr, "Layout type: \"%s\" not recognized. Use one of:%s\n",
- engine, gvplugin_list(gvc, API_layout, engine));
- return;
- }
- gvLayoutJobs(gvc, g);
-
-/* set bb attribute for basic layout.
- * doesn't yet include margins, scaling or page sizes because
- * those depend on the renderer being used. */
- if (GD_drawing(g)->landscape)
- sprintf(buf, "%d %d %d %d",
- ROUND(GD_bb(g).LL.y), ROUND(GD_bb(g).LL.x),
- ROUND(GD_bb(g).UR.y), ROUND(GD_bb(g).UR.x));
- else
- sprintf(buf, "%d %d %d %d",
- ROUND(GD_bb(g).LL.x), ROUND(GD_bb(g).LL.y),
- ROUND(GD_bb(g).UR.x), ROUND(GD_bb(g).UR.y));
-#ifndef WITH_CGRAPH
- if (!(a = agfindgraphattr(g, "bb")))
- a = agraphattr(g, "bb", "");
- agxset(g, a->index, buf);
-#else
- if (!(a = agattr(g, AGRAPH, "bb", NULL)))
- a = agattr(g, AGRAPH, "bb", "");
- agxset(g, a, buf);
-#endif
-}
-
-static int graphcmd(ClientData clientData, Tcl_Interp * interp,
-#ifndef TCLOBJ
- int argc, char *argv[]
-#else
- int argc, Tcl_Obj * CONST objv[]
-#endif
- )
-{
-
- Agraph_t *g, **gp, *sg, **sgp;
- Agnode_t **np, *n, *tail, *head;
- Agedge_t **ep, *e;
- Agsym_t *a;
- char c, buf[256], **argv2;
- int i, j, length, argc2, rc;
- unsigned long id;
- mycontext_t *mycontext = (mycontext_t *)clientData;
- GVC_t *gvc = mycontext->gvc;
- GVJ_t *job = gvc->job;
-
- if (argc < 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " option ?arg arg ...?\"",
- NULL);
- return TCL_ERROR;
- }
- if (!(gp = (Agraph_t **) tclhandleXlate(mycontext->graphTblPtr, argv[0]))) {
- Tcl_AppendResult(interp, " \"", argv[0], "\"", NULL);
- return TCL_ERROR;
- }
-
- g = *gp;
-
- c = argv[1][0];
- length = strlen(argv[1]);
-
- if ((c == 'a') && (strncmp(argv[1], "addedge", length) == 0)) {
- if ((argc < 4) || (argc % 2)) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " addedge tail head ?attributename attributevalue? ?...?\"",
- NULL);
- return TCL_ERROR;
- }
- if (!(np = (Agnode_t **) tclhandleXlate(mycontext->nodeTblPtr, argv[2]))) {
- if (!(tail = agfindnode(g, argv[2]))) {
- Tcl_AppendResult(interp, "Tail node \"", argv[2],
- "\" not found.", NULL);
- return TCL_ERROR;
- }
- } else {
- tail = *np;
- if (agroot(g) != agroot(agraphof(tail))) {
- Tcl_AppendResult(interp, "Node ", argv[2],
- " is not in the graph.", NULL);
- return TCL_ERROR;
- }
- }
- if (!(np = (Agnode_t **) tclhandleXlate(mycontext->nodeTblPtr, argv[3]))) {
- if (!(head = agfindnode(g, argv[3]))) {
- Tcl_AppendResult(interp, "Head node \"", argv[3],
- "\" not found.", NULL);
- return TCL_ERROR;
- }
- } else {
- head = *np;
- if (agroot(g) != agroot(agraphof(head))) {
- Tcl_AppendResult(interp, "Node ", argv[3],
- " is not in the graph.", NULL);
- return TCL_ERROR;
- }
- }
-#ifdef WITH_CGRAPH
- e = agedge(g, tail, head, NULL, 1);
-#else
- e = agedge(g, tail, head);
-#endif
- if (!(ep = (Agedge_t **) tclhandleXlateIndex(mycontext->edgeTblPtr, AGID(e))) || *ep != e) {
- ep = (Agedge_t **) tclhandleAlloc(mycontext->edgeTblPtr, Tcl_GetStringResult(interp), &id);
- *ep = e;
- AGID(e) = id;
-#ifndef TCLOBJ
- Tcl_CreateCommand(interp, Tcl_GetStringResult(interp), edgecmd,
- (ClientData) mycontext, (Tcl_CmdDeleteProc *) NULL);
-#else /* TCLOBJ */
- Tcl_CreateObjCommand(interp, Tcl_GetStringResult(interp), edgecmd,
- (ClientData) mycontext, (Tcl_CmdDeleteProc *) NULL);
-#endif /* TCLOBJ */
- } else {
- tclhandleString(mycontext->edgeTblPtr, Tcl_GetStringResult(interp), AGID(e));
- }
- setedgeattributes(agroot(g), e, &argv[4], argc - 4);
- reset_layout(gvc, g);
- return TCL_OK;
-
- } else if ((c == 'a') && (strncmp(argv[1], "addnode", length) == 0)) {
- if (argc % 2) {
- /* if odd number of args then argv[2] is name */
-#ifdef WITH_CGRAPH
- n = agnode(g, argv[2], 1);
-#else
- n = agnode(g, argv[2]);
- if (!(np = (Agnode_t **) tclhandleXlateIndex(mycontext->nodeTblPtr, AGID(n))) || *np != n) {
- np = (Agnode_t **) tclhandleAlloc(mycontext->nodeTblPtr, Tcl_GetStringResult(interp), &id);
- *np = n;
- AGID(n) = id;
-#ifndef TCLOBJ
- Tcl_CreateCommand(interp, Tcl_GetStringResult(interp), nodecmd,
- (ClientData) mycontext, (Tcl_CmdDeleteProc *) NULL);
-#else /* TCLOBJ */
- Tcl_CreateObjCommand(interp, Tcl_GetStringResult(interp), nodecmd,
- (ClientData) mycontext, (Tcl_CmdDeleteProc *) NULL);
-#endif /* TCLOBJ */
- } else {
- tclhandleString(mycontext->nodeTblPtr, Tcl_GetStringResult(interp), AGID(n));
- }
-#endif
- i = 3;
- } else {
- /* else use handle as name */
-#ifdef WITH_CGRAPH
- n = agnode(g, Tcl_GetStringResult(interp), 1);
-#else
- np = (Agnode_t **) tclhandleAlloc(mycontext->nodeTblPtr, Tcl_GetStringResult(interp), &id);
- n = agnode(g, Tcl_GetStringResult(interp));
- *np = n;
- AGID(n) = id;
-#ifndef TCLOBJ
- Tcl_CreateCommand(interp, Tcl_GetStringResult(interp), nodecmd,
- (ClientData) mycontext, (Tcl_CmdDeleteProc *) NULL);
-#else /* TCLOBJ */
- Tcl_CreateObjCommand(interp, Tcl_GetStringResult(interp), nodecmd,
- (ClientData) mycontext, (Tcl_CmdDeleteProc *) NULL);
-#endif /* TCLOBJ */
-#endif
- i = 2;
- }
-#ifdef WITH_CGRAPH
- np = (Agnode_t **)tclhandleXlateIndex(mycontext->nodeTblPtr, AGID(n));
- *np = n;
-#endif
- setnodeattributes(agroot(g), n, &argv[i], argc - i);
- reset_layout(gvc, g);
- return TCL_OK;
-
- } else if ((c == 'a')
- && (strncmp(argv[1], "addsubgraph", length) == 0)) {
- if (argc < 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- "\" addsubgraph ?name? ?attributename attributevalue? ?...?",
- NULL);
- }
- if (argc % 2) {
- /* if odd number of args then argv[2] is name */
-#ifdef WITH_CGRAPH
- sg = agsubg(g, argv[2], 1);
-#else
- sg = agsubg(g, argv[2]);
- if (! (sgp = (Agraph_t **) tclhandleXlateIndex(mycontext->graphTblPtr, AGID(sg))) || *sgp != sg) {
- sgp = (Agraph_t **) tclhandleAlloc(mycontext->graphTblPtr, Tcl_GetStringResult(interp), &id);
- *sgp = sg;
- AGID(sg) = id;
-#ifndef TCLOBJ
- Tcl_CreateCommand(interp, Tcl_GetStringResult(interp), graphcmd,
- (ClientData) mycontext, (Tcl_CmdDeleteProc *) NULL);
-#else
- Tcl_CreateObjCommand(interp, Tcl_GetStringResult(interp), graphcmd,
- (ClientData) mycontext, (Tcl_CmdDeleteProc *) NULL);
-#endif
- } else {
- tclhandleString(mycontext->graphTblPtr, Tcl_GetStringResult(interp), AGID(sg));
- }
-#endif
- i = 3;
- } else {
- /* else use handle as name */
-#ifdef WITH_CGRAPH
- sg = agsubg(g, Tcl_GetStringResult(interp), 1);
-#else
- sgp = (Agraph_t **) tclhandleAlloc(mycontext->graphTblPtr, Tcl_GetStringResult(interp), &id);
- sg = agsubg(g, Tcl_GetStringResult(interp));
- *sgp = sg;
- AGID(sg) = id;
-#ifndef TCLOBJ
- Tcl_CreateCommand(interp, Tcl_GetStringResult(interp), graphcmd,
- (ClientData) mycontext, (Tcl_CmdDeleteProc *) NULL);
-#else
- Tcl_CreateObjCommand(interp, Tcl_GetStringResult(interp), graphcmd,
- (ClientData) mycontext, (Tcl_CmdDeleteProc *) NULL);
-#endif
-#endif
- i = 2;
- }
-#ifdef WITH_CGRAPH
- sgp = (Agraph_t **)tclhandleXlateIndex(mycontext->graphTblPtr, AGID(sg));
- *sgp = sg;
-#endif
- setgraphattributes(sg, &argv[i], argc - i);
- reset_layout(gvc, g);
- return TCL_OK;
-
- } else if ((c == 'c') && (strncmp(argv[1], "countnodes", length) == 0)) {
- sprintf(buf, "%d", agnnodes(g));
- Tcl_AppendResult(interp, buf, NULL);
- return TCL_OK;
-
- } else if ((c == 'c') && (strncmp(argv[1], "countedges", length) == 0)) {
- sprintf(buf, "%d", agnedges(g));
- Tcl_AppendResult(interp, buf, NULL);
- return TCL_OK;
-
- } else if ((c == 'd') && (strncmp(argv[1], "delete", length) == 0)) {
- reset_layout(gvc, g);
-#ifndef WITH_CGRAPH
- deleteNodes(mycontext, g);
- deleteGraph(mycontext, g);
-#else
- deleteNodes(g);
- deleteGraph(g);
-#endif
- return TCL_OK;
-
- } else if ((c == 'f') && (strncmp(argv[1], "findedge", length) == 0)) {
- if (argc < 4) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " findedge tailnodename headnodename\"", NULL);
- return TCL_ERROR;
- }
- if (!(tail = agfindnode(g, argv[2]))) {
- Tcl_AppendResult(interp, "Tail node \"", argv[2], "\" not found.", NULL);
- return TCL_ERROR;
- }
- if (!(head = agfindnode(g, argv[3]))) {
- Tcl_AppendResult(interp, "Head node \"", argv[3], "\" not found.", NULL);
- return TCL_ERROR;
- }
- if (!(e = agfindedge(g, tail, head))) {
- Tcl_AppendResult(interp, "Edge \"", argv[2], " - ", argv[3], "\" not found.", NULL);
- return TCL_ERROR;
- }
- tclhandleString(mycontext->edgeTblPtr, buf, AGID(e));
- Tcl_AppendElement(interp, buf);
- return TCL_OK;
-
- } else if ((c == 'f') && (strncmp(argv[1], "findnode", length) == 0)) {
- if (argc < 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " findnode nodename\"", NULL);
- return TCL_ERROR;
- }
- if (!(n = agfindnode(g, argv[2]))) {
- Tcl_AppendResult(interp, "Node not found.", NULL);
- return TCL_ERROR;
- }
- tclhandleString(mycontext->nodeTblPtr, buf, AGID(n));
- Tcl_AppendResult(interp, buf, NULL);
- return TCL_OK;
-
- } else if ((c == 'l')
- && (strncmp(argv[1], "layoutedges", length) == 0)) {
- g = agroot(g);
- if (!GD_drawing(g))
- tcldot_layout(gvc, g, (argc > 2) ? argv[2] : NULL);
- return TCL_OK;
-
- } else if ((c == 'l')
- && (strncmp(argv[1], "layoutnodes", length) == 0)) {
- g = agroot(g);
- if (!GD_drawing(g))
- tcldot_layout(gvc, g, (argc > 2) ? argv[2] : NULL);
- return TCL_OK;
-
- } else if ((c == 'l')
- && (strncmp(argv[1], "listattributes", length) == 0)) {
- listGraphAttrs(interp, g);
- return TCL_OK;
-
- } else if ((c == 'l')
- && (strncmp(argv[1], "listedgeattributes", length) == 0)) {
- listEdgeAttrs (interp, g);
- return TCL_OK;
-
- } else if ((c == 'l')
- && (strncmp(argv[1], "listnodeattributes", length) == 0)) {
- listNodeAttrs (interp, g);
- return TCL_OK;
-
- } else if ((c == 'l') && (strncmp(argv[1], "listedges", length) == 0)) {
- for (n = agfstnode(g); n; n = agnxtnode(g, n)) {
- for (e = agfstout(g, n); e; e = agnxtout(g, e)) {
- tclhandleString(mycontext->edgeTblPtr, buf, AGID(e));
- Tcl_AppendElement(interp, buf);
- }
- }
- return TCL_OK;
-
- } else if ((c == 'l') && (strncmp(argv[1], "listnodes", length) == 0)) {
- for (n = agfstnode(g); n; n = agnxtnode(g, n)) {
- tclhandleString(mycontext->nodeTblPtr, buf, AGID(n));
- Tcl_AppendElement(interp, buf);
- }
- return TCL_OK;
-
- } else if ((c == 'l')
- && (strncmp(argv[1], "listnodesrev", length) == 0)) {
- for (n = aglstnode(g); n; n = agprvnode(g, n)) {
- tclhandleString(mycontext->nodeTblPtr, buf, AGID(n));
- Tcl_AppendElement(interp, buf);
- }
- return TCL_OK;
-
- } else if ((c == 'l')
- && (strncmp(argv[1], "listsubgraphs", length) == 0)) {
-#ifdef WITH_CGRAPH
- for (sg = agfstsubg(g); sg; sg = agnxtsubg(sg)) {
- tclhandleString(mycontext->graphTblPtr, buf, AGID(sg));
- Tcl_AppendElement(interp, buf);
- }
-#else
- if (g->meta_node) {
- for (e = agfstout(g->meta_node->graph, g->meta_node); e;
- e = agnxtout(g->meta_node->graph, e)) {
- sg = agusergraph(aghead(e));
- tclhandleString(mycontext->graphTblPtr, buf, AGID(sg));
- Tcl_AppendElement(interp, buf);
- }
- }
-#endif
- return TCL_OK;
-
- } else if ((c == 'q')
- && (strncmp(argv[1], "queryattributes", length) == 0)) {
- for (i = 2; i < argc; i++) {
- if (Tcl_SplitList
- (interp, argv[i], &argc2,
- (CONST84 char ***) &argv2) != TCL_OK)
- return TCL_ERROR;
- for (j = 0; j < argc2; j++) {
- if ((a = agfindgraphattr(g, argv2[j]))) {
-#ifndef WITH_CGRAPH
- Tcl_AppendElement(interp, agxget(g, a->index));
-#else
- Tcl_AppendElement(interp, agxget(g, a));
-#endif
- } else {
- Tcl_AppendResult(interp, " No attribute named \"", argv2[j], "\"", NULL);
- return TCL_ERROR;
- }
- }
- Tcl_Free((char *) argv2);
- }
- return TCL_OK;
-
- } else if ((c == 'q')
- && (strncmp(argv[1], "queryattributevalues", length) ==
- 0)) {
- for (i = 2; i < argc; i++) {
- if (Tcl_SplitList
- (interp, argv[i], &argc2,
- (CONST84 char ***) &argv2) != TCL_OK)
- return TCL_ERROR;
- for (j = 0; j < argc2; j++) {
- if ((a = agfindgraphattr(g, argv2[j]))) {
- Tcl_AppendElement(interp, argv2[j]);
-#ifndef WITH_CGRAPH
- Tcl_AppendElement(interp, agxget(g, a->index));
-#else
- Tcl_AppendElement(interp, agxget(g, a));
-#endif
- } else {
- Tcl_AppendResult(interp, " No attribute named \"", argv2[j], "\"", NULL);
- return TCL_ERROR;
- }
- }
- Tcl_Free((char *) argv2);
- }
- return TCL_OK;
-
- } else if ((c == 'q')
- && (strncmp(argv[1], "queryedgeattributes", length) == 0)) {
- for (i = 2; i < argc; i++) {
- if (Tcl_SplitList
- (interp, argv[i], &argc2,
- (CONST84 char ***) &argv2) != TCL_OK)
- return TCL_ERROR;
- for (j = 0; j < argc2; j++) {
- if ((a = agfindedgeattr(g, argv2[j]))) {
-#ifndef WITH_CGRAPH
- Tcl_AppendElement(interp, agxget(g->proto->e, a->index));
-#else
- Tcl_AppendElement(interp, agxget(g, a));
-#endif
- } else {
- Tcl_AppendResult(interp, " No attribute named \"", argv2[j], "\"", NULL);
- return TCL_ERROR;
- }
- }
- Tcl_Free((char *) argv2);
- }
- return TCL_OK;
-
- } else if ((c == 'q')
- && (strncmp(argv[1], "queryedgeattributevalues", length) == 0)) {
- for (i = 2; i < argc; i++) {
- if (Tcl_SplitList
- (interp, argv[i], &argc2,
- (CONST84 char ***) &argv2) != TCL_OK)
- return TCL_ERROR;
- for (j = 0; j < argc2; j++) {
- if ((a = agfindedgeattr(g, argv2[j]))) {
- Tcl_AppendElement(interp, argv2[j]);
-#ifndef WITH_CGRAPH
- Tcl_AppendElement(interp, agxget(g->proto->e, a->index));
-#else
- Tcl_AppendElement(interp, agxget(g, a));
-#endif
- } else {
- Tcl_AppendResult(interp, " No attribute named \"",
- argv2[j], "\"", NULL);
- return TCL_ERROR;
- }
- }
- Tcl_Free((char *) argv2);
- }
- return TCL_OK;
-
- } else if ((c == 'q')
- && (strncmp(argv[1], "querynodeattributes", length) == 0)) {
- for (i = 2; i < argc; i++) {
- if (Tcl_SplitList
- (interp, argv[i], &argc2,
- (CONST84 char ***) &argv2) != TCL_OK)
- return TCL_ERROR;
- for (j = 0; j < argc2; j++) {
- if ((a = agfindnodeattr(g, argv2[j]))) {
-#ifndef WITH_CGRAPH
- Tcl_AppendElement(interp, agxget(g->proto->n, a->index));
-#else
- Tcl_AppendElement(interp, agxget(g, a));
-#endif
- } else {
- Tcl_AppendResult(interp, " No attribute named \"",
- argv2[j], "\"", NULL);
- return TCL_ERROR;
- }
- }
- Tcl_Free((char *) argv2);
- }
- return TCL_OK;
-
- } else if ((c == 'q')
- && (strncmp(argv[1], "querynodeattributevalues", length) ==
- 0)) {
- for (i = 2; i < argc; i++) {
- if (Tcl_SplitList
- (interp, argv[i], &argc2,
- (CONST84 char ***) &argv2) != TCL_OK)
- return TCL_ERROR;
- for (j = 0; j < argc2; j++) {
- if ((a = agfindnodeattr(g, argv2[j]))) {
- Tcl_AppendElement(interp, argv2[j]);
-#ifndef WITH_CGRAPH
- Tcl_AppendElement(interp, agxget(g->proto->n, a->index));
-#else
- Tcl_AppendElement(interp, agxget(g, a));
-#endif
- } else {
- Tcl_AppendResult(interp, " No attribute named \"", argv2[j], "\"", NULL);
- return TCL_ERROR;
- }
- }
- Tcl_Free((char *) argv2);
- }
- return TCL_OK;
-
- } else if ((c == 'r') && (strncmp(argv[1], "render", length) == 0)) {
- char *canvas;
-
- if (argc < 3) {
- canvas = "$c";
- } else {
- canvas = argv[2];
-#if 0 /* not implemented */
- if (argc < 4) {
- tkgendata.eval = FALSE;
- } else {
- if ((Tcl_GetBoolean(interp, argv[3], &tkgendata.eval)) !=
- TCL_OK) {
- Tcl_AppendResult(interp, " Invalid boolean: \"",
- argv[3], "\"", NULL);
- return TCL_ERROR;
- }
- }
-#endif
- }
- rc = gvjobs_output_langname(gvc, "tk");
- if (rc == NO_SUPPORT) {
- Tcl_AppendResult(interp, " Format: \"tk\" not recognized.\n", NULL);
- return TCL_ERROR;
- }
-
- gvc->write_fn = Tcldot_string_writer;
- job = gvc->job;
- job->imagedata = canvas;
- job->context = (void *)interp;
- job->external_context = TRUE;
- job->output_file = stdout;
-
- /* make sure that layout is done */
- g = agroot(g);
- if (!GD_drawing(g) || argc > 3)
- tcldot_layout (gvc, g, (argc > 3) ? argv[3] : NULL);
-
- /* render graph TK canvas commands */
- gvc->common.viewNum = 0;
- gvRenderJobs(gvc, g);
- gvrender_end_job(job);
- gvdevice_finalize(job);
- fflush(job->output_file);
- gvjobs_delete(gvc);
- return TCL_OK;
-
-#if HAVE_LIBGD
- } else if ((c == 'r') && (strncmp(argv[1], "rendergd", length) == 0)) {
- void **hdl;
-
- if (argc < 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " rendergd gdhandle ?DOT|NEATO|TWOPI|FDP|CIRCO?\"", NULL);
- return TCL_ERROR;
- }
- rc = gvjobs_output_langname(gvc, "gd:gd:gd");
- if (rc == NO_SUPPORT) {
- Tcl_AppendResult(interp, " Format: \"gd\" not recognized.\n", NULL);
- return TCL_ERROR;
- }
- job = gvc->job;
-
- if (! (hdl = tclhandleXlate(GDHandleTable, argv[2]))) {
- Tcl_AppendResult(interp, "GD Image not found.", NULL);
- return TCL_ERROR;
- }
- job->context = *hdl;
- job->external_context = TRUE;
-
- /* make sure that layout is done */
- g = agroot(g);
- if (!GD_drawing(g) || argc > 4)
- tcldot_layout(gvc, g, (argc > 4) ? argv[4] : NULL);
-
- gvc->common.viewNum = 0;
- gvRenderJobs(gvc, g);
- gvrender_end_job(job);
- gvdevice_finalize(job);
- fflush(job->output_file);
- gvjobs_delete(gvc);
- Tcl_AppendResult(interp, argv[2], NULL);
- return TCL_OK;
-#endif
-
- } else if ((c == 's')
- && (strncmp(argv[1], "setattributes", length) == 0)) {
- if (argc == 3) {
- if (Tcl_SplitList
- (interp, argv[2], &argc2,
- (CONST84 char ***) &argv2) != TCL_OK)
- return TCL_ERROR;
- if ((argc2 == 0) || (argc2 % 2)) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- "\" setattributes attributename attributevalue ?attributename attributevalue? ?...?",
- NULL);
- Tcl_Free((char *) argv2);
- return TCL_ERROR;
- }
- setgraphattributes(g, argv2, argc2);
- Tcl_Free((char *) argv2);
- reset_layout(gvc, g);
- }
- if (argc == 4 && strcmp(argv[2], "viewport") == 0) {
- /* special case to allow viewport to be set without resetting layout */
- setgraphattributes(g, &argv[2], argc - 2);
- } else {
- if ((argc < 4) || (argc % 2)) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- "\" setattributes attributename attributevalue ?attributename attributevalue? ?...?",
- NULL);
- return TCL_ERROR;
- }
- setgraphattributes(g, &argv[2], argc - 2);
- reset_layout(gvc, g);
- }
- return TCL_OK;
-
- } else if ((c == 's')
- && (strncmp(argv[1], "setedgeattributes", length) == 0)) {
- if (argc == 3) {
- if (Tcl_SplitList
- (interp, argv[2], &argc2,
- (CONST84 char ***) &argv2) != TCL_OK)
- return TCL_ERROR;
- if ((argc2 == 0) || (argc2 % 2)) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- "\" setedgeattributes attributename attributevalue ?attributename attributevalue? ?...?",
- NULL);
- Tcl_Free((char *) argv2);
- return TCL_ERROR;
- }
-#ifndef WITH_CGRAPH
- setedgeattributes(g, g->proto->e, argv2, argc2);
-#else
- setedgeattributes(g, NULL, argv2, argc2);
-#endif
- Tcl_Free((char *) argv2);
- } else {
- if ((argc < 4) || (argc % 2)) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- "\" setedgeattributes attributename attributevalue ?attributename attributevalue? ?...?",
- NULL);
- }
-#ifndef WITH_CGRAPH
- setedgeattributes(g, g->proto->e, &argv[2], argc - 2);
-#else
- setedgeattributes(g, NULL, &argv[2], argc - 2);
-#endif
- }
- reset_layout(gvc, g);
- return TCL_OK;
-
- } else if ((c == 's')
- && (strncmp(argv[1], "setnodeattributes", length) == 0)) {
- if (argc == 3) {
- if (Tcl_SplitList
- (interp, argv[2], &argc2,
- (CONST84 char ***) &argv2) != TCL_OK)
- return TCL_ERROR;
- if ((argc2 == 0) || (argc2 % 2)) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- "\" setnodeattributes attributename attributevalue ?attributename attributevalue? ?...?",
- NULL);
- Tcl_Free((char *) argv2);
- return TCL_ERROR;
- }
-#ifndef WITH_CGRAPH
- setnodeattributes(g, g->proto->n, argv2, argc2);
-#else
- setnodeattributes(g, NULL, argv2, argc2);
-#endif
- Tcl_Free((char *) argv2);
- } else {
- if ((argc < 4) || (argc % 2)) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- "\" setnodeattributes attributename attributevalue ?attributename attributevalue? ?...?",
- NULL);
- }
-#ifndef WITH_CGRAPH
- setnodeattributes(g, g->proto->n, &argv[2], argc - 2);
-#else
- setnodeattributes(g, NULL, &argv[2], argc - 2);
-#endif
- }
- reset_layout(gvc, g);
- return TCL_OK;
-
- } else if ((c == 's') && (strncmp(argv[1], "showname", length) == 0)) {
- Tcl_SetResult(interp, agnameof(g), TCL_STATIC);
- return TCL_OK;
-
- } else if ((c == 'w') && (strncmp(argv[1], "write", length) == 0)) {
- g = agroot(g);
- if (argc < 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " write fileHandle ?language ?DOT|NEATO|TWOPI|FDP|CIRCO|NOP??\"",
- NULL);
- return TCL_ERROR;
- }
-
- /* process lang first to create job */
- if (argc < 4) {
- i = gvjobs_output_langname(gvc, "dot");
- } else {
- i = gvjobs_output_langname(gvc, argv[3]);
- }
- if (i == NO_SUPPORT) {
- const char *s = gvplugin_list(gvc, API_render, argv[3]);
- Tcl_AppendResult(interp, "Bad langname: \"", argv[3], "\". Use one of:", s, NULL);
- return TCL_ERROR;
- }
-
- gvc->write_fn = Tcldot_channel_writer;
- job = gvc->job;
-
- /* populate new job struct with output language and output file data */
- job->output_lang = gvrender_select(job, job->output_langname);
-
-// if (Tcl_GetOpenFile (interp, argv[2], 1, 1, &outfp) != TCL_OK)
-// return TCL_ERROR;
-// job->output_file = (FILE *)outfp;
-
- {
- Tcl_Channel chan;
- int mode;
-
- chan = Tcl_GetChannel(interp, argv[2], &mode);
-
- if (!chan) {
- Tcl_AppendResult(interp, "Channel not open: \"", argv[2], NULL);
- return TCL_ERROR;
- }
- if (!(mode & TCL_WRITABLE)) {
- Tcl_AppendResult(interp, "Channel not writable: \"", argv[2], NULL);
- return TCL_ERROR;
- }
- job->output_file = (FILE *)chan;
- }
- job->output_filename = NULL;
-
- /* make sure that layout is done - unless canonical output */
- if ((!GD_drawing(g) || argc > 4) && !(job->flags & LAYOUT_NOT_REQUIRED)) {
- tcldot_layout(gvc, g, (argc > 4) ? argv[4] : NULL);
- }
-
- gvc->common.viewNum = 0;
- gvRenderJobs(gvc, g);
- gvdevice_finalize(job);
-// fflush(job->output_file);
- gvjobs_delete(gvc);
- return TCL_OK;
-
- } else {
- Tcl_AppendResult(interp, "bad option \"", argv[1],
- "\": must be one of:",
- "\n\taddedge, addnode, addsubgraph, countedges, countnodes,",
- "\n\tlayout, listattributes, listedgeattributes, listnodeattributes,",
- "\n\tlistedges, listnodes, listsubgraphs, render, rendergd,",
- "\n\tqueryattributes, queryedgeattributes, querynodeattributes,",
- "\n\tqueryattributevalues, queryedgeattributevalues, querynodeattributevalues,",
- "\n\tsetattributes, setedgeattributes, setnodeattributes,",
- "\n\tshowname, write.", NULL);
- return TCL_ERROR;
- }
-} /* graphcmd */
-
static int dotnew(ClientData clientData, Tcl_Interp * interp,
#ifndef TCLOBJ
int argc, char *argv[]
--- /dev/null
+/* $Id$ $Revision$ */
+/* vim:set shiftwidth=4 ts=8: */
+
+/*************************************************************************
+ * Copyright (c) 2011 AT&T Intellectual Property
+ * All rights reserved. This program and the accompanying materials
+ * are made available under the terms of the Eclipse Public License v1.0
+ * which accompanies this distribution, and is available at
+ * http://www.eclipse.org/legal/epl-v10.html
+ *
+ * Contributors: See CVS logs. Details at http://www.graphviz.org/
+ *************************************************************************/
+
+
+/* avoid compiler warnings with template changes in Tcl8.4 */
+/* specifically just the change to Tcl_CmdProc */
+#define USE_NON_CONST
+#include <tcl.h>
+#include "render.h"
+#include "gvc.h"
+#include "gvio.h"
+#include "tclhandle.h"
+
+#ifndef CONST84
+#define CONST84
+#endif
+
+/* ******* not ready yet
+#if (TCL_MAJOR_VERSION > 7)
+#define TCLOBJ
+#if (TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION == 0)
+char *
+Tcl_GetString(Tcl_Obj *obj) {
+ int len;
+ return (Tcl_GetStringFromObj(obj, &len));
+}
+#else
+#define UTF8
+#endif
+#endif
+********* */
+
+typedef struct {
+#ifdef WITH_CGRAPH
+ Agdisc_t mydisc; // must be first to allow casting mydisc to mycontext
+#endif
+ void *graphTblPtr, *nodeTblPtr, *edgeTblPtr;
+ Tcl_Interp *interp;
+ GVC_t *gvc;
+} mycontext_t;
+
+/* Globals */
+
+#if HAVE_LIBGD
+extern void *GDHandleTable;
+extern int Gdtclft_Init(Tcl_Interp *);
+#endif
+
+#ifndef WITH_CGRAPH
+#undef AGID
+#define AGID(x) ((x)->handle)
+#endif
+
+extern int graphcmd(ClientData clientData, Tcl_Interp * interp,
+#ifndef TCLOBJ
+ int argc, char *argv[]
+#else
+ int argc, Tcl_Obj * CONST objv[]
+#endif
+ );
+extern int nodecmd(ClientData clientData, Tcl_Interp * interp,
+#ifndef TCLOBJ
+ int argc, char *argv[]
+#else
+ int argc, Tcl_Obj * CONST objv[]
+#endif
+ );
+extern int edgecmd(ClientData clientData, Tcl_Interp * interp,
+#ifndef TCLOBJ
+ int argc, char *argv[]
+#else
+ int argc, Tcl_Obj * CONST objv[]
+#endif
+ );
+
+#ifdef WITH_CGRAPH
+extern void deleteEdges(Agraph_t * g, Agnode_t * n);
+extern void deleteNodes(Agraph_t * g);
+extern void deleteGraph(Agraph_t * g);
+extern void listGraphAttrs (Tcl_Interp * interp, Agraph_t* g);
+extern void listNodeAttrs (Tcl_Interp * interp, Agraph_t* g);
+extern void listEdgeAttrs (Tcl_Interp * interp, Agraph_t* g);
+#else
+extern void deleteEdges(mycontext_t * mycontext, Agraph_t * g, Agnode_t * n);
+extern void deleteNodes(mycontext_t * mycontext, Agraph_t * g);
+extern void deleteGraph(mycontext_t * mycontext, Agraph_t * g);
+extern void listGraphAttrs (Tcl_Interp * interp, Agraph_t* g);
+extern void listNodeAttrs (Tcl_Interp * interp, Agraph_t* g);
+extern void listEdgeAttrs (Tcl_Interp * interp, Agraph_t* g);
+#endif
+
+extern void setgraphattributes(Agraph_t * g, char *argv[], int argc);
+extern void setedgeattributes(Agraph_t * g, Agedge_t * e, char *argv[], int argc);
+extern void setnodeattributes(Agraph_t * g, Agnode_t * n, char *argv[], int argc);
+
+extern size_t Tcldot_string_writer(GVJ_t *job, const char *s, size_t len);
+extern size_t Tcldot_channel_writer(GVJ_t *job, const char *s, size_t len);
+
+extern void tcldot_layout(GVC_t *gvc, Agraph_t * g, char *engine);
+extern void reset_layout(GVC_t *gvc, Agraph_t * sg);
+
+
+
+
+
+
+
+