text.mod/graphviz.mod/graphviz/tclpkg/tcldot/tcldot.c

/*************************************************************************
 * 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
 * https://www.eclipse.org/legal/epl-v10.html
 *
 * Contributors: Details at https://graphviz.org
 *************************************************************************/

#include "tcldot.h"
#include <cgraph/rdr.h>
#include <stdlib.h>
#include <string.h>
#include <tcl.h>
#include <util/alloc.h>

static int dotnew_internal(ClientData clientData, Tcl_Interp *interp, int argc,
                           char *argv[]) {
  ictx_t *ictx = (ictx_t *)clientData;
  Agraph_t *g;
  int i;
  Agdesc_t kind;

  if ((argc < 2)) {
    Tcl_AppendResult(
        interp, "wrong # args: should be \"", argv[0],
        " graphtype ?graphname? ?attributename attributevalue? ?...?\"", NULL);
    return TCL_ERROR;
  }
  if (strcmp("digraph", argv[1]) == 0) {
    kind = Agdirected;
  } else if (strcmp("digraphstrict", argv[1]) == 0) {
    kind = Agstrictdirected;
  } else if (strcmp("graph", argv[1]) == 0) {
    kind = Agundirected;
  } else if (strcmp("graphstrict", argv[1]) == 0) {
    kind = Agstrictundirected;
  } else {
    Tcl_AppendResult(interp, "bad graphtype \"", argv[1], "\": must be one of:",
                     "\n\tdigraph, digraphstrict, graph, graphstrict.", NULL);
    return TCL_ERROR;
  }
  if (argc % 2) {
    /* if odd number of args then argv[2] is name */
    g = agopen(argv[2], kind, (Agdisc_t *)ictx);
    i = 3;
  } else {
    /* else use handle as name */
#if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 4
    char *name = gv_strdup(Tcl_GetStringResult(interp));
    g = agopen(name, kind, (Agdisc_t *)ictx);
    free(name);
#else
    g = agopen(Tcl_GetStringResult(interp), kind, (Agdisc_t *)ictx);
#endif
    i = 2;
  }
  if (!g) {
    Tcl_AppendResult(interp, "\nFailure to open graph.", NULL);
    return TCL_ERROR;
  }
  setgraphattributes(g, &argv[i], argc - i);
  Tcl_AppendResult(interp, obj2cmd(g), NULL);

  return TCL_OK;
}

static int dotnew(ClientData clientData, Tcl_Interp *interp, int argc,
                  const char *argv[]) {
  char **argv_copy = tcldot_argv_dup(argc, argv);
  int rc = dotnew_internal(clientData, interp, argc, argv_copy);
  tcldot_argv_free(argc, argv_copy);
  return rc;
}

static int dotread(ClientData clientData, Tcl_Interp *interp, int argc,
                   const char *argv[]) {
  Agraph_t *g;
  Tcl_Channel channel;
  int mode;
  ictx_t *ictx = (ictx_t *)clientData;

  ictx->myioDisc.afread =
      myiodisc_afread; /* replace afread to use Tcl Channels */

  if (argc < 2) {
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
                     " fileHandle\"", NULL);
    return TCL_ERROR;
  }
  channel = Tcl_GetChannel(interp, argv[1], &mode);
  if (channel == NULL || !(mode & TCL_READABLE)) {
    Tcl_AppendResult(interp, "\nChannel \"", argv[1], "\"", "is unreadable.",
                     NULL);
    return TCL_ERROR;
  }
  /*
   * read a graph from the channel, the channel is left open
   *   ready to read the first line after the last line of
   *   a properly parsed graph. If the graph doesn't parse
   *   during reading then the channel will be left at EOF
   */
  g = agread((FILE *)channel, (Agdisc_t *)clientData);
  if (!g) {
    Tcl_AppendResult(interp, "\nFailure to read graph \"", argv[1], "\"", NULL);
    if (agerrors()) {
      Tcl_AppendResult(interp, " because of syntax errors.", NULL);
    }
    return TCL_ERROR;
  }
  if (agerrors()) {
    Tcl_AppendResult(interp, "\nSyntax errors in file \"", argv[1], " \"",
                     NULL);
    return TCL_ERROR;
  }
  Tcl_AppendResult(interp, obj2cmd(g), NULL);
  return TCL_OK;
}

static int dotstring(ClientData clientData, Tcl_Interp *interp, int argc,
                     const char *argv[]) {
  Agraph_t *g;
  ictx_t *ictx = (ictx_t *)clientData;
  rdr_t rdr;

  if (argc < 2) {
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " string\"",
                     NULL);
    return TCL_ERROR;
  }

  ictx->myioDisc.afread =
      myiodisc_memiofread; /* replace afread to use memory range */
  rdr.data = argv[1];
  rdr.len = strlen(rdr.data);
  rdr.cur = 0;

  /* agmemread() is broken for our use because it replaces the id disc */
  g = agread(&rdr, (Agdisc_t *)clientData);
  if (!g) {
    Tcl_AppendResult(interp, "\nFailure to read string \"", argv[1], "\"",
                     NULL);
    if (agerrors()) {
      Tcl_AppendResult(interp, " because of syntax errors.", NULL);
    }
    return TCL_ERROR;
  }
  if (agerrors()) {
    Tcl_AppendResult(interp, "\nSyntax errors in string \"", argv[1], " \"",
                     NULL);
    return TCL_ERROR;
  }
  Tcl_AppendResult(interp, obj2cmd(g), NULL);
  return TCL_OK;
}

int Tcldot_Init(Tcl_Interp *interp);
int Tcldot_Init(Tcl_Interp *interp) {
  ictx_t *ictx = calloc(1, sizeof(ictx_t));
  if (!ictx)
    return TCL_ERROR;

  ictx->interp = interp;
  /* build disciplines dynamically so we can selectively replace functions */

  ictx->myioDisc.afread =
      NULL; /* set in dotread() or dotstring() according to need */
  ictx->myioDisc.putstr = AgIoDisc.putstr; /* no change */
  ictx->myioDisc.flush = AgIoDisc.flush;   /* no change */

  ictx->mydisc.id = &myiddisc;         /* complete replacement */
  ictx->mydisc.io = &(ictx->myioDisc); /* change parts */

  ictx->ctr = 1; /* init to first odd number,  increment by 2 */

#ifdef USE_TCL_STUBS
  if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
    return TCL_ERROR;
  }
#else
  if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 0) == NULL) {
    return TCL_ERROR;
  }
#endif
  // inter-release Graphviz versions have a number including '~dev.' that does
  // not comply with TCL version number rules, so replace this with 'b'
  char adjusted_version[sizeof(PACKAGE_VERSION)] = PACKAGE_VERSION;
  char *tilde_dev = strstr(adjusted_version, "~dev.");
  if (tilde_dev != NULL) {
    *tilde_dev = 'b';
    memmove(tilde_dev + 1, tilde_dev + strlen("~dev."),
            strlen(tilde_dev + strlen("~dev.")) + 1);
  }
  if (Tcl_PkgProvide(interp, "Tcldot", adjusted_version) != TCL_OK) {
    return TCL_ERROR;
  }

#ifdef HAVE_LIBGD
  Gdtclft_Init(interp);
#endif

  /* create a GraphViz Context and pass a pointer to it in clientdata */
  ictx->gvc = gvContextPlugins(lt_preloaded_symbols, DEMAND_LOADING);

  Tcl_CreateCommand(interp, "dotnew", dotnew, ictx, free);
  Tcl_CreateCommand(interp, "dotread", dotread, ictx, NULL);
  Tcl_CreateCommand(interp, "dotstring", dotstring, ictx, NULL);

  return TCL_OK;
}

int Tcldot_SafeInit(Tcl_Interp *interp);
int Tcldot_SafeInit(Tcl_Interp *interp) { return Tcldot_Init(interp); }

int Tcldot_builtin_Init(Tcl_Interp *interp);
int Tcldot_builtin_Init(Tcl_Interp *interp) { return Tcldot_Init(interp); }