/*
* Parse paragraph or argument. Called recursively.
* Return 0 if no substitution made.
* Generally: caller frees string returned when no longer needed.
*  \cmd  [arg]{arg}{arg}   (optional space between cmd and arg)
*  \"{}  \"x
*  {\bf }
*  \begin{x} \begin{x}{arg}{...} \end{x}
*  not yet: \begin{x}[opt]
*  $...$
*  &
*/
#include <tcl.h>
#include <string.h>    /* strchr(), strerror() */
#include <stdlib.h>    /* getopt() */
#include <ctype.h>
#include <memory.h>
#include <errno.h>
#include <sys/param.h> /* MAXPATHLEN */
#include "ansi.h"
#include "l2x.h"
#define MAX_ARGS 10

struct cmd_struct {
  char *name;         /* LaTeX name */
  char *tcl_name;     /* name of Tcl command */
  int  max_optional;  /* maximum number of [] arguments */
  int  max_args;      /* maximum number of {} arguments */
  int  dne;           /* do not evaluate args */
  int  recheck;       /* get new arg count after first (\begin) */
};
/* For extracting pieces to be passed whole to a Tcl routine */
static struct {
  char *type;         /* type of environment */
  char *delimiter;    /* what ends environment */
} extract;
static Tcl_HashTable cmd_table;

/* white space waiting */
static int white = 0;

static void white_set()
{
  white = 1;
} /* white_set */

/*
* Either show or swallow (before &, \\) white space.
*/
static void white_out(Tcl_DString *d, int show)
{
  if (white) {
    if (show) Tcl_DStringAppend(d, " ", 1);
    white = 0;
  }
} /* white_show */

/*
* Append result of evaluation of 'cmd' to DString 'd'.
* Parse if 'p' is true. Set string to zero if 'trunc' is true.
*/
void Tcl_DStringEval(Tcl_Interp *interp, int p, char *cmd, 
  int trunc, Tcl_DString *d)
{
  int status;

  if (p) {
    status = Tcl_VarEval(interp, "parse {", cmd, "}", NULL);
  }
  else {
    status = Tcl_Eval(interp, cmd);
  }
  if (status == TCL_OK) {
    if (trunc) Tcl_DStringTrunc(d, 0);
    Tcl_DStringAppend(d, interp->result, -1);
  }
  else {
    fprintf(stderr, "Error in %s: %s\n", cmd, interp->result);
  }
} /* Tcl_DStringEval */

/*
* Suspend (client=1) and reactivate (client=0) parser (needed for
* verbatim, verb, and math mode).  If command has argument
* (delimiter), treat as 'verb', rather than verbatim.  Arguments: type
* [verb, verbatim, equation, ...] delimiter.
*/
int parser_suspend(ClientData client, Tcl_Interp *interp, 
  int argc, char *argv[])
{
  if ((int)client) {
    extract.type = 0;
    if (argc > 1) extract.type      = strdup(argv[1]);
    extract.delimiter = 0;
    if (argc > 2) extract.delimiter = strdup(argv[2]);
  }
  else {
    if (extract.type) {
      free(extract.type);
      extract.type = 0;
    }
    if (extract.delimiter) {
      free(extract.delimiter);
      extract.delimiter = 0;
    }
  }
  return TCL_OK;
} /* parser_suspend */


/*
* Enter commands into hash table: name [args] [optional] [command] [e|r]
*/
int parser_init(ClientData client, Tcl_Interp *interp, int argc, char *argv[])
{
  Tcl_HashEntry *e;
  int new;
  struct cmd_struct *c;
  static initialized = 0;

  if (!initialized) {
    Tcl_InitHashTable(&cmd_table, TCL_STRING_KEYS);
    initialized = 1;
  }

  c = (struct cmd_struct *)malloc(sizeof(struct cmd_struct));
  c->name         = strsave(argv[1]);
  c->tcl_name     = (argc > 4 && *argv[4]) ? strsave(argv[4]) : strsave(argv[1]);
  c->max_args     = argc > 2 ? atoi(argv[2]) : 0;
  c->max_optional = argc > 3 ? atoi(argv[3]) : 0;
  c->dne          = argc > 5 ? strchr(argv[5], 'e') != 0 : 0;
  c->recheck      = argc > 5 ? strchr(argv[5], 'r') != 0 : 0;
  e = Tcl_CreateHashEntry(&cmd_table, c->name, &new);
  Tcl_SetHashValue(e, c);
  return TCL_OK;
} /* parser_init */


/*
* Return pointer to command descriptor.
*/
struct cmd_struct *parse_find(char *name)
{
  Tcl_HashEntry *e;
  e = Tcl_FindHashEntry(&cmd_table, name);
  if (e) {
    return (struct cmd_struct *)Tcl_GetHashValue(e);
  }
  return 0;
} /* parse_find */


/*
* Evaluate given command.
*/
static int parse_eval(Tcl_Interp *interp, Tcl_DString *ds,
  Tcl_DString *cmd, Tcl_DString *optional, int args_seen, Tcl_DString *bargv)
{
  int i;
  struct cmd_struct *cs;
  char *cmd_e;  /* command to be evaluated */

  if (Tcl_DStringLength(cmd) > 0) {
    cs = parse_find(cmd->string);
    cmd_e = cs ? (cs->tcl_name ? cs->tcl_name : cs->name) : cmd->string;

    /* process optional [] arguments recursively */
    if (Tcl_DStringLength(optional) > 0) {
      Tcl_DStringEval(interp, 1, optional->string, 1, optional);
    } 
    /* process {} arguments recursively */
    if (cs && !cs->dne) {
      for (i = 0; i < args_seen; i++) {
        Tcl_DStringEval(interp, 1, bargv[i].string, 1, &bargv[i]);
      }
    }
    if (cs) {
      if (Tcl_VarEval(interp, cmd_e, " command ",
        "{", optional->string, "} ", args_seen > 0 ? "" : NULL,
        "{", bargv[0].string,  "} ", args_seen > 1 ? "" : NULL,
        "{", bargv[1].string,  "} ", args_seen > 2 ? "" : NULL,
        "{", bargv[2].string,  "} ", args_seen > 3 ? "" : NULL,
        "{", bargv[3].string,  "} ",
        NULL) == TCL_OK) {
         Tcl_DStringAppend(ds, interp->result, -1);
      }
      else {
        fprintf(stderr, "Cannot evaluate %s (%s): %s\n", 
          cmd->string, cmd_e, interp->result);
      }
    }
    /* not defined - call "undefined" */
    else {
      if (Tcl_VarEval(interp, "undefined ", cmd_e, NULL) == TCL_OK) {
        Tcl_DStringAppend(ds, interp->result, -1);
      }
      else {
        fprintf(stderr, "Cannot evaluate %s (%s): %s\n", 
          cmd->string, cmd_e, interp->result);
      }
    }
    Tcl_DStringTrunc(cmd, 0);
    Tcl_DStringTrunc(optional, 0);
    for (i = 0; i < args_seen; i++) {
      Tcl_DStringTrunc(&bargv[i], 0);
    }
  }
  return 0;
} /* parse_eval */

/*
* Return last character.
*/
static char lastchar(Tcl_DString *ds)
{
  int len = Tcl_DStringLength(ds);
  char *s = Tcl_DStringValue(ds);

  if (len > 0) return s[len-1];
  return 0;
} /* lastchar */


/*
* Parse text string. Return first argument, after substitutions.
*/
int parse(ClientData client, Tcl_Interp *interp, int argc, char *argv[])
{
  char *s;
  enum {S_initial, S_cmd, S_opt_arg, S_optional, S_arg} 
    state = S_initial;
  char cmd_eval[80];
  /* text, command and expansion */
  Tcl_DString ds, cmd, optional, bargv[MAX_ARGS], ex;
  /* state at [0]: global, [1]: beginning of command */
  struct {
    int brace;                 /* brace level (0, ...) */
    int bracket;               /* bracket level (0, ...) */
  } stack[2];
  int rquote = 0, lquote = 0;  /* right and left quotes */
  int dashes = 0;              /* current number of dashes */
  int i, args_seen;
  int optional_seen;
  int max_optional, max_args;
  struct cmd_struct *cs;

  Tcl_DStringInit(&ds);
  Tcl_DStringInit(&cmd);
  Tcl_DStringInit(&optional);
  Tcl_DStringInit(&ex);
  for (i = 0; i < MAX_ARGS; i++) {
    Tcl_DStringInit(&bargv[i]);
  }

  stack[0].brace = 0;
  stack[0].bracket = 0;

  for (s = argv[1]; *s; s++) {
    switch(state) {
    case S_initial:
      /* process any pending commands */
      parse_eval(interp, &ds, &cmd, &optional, args_seen, bargv);
      if (extract.delimiter) {
        /* delimiter matched - call function */
        if (strncmp(s, extract.delimiter, strlen(extract.delimiter)) == 0) {
           /* call function and add result */
           s += strlen(extract.delimiter);
           Tcl_DStringAppend(&ex, "}", -1);
           Tcl_DStringEval(interp, 0, ex.string, 0, &ds);
           Tcl_DStringSetLength(&ex, 0);
           parser_suspend(0, interp, 0, 0);
        }
        else {
          /* prepend "body" to command */
          if (Tcl_DStringLength(&ex) == 0) {
            Tcl_DStringAppend(&ex, extract.type, -1);
            Tcl_DStringAppend(&ex, " body {", -1);
          }
          Tcl_DStringAppend(&ex, s, 1);
          break;
        }
      }

      /* -, --, --- */
      if (dashes && *s != '-') {
        sprintf(cmd_eval, "dash %d", dashes);
        Tcl_DStringEval(interp, 0, cmd_eval, 0, &ds); 
        dashes = 0;
      }

      if (lquote == 2) {
        sprintf(cmd_eval, "lquote");
        Tcl_DStringEval(interp, 0, cmd_eval, 0, &ds); 
        lquote = 0;
      }
      else if (lquote && *s != '`') {
        Tcl_DStringAppend(&ds, "`", -1);
        lquote = 0;
      }

      /* right quote */
      if (rquote == 2) {
        sprintf(cmd_eval, "rquote");
        Tcl_DStringEval(interp, 0, cmd_eval, 0, &ds); 
        rquote = 0;
      }
      else if (rquote && *s != '\'') {
        Tcl_DStringAppend(&ds, "'", -1);
        rquote = 0;
      }

      /* single characters */
      if (*s == '\\') {
        white_out(&ds, 1);
        args_seen = stack[1].brace = stack[1].bracket = 0;
        Tcl_DStringTrunc(&optional, 0);
        state = S_cmd;
      }
      else if (*s == '\n') {
        if (lastchar(&ds) && lastchar(&ds) != '\n') {
          Tcl_DStringAppend(&ds, s, 1);
        }
      }
      /* white space: save up for later (possible) use */
      else if (isspace(*s)) {
        white_set();
      }
      else {
        switch (*s) {
        case '{':
          white_out(&ds, 1);
          stack[0].brace++;
          sprintf(cmd_eval, "group begin %d", stack[0].brace);
          Tcl_DStringEval(interp, 0, cmd_eval, 0, &ds); 
          break;

        case '}':
          white_out(&ds, 0);
          sprintf(cmd_eval, "group end %d", stack[0].brace);
          Tcl_DStringEval(interp, 0, cmd_eval, 0, &ds); 
          stack[0].brace--;
          break;

        case '~':
          white_out(&ds, 1);
          Tcl_DStringEval(interp, 0, "tie", 0, &ds);
          break;

        case '$':
          white_out(&ds, 1);
          Tcl_DStringEval(interp, 0, "$", 0, &ds);
          break;

        case '-':
          white_out(&ds, 1);
          dashes++;
          break;

        case '`':
          white_out(&ds, 1);
          lquote++;
          break;

        case '\'':
          white_out(&ds, 1);
          rquote++;
          break;

        case '<':
          white_out(&ds, 1);
          sprintf(cmd_eval, "lt");
          Tcl_DStringEval(interp, 0, cmd_eval, 0, &ds); 
          break;

        case '>':
          white_out(&ds, 1);
          sprintf(cmd_eval, "gt");
          Tcl_DStringEval(interp, 0, cmd_eval, 0, &ds); 
          break;

        case '&':
          white_out(&ds, 0);
          sprintf(cmd_eval, "ampersand");
          Tcl_DStringEval(interp, 0, cmd_eval, 0, &ds); 
          break;

        default:
          white_out(&ds, 1);
          Tcl_DStringAppend(&ds, s, 1);
        }
      }
      break;

    /* command word */
    case S_cmd:
      /* either "\ " or punctuation (but not @) ends command */
      if (Tcl_DStringLength(&cmd) == 0 && 
            ((ispunct(*s) && (*s != '@')) || isspace(*s) || (*s == '~'))) {
        /* for [, we need to prefix with \ to satisfy Tcl */
        if (*s == '[') Tcl_DStringAppend(&cmd, "\\", 1);
        Tcl_DStringAppend(&cmd, s, 1);
        state = S_opt_arg;
      }
      /* white space after \command will be swallowed */
      else if (isspace(*s)) {
        state = S_opt_arg;
      }
      else if (strchr("{}[].;,|+-=#$%^&()_~<>?:\\\"'", *s) || isdigit(*s)) {
        state = S_opt_arg;
        s--;  /* need to revisit this character... */
      }
      else {
        Tcl_DStringAppend(&cmd, s, 1);      
      }
      /* command complete */
      if (state != S_cmd) {
        cs = parse_find(cmd.string);
        if (cs) {
          max_optional   = cs->max_optional;
          max_args       = cs->max_args;
        }
        else {
          max_optional   = 0;
          max_args       = 0;
        }
        args_seen = 0;
        optional_seen = 0;
      }
      break;

    /* optional [] argument */
    case S_optional:
      if      (*s == '{') stack[1].brace++;
      else if (*s == '}') stack[1].brace--;
      else if (*s == '[') stack[1].bracket++;
      else if (*s == ']') stack[1].bracket--;
      if (stack[1].brace == 0 && stack[1].bracket == 0) {
        state = S_opt_arg;
        optional_seen++;
      }
      else if (stack[1].bracket > 1 || *s != '[') {
        Tcl_DStringAppend(&optional, s, 1);
      }
      break;

    /* argument with or without braces */
    case S_arg:
      if (*s == '{') {
        stack[1].brace++;
      }
      else if (*s == '}') stack[1].brace--;
      if (stack[1].brace == 0) {
        if (*s != '}') Tcl_DStringAppend(&bargv[args_seen], s, 1);
        /* 
         * After first arg, recompute argument count to allow
         * for \begin{tabular}{lcl}, \begin{deflist}{width} and kindred.
         */
        if (args_seen == 0 && cs && cs->recheck) {
          cs = parse_find(bargv[0].string);
          if (cs) {
            max_optional = cs->max_optional;
            max_args     = cs->max_args;
          }
        }
        args_seen++;
        state = S_opt_arg;
      }
      /* don't save opening brace of argument */
      else if (stack[1].brace > 1 || *s != '{') { 
        Tcl_DStringAppend(&bargv[args_seen], s, 1);
      }
      break;

    /* either optional or regular argument */
    case S_opt_arg:
      /* space between arguments */
      if (isspace(*s) && (args_seen < max_args || optional_seen < max_optional)) {
        state = S_opt_arg;
      }
      else if (*s == '[' && max_optional) {
        state = S_optional;
        s--;
      }
      else if (args_seen < max_args) {
        state = S_arg;
        s--;
      }
      else {
        state = S_initial;
        s--;
      }
      break;
    }
  }
  parse_eval(interp, &ds, &cmd, &optional, args_seen, bargv);

  Tcl_DStringFree(&optional);
  Tcl_DStringFree(&ex);
  for (i = 0; i < MAX_ARGS; i++) Tcl_DStringFree(&bargv[i]);
  Tcl_DStringFree(&cmd);
  Tcl_DStringResult(interp, &ds);
  return TCL_OK;
} /* parse */


/*
* Read and parse a file: type opt filename.
* Filename '-' indicates stdin. 'type' and 'opt' aren't used.
* Return value.
*/
int parse_file(ClientData client, Tcl_Interp *interp,
  int argc, char *argv[])
{
  FILE *in;
  char buffer[MAXPATHLEN], *fn;
  int ch;
  char c, prior_c = 0;
  int comment = 0;
  Tcl_DString ds;

  if (argc != 4) {
    sprintf(interp->result, "wrong # args");
    return TCL_ERROR;
  }

  fn = argv[3];
  if (strcmp(fn, "-") == 0) {
    in = stdin;
  }
  else {
    if ((in = fopen(fn, "r")) == NULL) {
      /* if that fails, try appending .tex */
      sprintf(buffer, "%s.tex", fn);
      in = fopen(buffer, "r");
    }
    if (in == NULL) {
      sprintf(interp->result, "%s: %s", fn, strerror(errno));
      return TCL_ERROR;
    }
  }
  Tcl_DStringInit(&ds);
  while ((ch = fgetc(in)) != EOF) {
    c = ch;

    if (comment && c == '\n') comment = 0;
    else if (prior_c != '\\' && c == '%') comment = 1;
    if (!comment) Tcl_DStringAppend(&ds, &c, 1);
    prior_c = c;
  }
  Tcl_DStringEval(interp, /*parse*/ 1, ds.string, /*trunc*/ 1, &ds);
  Tcl_DStringResult(interp, &ds);
  return TCL_OK;
} /* parse_file */
