Fossil

/*
** The implementation of the TH core. This file contains the parser, and
** the implementation of the interface in th.h.
*/

#include "config.h"
#include "th.h"
#include <string.h>
#include <assert.h>

typedef struct Th_Command        Th_Command;
typedef struct Th_Frame          Th_Frame;
typedef struct Th_Variable       Th_Variable;
typedef struct Th_InterpAndList  Th_InterpAndList;

/*
** Interpreter structure.
*/
struct Th_Interp {
  Th_Vtab *pVtab;     /* Copy of the argument passed to Th_CreateInterp() */
  char *zResult;      /* Current interpreter result (Th_Malloc()ed) */

*/
struct Th_Variable {
  int nRef;                   /* Number of references to this structure */
  int nData;                  /* Number of bytes at Th_Variable.zData */
  char *zData;                /* Data for scalar variables */
  Th_Hash *pHash;             /* Data for array variables */
};

/*
** This structure is used to pass complete context information to the
** hash iteration callback functions that need a Th_Interp and a list
** to operate on, e.g. thListAppend().
*/
struct Th_InterpAndList {
  Th_Interp *interp;          /* Associated interpreter context */
  char **pzList;              /* IN/OUT: Ptr to ptr to list */
  int *pnList;                /* IN/OUT: Current length of *pzList */
};

/*
** Hash table API:
*/
#define TH_HASHSIZE 257
struct Th_Hash {
  Th_HashEntry *a[TH_HASHSIZE];

  if( pCommand->xDel ){
    pCommand->xDel((Th_Interp *)pContext, pCommand->pContext);
  }
  Th_Free((Th_Interp *)pContext, pEntry->pData);
  pEntry->pData = 0;
  return 1;
}

/*
** Argument pEntry points to an entry in a hash table.  The key is
** the list element to be added.
**
** Argument pContext is a pointer to the Th_InterpAndList structure.
**
** Always returns non-zero.
*/
static int thListAppend(Th_HashEntry *pEntry, void *pContext){
  Th_InterpAndList *pInterpAndList = (Th_InterpAndList *)pContext;
  Th_ListAppend(pInterpAndList->interp, pInterpAndList->pzList,
                pInterpAndList->pnList, pEntry->zKey, pEntry->nKey);
  return 1;
}

/*
** Push a new frame onto the stack.
*/
static int thPushFrame(Th_Interp *interp, Th_Frame *pFrame){
  pFrame->paVar = Th_HashNew(interp);
  pFrame->pCaller = interp->pFrame;

      *z++ = zExp[i];
    }
  }

  *z = '\0';
  return Th_SetResult(interp, zBuf, -1);
}

/*
** Appends all currently registered command names to the specified list
** and returns TH_OK upon success.  Any other return value indicates an
** error.
*/
int Th_ListAppendCommands(Th_Interp *interp, char **pzList, int *pnList){
  Th_InterpAndList *p = (Th_InterpAndList *)Th_Malloc(
    interp, sizeof(Th_InterpAndList)
  );
  p->interp = interp;
  p->pzList = pzList;
  p->pnList = pnList;
  Th_HashIterate(interp, interp->paCmd, thListAppend, p);
  Th_Free(interp, p);
  return TH_OK;
}

/*
** Appends all variable names for the current frame to the specified list
** and returns TH_OK upon success.  Any other return value indicates an
** error.  If the current frame cannot be obtained, TH_ERROR is returned.
*/
int Th_ListAppendVariables(Th_Interp *interp, char **pzList, int *pnList){
  Th_Frame *pFrame = getFrame(interp, 0);
  if( pFrame ){
    Th_InterpAndList *p = (Th_InterpAndList *)Th_Malloc(
      interp, sizeof(Th_InterpAndList)
    );
    p->interp = interp;
    p->pzList = pzList;
    p->pnList = pnList;
    Th_HashIterate(interp, pFrame->paVar, thListAppend, p);
    Th_Free(interp, p);
    return TH_OK;
  }else{
    return TH_ERROR;
  }
}

** Functions for handling numbers and pointers.
*/
int Th_ToInt(Th_Interp *, const char *, int, int *);
int Th_ToDouble(Th_Interp *, const char *, int, double *);
int Th_SetResultInt(Th_Interp *, int);
int Th_SetResultDouble(Th_Interp *, double);

/*
** Functions for handling command and variable introspection.
*/
int Th_ListAppendCommands(Th_Interp *, char **, int *);
int Th_ListAppendVariables(Th_Interp *, char **, int *);

/*
** Drop in replacements for the corresponding standard library functions.
*/
int th_strlen(const char *);
int th_isdigit(char);
int th_isspace(char);
int th_isalnum(char);

  Th_SetResult(interp, z, n);
  return TH_OK;
}

/*
** TH Syntax:
**
**   info exists VARNAME
*/
static int info_exists_command(
  Th_Interp *interp, void *ctx, int argc, const char **argv, int *argl
){
  int rc;

  if( argc!=3 ){
    return Th_WrongNumArgs(interp, "info exists var");
  }
  rc = Th_ExistsVar(interp, argv[2], argl[2]);
  Th_SetResultInt(interp, rc);
  return TH_OK;
}

/*
** TH Syntax:
**
**   info commands
*/
static int info_commands_command(
  Th_Interp *interp, void *ctx, int argc, const char **argv, int *argl
){
  int rc;
  char *zElem = 0;
  int nElem = 0;

  if( argc!=2 ){
    return Th_WrongNumArgs(interp, "info commands");
  }
  rc = Th_ListAppendCommands(interp, &zElem, &nElem);
  if( rc!=TH_OK ){
    return rc;
  }
  Th_SetResult(interp, zElem, nElem);
  return TH_OK;
}

/*
** TH Syntax:
**
**   info vars
*/
static int info_vars_command(
  Th_Interp *interp, void *ctx, int argc, const char **argv, int *argl
){
  int rc;
  char *zElem = 0;
  int nElem = 0;

  if( argc!=2 ){
    return Th_WrongNumArgs(interp, "info vars");
  }
  rc = Th_ListAppendVariables(interp, &zElem, &nElem);
  if( rc!=TH_OK ){
    return rc;
  }
  Th_SetResult(interp, zElem, nElem);
  return TH_OK;
}

/*
** TH Syntax:
**
**   unset VAR
*/
static int unset_command(

  };
  return Th_CallSubCommand(interp, ctx, argc, argv, argl, aSub);
}

/*
** TH Syntax:
**
**   info commands
**   info exists VARNAME
**   info vars
*/
static int info_command(
  Th_Interp *interp,
  void *ctx,
  int argc,
  const char **argv,
  int *argl
){
  static const Th_SubCommand aSub[] = {
    { "commands", info_commands_command },
    { "exists",   info_exists_command },
    { "vars",     info_vars_command },
    { 0, 0 }
  };
  return Th_CallSubCommand(interp, ctx, argc, argv, argl, aSub);
}

/*
** Convert the script level frame specification (used by the commands

fossil test-th-eval "reinitialize; globalState configuration"
test th1-reinitialize-1 {$RESULT eq ""}

###############################################################################

fossil test-th-eval "reinitialize 1; globalState configuration"
test th1-reinitialize-2 {$RESULT ne ""}

###############################################################################

#
# NOTE: This test may fail if the command names do not always come
#       out in a deterministic order from TH1.
#
fossil test-th-eval "info commands"
test th1-info-commands-1 {$RESULT eq {linecount htmlize date stime\
enable_output uplevel http expr utime styleFooter catch if tclReady\
searchable reinitialize combobox lindex query html anoncap randhex\
llength for set break regexp styleHeader puts return checkout decorate\
artifact trace wiki proc hascap globalState continue getParameter\
hasfeature setting breakpoint upvar render repository string unset\
setParameter list error info rename anycap httpize}}

###############################################################################

fossil test-th-eval "info vars"
test th1-info-vars-1 {$RESULT eq ""}

###############################################################################

fossil test-th-eval "set x 1; info vars"
test th1-info-vars-2 {$RESULT eq "x"}

###############################################################################

fossil test-th-eval "set x 1; unset x; info vars"
test th1-info-vars-3 {$RESULT eq ""}

###############################################################################

fossil test-th-eval "proc foo {} {set x 1; info vars}; foo"
test th1-info-vars-4 {$RESULT eq "x"}

###############################################################################

fossil test-th-eval "set y 1; proc foo {} {set x 1; uplevel 1 {info vars}}; foo"
test th1-info-vars-5 {$RESULT eq "y"}

  *  break
  *  catch SCRIPT ?VARIABLE?
  *  continue
  *  error ?STRING?
  *  expr EXPR
  *  for INIT-SCRIPT TEST-EXPR NEXT-SCRIPT BODY-SCRIPT
  *  if EXPR SCRIPT (elseif EXPR SCRIPT)* ?else SCRIPT?
  *  info commands
  *  info exists VARNAME
  *  info vars
  *  lindex LIST INDEX
  *  list ARG ...
  *  llength LIST
  *  proc NAME ARG-LIST BODY-SCRIPT
  *  rename OLD NEW
  *  return ?-code CODE? ?VALUE?
  *  set VARNAME VALUE