}
if {![cc-check-includes zlib.h] || ![cc-check-function-in-lib inflateEnd z]} {
    user-error "zlib not found please install it or specify the location with --with-zlib"
}

set tclpath [opt-val with-tcl]
if {$tclpath ne ""} {
	# Note parse-tclconfig-sh is in autosetup/local.tcl
    if {$tclpath eq "1"} {
        # Use the system Tcl. Look in some likely places.
        array set tclconfig [parse-tclconfig-sh /usr /usr/local /usr/share /opt/local]
		set msg "on your system"
	} else {
        array set tclconfig [parse-tclconfig-sh $tclpath]
		set msg "at $tclpath"
	}
	if {![info exists tclconfig(TCL_INCLUDE_SPEC)]} {
		user-error "Cannot find Tcl $msg"
	}
	set cflags $tclconfig(TCL_INCLUDE_SPEC)
	set libs "$tclconfig(TCL_LIB_SPEC) $tclconfig(TCL_LIBS)"
	cc-with [list -cflags $cflags -libs $libs] {
		if {![cc-check-functions Tcl_CreateInterp]} {
			user-error "Cannot find a usable Tcl $msg"
		}
	}
	set version $tclconfig(TCL_VERSION)$tclconfig(TCL_PATCH_LEVEL)
	msg-result "Found Tcl $version at $tclconfig(TCL_PREFIX)"
	define-append LIBS $libs
	define-append EXTRA_CFLAGS $cflags
	define-append EXTRA_LDFLAGS $tclconfig(TCL_LD_FLAGS)

    define FOSSIL_ENABLE_TCL
}

# Helper for openssl checking
proc check-for-openssl {msg {cflags {}}} {
    msg-checking "Checking for $msg..."

This is autosetup v0.6.2. See http://msteveb.github.com/autosetup/

#!/bin/sh
# Copyright (c) 2006-2011 WorkWare Systems http://www.workware.net.au/
# All rights reserved
# vim:se syntax=tcl:
# \
dir=`dirname "$0"`; exec "`$dir/find-tclsh`" "$0" "$@"

set autosetup(version) 0.6.2

# Can be set to 1 to debug early-init problems
set autosetup(debug) 0

##################################################################
#
# Main flow of control, option handling

	}
	getenv $name $default
}

# @env-is-set name
#
# Returns 1 if the $name was specified on the command line or in the environment.

#
proc env-is-set {name} {
	if {[dict exists $::autosetup(cmdline) $name]} {
		return 1
	}
	info exists ::env($name)



}

# @readfile filename ?default=""?
#
# Return the contents of the file, without the trailing newline.
# If the doesn't exist or can't be read, returns $default.
#

	}
} elseif {$autosetup(iswin)} {
	# On Windows, backslash convert all environment variables
	# (Assume that Tcl does this for us)
	proc getenv {name args} {
		string map {\\ /} [env $name {*}$args]
	}
	# Jim uses system() for exec under mingw, so
	# we need to fetch the output ourselves
	proc exec-with-stderr {args} {
			set tmpfile auto[format %04x [rand 10000]].tmp
			set rc [catch [list exec {*}$args >$tmpfile 2>&1] result]
			set result [readfile $tmpfile]
			file delete $tmpfile
			return -code $rc $result
	}
} else {
	# Jim on unix is simple
	alias getenv env
}

# In case 'file normalize' doesn't exist
#

	}
	* {
		# Generic Unix settings
		define SH_LINKFLAGS -rdynamic
		define SH_CFLAGS -fpic
		define SH_LDFLAGS -shared
		define SHOBJ_CFLAGS -fpic
		define SHOBJ_LDFLAGS "-shared -nostartfiles"
	}
}

	} elseif {[llength $args] > 1} {
		autosetup-error "usage: cc-with settings ?script?"
	} else {
		set save [cc-add-settings $settings]
		set rc [catch {uplevel 1 [lindex $args 0]} result info]
		cc-store-settings $save
		if {$rc != 0} {
			return $result -code [dict get $info -code]
		}
		return $result
	}
}

# @cctest ?settings?
# 

#!/bin/sh
# Looks for a suitable tclsh or jimsh in the PATH
# If not found, builds a bootstrap jimsh from source
d=`dirname "$0"`

PATH="$PATH:$d"
for tclsh in jimsh tclsh tclsh8.5 tclsh8.6 jimsh0; do
	{ $tclsh "$d/test-tclsh"; } 2>/dev/null && exit 0
done
echo 1>&2 "No installed jimsh or tclsh, building local bootstrap jimsh0"
for cc in ${CC_FOR_BUILD:-cc} gcc; do
	{ $cc -o "$d/jimsh0" "$d/jimsh0.c"; } 2>/dev/null || continue
	"$d/jimsh0" "$d/test-tclsh" && exit 0
done

define prefix $prefix
define builddir $autosetup(builddir)
define srcdir $autosetup(srcdir)
# Allow this to come from the environment
define top_srcdir [get-env top_srcdir [get-define srcdir]]

# autoconf supports all of these
define exec_prefix [opt-val exec-prefix [get-env exec-prefix \${prefix}]]

foreach {name defpath} {
	bindir \${exec_prefix}/bin
	sbindir \${exec_prefix}/sbin
	libexecdir \${exec_prefix}/libexec
	libdir \${exec_prefix}/lib




	datadir \${prefix}/share
	sysconfdir \${prefix}/etc
	sharedstatedir \${prefix}/com
	localstatedir \${prefix}/var
	infodir \${prefix}/share/info
	mandir \${prefix}/share/man
	includedir \${prefix}/include
} {
	define $name [opt-val $name [get-env $name $defpath]]
}

define SHELL [get-env SHELL [find-an-executable sh bash ksh]]

# Windows vs. non-Windows
switch -glob -- [get-define host] {
	*-*-ming* - *-*-cygwin {

# A small Tcl script to verify that the chosen
# interpreter works. Sometimes we might e.g. pick up
# an interpreter for a different arch.
# Outputs the full path to the interpreter

if {[catch {info version} version] == 0} {
	# This is Jim Tcl
	if {$version >= 0.70} {
		# Ensure that regexp works
		regexp (a.*?) a

		# Older versions of jimsh may return a relative path for [info nameofexecutable]
		puts [file join [pwd] [info nameofexecutable]]
		exit 0
	}
} elseif {[catch {info tclversion} version] == 0} {
	if {$version >= 8.5 && ![string match 8.5a* [info patchlevel]]} {
		puts [info nameofexecutable]
		exit 0
	}

#include <time.h>
#include <fcntl.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <stdlib.h> /* atexit() */

#if INTERFACE


#ifdef FOSSIL_ENABLE_JSON
#  include "cson_amalgamation.h" /* JSON API. Needed inside the INTERFACE block! */
#  include "json_detail.h"
#endif
#ifdef FOSSIL_ENABLE_TCL
#include "tcl.h"
#endif

  int iErrPriority;       /* Priority of current error message */
  char *zErrMsg;          /* Text of an error message */
  int sslNotAvailable;    /* SSL is not available.  Do not redirect to https: */
  Blob cgiIn;             /* Input to an xfer www method */
  int cgiOutput;          /* Write error and status messages to CGI */
  int xferPanic;          /* Write error messages in XFER protocol */
  int fullHttpReply;      /* True for full HTTP reply.  False for CGI reply */
  Th_Interp *interp;      /* The TH1 interpreter */
  FILE *httpIn;           /* Accept HTTP input from here */
  FILE *httpOut;          /* Send HTTP output here */
  int xlinkClusterOnly;   /* Set when cloning.  Only process clusters */
  int fTimeFormat;        /* 1 for UTC.  2 for localtime.  0 not yet selected */
  int *aCommitFile;       /* Array of files to be committed */
  int markPrivate;        /* All new artifacts are private if true */
  int clockSkewSeen;      /* True if clocks on client and server out of sync */

  /* For defense against Cross-site Request Forgery attacks */
  char zCsrfToken[12];    /* Value of the anti-CSRF token */
  int okCsrf;             /* Anti-CSRF token is present and valid */

  int parseCnt[10];       /* Counts of artifacts parsed */
  FILE *fDebug;           /* Write debug information here, if the file exists */
  int thTrace;            /* True to enable TH1 debugging output */
  Blob thLog;             /* Text of the TH1 debugging output */

  int isHome;             /* True if rendering the "home" page */

  /* Storage for the aux() and/or option() SQL function arguments */
  int nAux;                    /* Number of distinct aux() or option() values */
  const char *azAuxName[MX_AUX]; /* Name of each aux() or option() value */
  char *azAuxParam[MX_AUX];      /* Param of each aux() or option() value */

# The FOSSIL_ENABLE_TCL variable may be undefined, set to 0, or set to 1.
# If it is set to 1, then we need to build the Tcl integration code and
# link to the Tcl library.
TCL_OBJ.0 = 
TCL_OBJ.1 = $(OBJDIR)/th_tcl.o
TCL_OBJ. = $(TCL_OBJ.0)

EXTRAOBJ =  $(SQLITE3_OBJ.$(USE_SYSTEM_SQLITE))  $(OBJDIR)/shell.o  $(OBJDIR)/th.o  $(OBJDIR)/th_lang.o  $(TCL_OBJ.$(FOSSIL_ENABLE_TCL))  $(OBJDIR)/cson_amalgamation.o

$(APPNAME):	$(OBJDIR)/headers $(OBJ) $(EXTRAOBJ)
	$(TCC) -o $(APPNAME) $(OBJ) $(EXTRAOBJ) $(LIB)

# This rule prevents make from using its default rules to try build
# an executable named "manifest" out of the file named "manifest.c"
#
$(SRCDIR)/../manifest:	
	# noop

clean:	
	rm -rf $(OBJDIR)/* $(APPNAME)


$(OBJDIR)/page_index.h: $(TRANS_SRC) $(OBJDIR)/mkindex
	$(OBJDIR)/mkindex $(TRANS_SRC) >$@
$(OBJDIR)/headers:	$(OBJDIR)/page_index.h $(OBJDIR)/makeheaders $(OBJDIR)/VERSION.h
	$(OBJDIR)/makeheaders  $(OBJDIR)/add_.c:$(OBJDIR)/add.h $(OBJDIR)/allrepo_.c:$(OBJDIR)/allrepo.h $(OBJDIR)/attach_.c:$(OBJDIR)/attach.h $(OBJDIR)/bag_.c:$(OBJDIR)/bag.h $(OBJDIR)/bisect_.c:$(OBJDIR)/bisect.h $(OBJDIR)/blob_.c:$(OBJDIR)/blob.h $(OBJDIR)/branch_.c:$(OBJDIR)/branch.h $(OBJDIR)/browse_.c:$(OBJDIR)/browse.h $(OBJDIR)/captcha_.c:$(OBJDIR)/captcha.h $(OBJDIR)/cgi_.c:$(OBJDIR)/cgi.h $(OBJDIR)/checkin_.c:$(OBJDIR)/checkin.h $(OBJDIR)/checkout_.c:$(OBJDIR)/checkout.h $(OBJDIR)/clearsign_.c:$(OBJDIR)/clearsign.h $(OBJDIR)/clone_.c:$(OBJDIR)/clone.h $(OBJDIR)/comformat_.c:$(OBJDIR)/comformat.h $(OBJDIR)/configure_.c:$(OBJDIR)/configure.h $(OBJDIR)/content_.c:$(OBJDIR)/content.h $(OBJDIR)/db_.c:$(OBJDIR)/db.h $(OBJDIR)/delta_.c:$(OBJDIR)/delta.h $(OBJDIR)/deltacmd_.c:$(OBJDIR)/deltacmd.h $(OBJDIR)/descendants_.c:$(OBJDIR)/descendants.h $(OBJDIR)/diff_.c:$(OBJDIR)/diff.h $(OBJDIR)/diffcmd_.c:$(OBJDIR)/diffcmd.h $(OBJDIR)/doc_.c:$(OBJDIR)/doc.h $(OBJDIR)/encode_.c:$(OBJDIR)/encode.h $(OBJDIR)/event_.c:$(OBJDIR)/event.h $(OBJDIR)/export_.c:$(OBJDIR)/export.h $(OBJDIR)/file_.c:$(OBJDIR)/file.h $(OBJDIR)/finfo_.c:$(OBJDIR)/finfo.h $(OBJDIR)/glob_.c:$(OBJDIR)/glob.h $(OBJDIR)/graph_.c:$(OBJDIR)/graph.h $(OBJDIR)/gzip_.c:$(OBJDIR)/gzip.h $(OBJDIR)/http_.c:$(OBJDIR)/http.h $(OBJDIR)/http_socket_.c:$(OBJDIR)/http_socket.h $(OBJDIR)/http_ssl_.c:$(OBJDIR)/http_ssl.h $(OBJDIR)/http_transport_.c:$(OBJDIR)/http_transport.h $(OBJDIR)/import_.c:$(OBJDIR)/import.h $(OBJDIR)/info_.c:$(OBJDIR)/info.h $(OBJDIR)/json_.c:$(OBJDIR)/json.h $(OBJDIR)/json_artifact_.c:$(OBJDIR)/json_artifact.h $(OBJDIR)/json_branch_.c:$(OBJDIR)/json_branch.h $(OBJDIR)/json_diff_.c:$(OBJDIR)/json_diff.h $(OBJDIR)/json_login_.c:$(OBJDIR)/json_login.h $(OBJDIR)/json_query_.c:$(OBJDIR)/json_query.h $(OBJDIR)/json_report_.c:$(OBJDIR)/json_report.h $(OBJDIR)/json_tag_.c:$(OBJDIR)/json_tag.h $(OBJDIR)/json_timeline_.c:$(OBJDIR)/json_timeline.h $(OBJDIR)/json_user_.c:$(OBJDIR)/json_user.h $(OBJDIR)/json_wiki_.c:$(OBJDIR)/json_wiki.h $(OBJDIR)/leaf_.c:$(OBJDIR)/leaf.h $(OBJDIR)/login_.c:$(OBJDIR)/login.h $(OBJDIR)/main_.c:$(OBJDIR)/main.h $(OBJDIR)/manifest_.c:$(OBJDIR)/manifest.h $(OBJDIR)/md5_.c:$(OBJDIR)/md5.h $(OBJDIR)/merge_.c:$(OBJDIR)/merge.h $(OBJDIR)/merge3_.c:$(OBJDIR)/merge3.h $(OBJDIR)/name_.c:$(OBJDIR)/name.h $(OBJDIR)/path_.c:$(OBJDIR)/path.h $(OBJDIR)/pivot_.c:$(OBJDIR)/pivot.h $(OBJDIR)/popen_.c:$(OBJDIR)/popen.h $(OBJDIR)/pqueue_.c:$(OBJDIR)/pqueue.h $(OBJDIR)/printf_.c:$(OBJDIR)/printf.h $(OBJDIR)/rebuild_.c:$(OBJDIR)/rebuild.h $(OBJDIR)/report_.c:$(OBJDIR)/report.h $(OBJDIR)/rss_.c:$(OBJDIR)/rss.h $(OBJDIR)/schema_.c:$(OBJDIR)/schema.h $(OBJDIR)/search_.c:$(OBJDIR)/search.h $(OBJDIR)/setup_.c:$(OBJDIR)/setup.h $(OBJDIR)/sha1_.c:$(OBJDIR)/sha1.h $(OBJDIR)/shun_.c:$(OBJDIR)/shun.h $(OBJDIR)/skins_.c:$(OBJDIR)/skins.h $(OBJDIR)/sqlcmd_.c:$(OBJDIR)/sqlcmd.h $(OBJDIR)/stash_.c:$(OBJDIR)/stash.h $(OBJDIR)/stat_.c:$(OBJDIR)/stat.h $(OBJDIR)/style_.c:$(OBJDIR)/style.h $(OBJDIR)/sync_.c:$(OBJDIR)/sync.h $(OBJDIR)/tag_.c:$(OBJDIR)/tag.h $(OBJDIR)/tar_.c:$(OBJDIR)/tar.h $(OBJDIR)/th_main_.c:$(OBJDIR)/th_main.h $(OBJDIR)/timeline_.c:$(OBJDIR)/timeline.h $(OBJDIR)/tkt_.c:$(OBJDIR)/tkt.h $(OBJDIR)/tktsetup_.c:$(OBJDIR)/tktsetup.h $(OBJDIR)/undo_.c:$(OBJDIR)/undo.h $(OBJDIR)/update_.c:$(OBJDIR)/update.h $(OBJDIR)/url_.c:$(OBJDIR)/url.h $(OBJDIR)/user_.c:$(OBJDIR)/user.h $(OBJDIR)/verify_.c:$(OBJDIR)/verify.h $(OBJDIR)/vfile_.c:$(OBJDIR)/vfile.h $(OBJDIR)/wiki_.c:$(OBJDIR)/wiki.h $(OBJDIR)/wikiformat_.c:$(OBJDIR)/wikiformat.h $(OBJDIR)/winhttp_.c:$(OBJDIR)/winhttp.h $(OBJDIR)/xfer_.c:$(OBJDIR)/xfer.h $(OBJDIR)/xfersetup_.c:$(OBJDIR)/xfersetup.h $(OBJDIR)/zip_.c:$(OBJDIR)/zip.h $(SRCDIR)/sqlite3.h $(SRCDIR)/th.h $(OBJDIR)/VERSION.h
	touch $(OBJDIR)/headers
$(OBJDIR)/headers: Makefile
$(OBJDIR)/json.o $(OBJDIR)/json_artifact.o $(OBJDIR)/json_branch.o $(OBJDIR)/json_diff.o $(OBJDIR)/json_login.o $(OBJDIR)/json_query.o $(OBJDIR)/json_report.o $(OBJDIR)/json_tag.o $(OBJDIR)/json_timeline.o $(OBJDIR)/json_user.o $(OBJDIR)/json_wiki.o : $(SRCDIR)/json_detail.h
Makefile:
$(OBJDIR)/add_.c:	$(SRCDIR)/add.c $(OBJDIR)/translate
	$(OBJDIR)/translate $(SRCDIR)/add.c >$(OBJDIR)/add_.c

$(OBJDIR)/th.o:	$(SRCDIR)/th.c
	$(XTCC) -I$(SRCDIR) -c $(SRCDIR)/th.c -o $(OBJDIR)/th.o

$(OBJDIR)/th_lang.o:	$(SRCDIR)/th_lang.c
	$(XTCC) -I$(SRCDIR) -c $(SRCDIR)/th_lang.c -o $(OBJDIR)/th_lang.o




$(OBJDIR)/th_tcl.o:	$(SRCDIR)/th_tcl.c
	$(XTCC) -I$(SRCDIR) -c $(SRCDIR)/th_tcl.c -o $(OBJDIR)/th_tcl.o


$(OBJDIR)/cson_amalgamation.o: $(SRCDIR)/cson_amalgamation.c
	$(XTCC) -I$(SRCDIR) -c $(SRCDIR)/cson_amalgamation.c -o $(OBJDIR)/cson_amalgamation.o -DCSON_FOSSIL_MODE

TCL_OBJ.0 = 
TCL_OBJ.1 = $(OBJDIR)/th_tcl.o
TCL_OBJ. = $(TCL_OBJ.0)

EXTRAOBJ = \
  $(SQLITE3_OBJ.$(USE_SYSTEM_SQLITE)) \
  $(OBJDIR)/shell.o \
  $(OBJDIR)/th.o \
  $(OBJDIR)/th_lang.o \
  $(TCL_OBJ.$(FOSSIL_ENABLE_TCL)) \
  $(OBJDIR)/cson_amalgamation.o

$(APPNAME):	$(OBJDIR)/headers $(OBJ) $(EXTRAOBJ)
	$(TCC) -o $(APPNAME) $(OBJ) $(EXTRAOBJ) $(LIB)

# This rule prevents make from using its default rules to try build

set mhargs {}
foreach s [lsort $src] {
  append mhargs " \$(OBJDIR)/${s}_.c:\$(OBJDIR)/$s.h"
  set extra_h($s) {}
}
append mhargs " \$(SRCDIR)/sqlite3.h"
append mhargs " \$(SRCDIR)/th.h"
#append mhargs " \$(SRCDIR)/cson_amalgamation.h"
append mhargs " \$(OBJDIR)/VERSION.h"
writeln "\$(OBJDIR)/page_index.h: \$(TRANS_SRC) \$(OBJDIR)/mkindex"
writeln "\t\$(OBJDIR)/mkindex \$(TRANS_SRC) >$@"
writeln "\$(OBJDIR)/headers:\t\$(OBJDIR)/page_index.h \$(OBJDIR)/makeheaders \$(OBJDIR)/VERSION.h"
writeln "\t\$(OBJDIR)/makeheaders $mhargs"
writeln "\ttouch \$(OBJDIR)/headers"

writeln "\$(OBJDIR)/th.o:\t\$(SRCDIR)/th.c"
writeln "\t\$(XTCC) -I\$(SRCDIR) -c \$(SRCDIR)/th.c -o \$(OBJDIR)/th.o\n"

writeln "\$(OBJDIR)/th_lang.o:\t\$(SRCDIR)/th_lang.c"
writeln "\t\$(XTCC) -I\$(SRCDIR) -c \$(SRCDIR)/th_lang.c -o \$(OBJDIR)/th_lang.o\n"




writeln "\$(OBJDIR)/th_tcl.o:\t\$(SRCDIR)/th_tcl.c"
writeln "\t\$(XTCC) -I\$(SRCDIR) -c \$(SRCDIR)/th_tcl.c -o \$(OBJDIR)/th_tcl.o\n"

set opt {}
writeln {
$(OBJDIR)/cson_amalgamation.o: $(SRCDIR)/cson_amalgamation.c
	$(XTCC) -I$(SRCDIR) -c $(SRCDIR)/cson_amalgamation.c -o $(OBJDIR)/cson_amalgamation.o -DCSON_FOSSIL_MODE

set mhargs {}
foreach s [lsort $src] {
  append mhargs " \$(OBJDIR)/${s}_.c:\$(OBJDIR)/$s.h"
  set extra_h($s) {}
}
append mhargs " \$(SRCDIR)/sqlite3.h"
append mhargs " \$(SRCDIR)/th.h"
append mhargs " \$(OBJDIR)/VERSION.h"
writeln "\$(OBJDIR)/page_index.h: \$(TRANS_SRC) \$(OBJDIR)/mkindex"
writeln "\t\$(MKINDEX) \$(TRANS_SRC) >$@"
writeln "\$(OBJDIR)/headers:\t\$(OBJDIR)/page_index.h \$(OBJDIR)/makeheaders \$(OBJDIR)/VERSION.h"
writeln "\t\$(MAKEHEADERS) $mhargs"
writeln "\techo Done >\$(OBJDIR)/headers"
writeln ""

  writeln "\t+translate\$E \$** > \$@\n"
}

writeln -nonewline "headers: makeheaders\$E page_index.h VERSION.h\n\t +makeheaders\$E "
foreach s [lsort $src] {
  writeln -nonewline "${s}_.c:$s.h "
}
writeln "\$(SRCDIR)\\sqlite3.h \$(SRCDIR)\\th.h VERSION.h \$(SRCDIR)\\cson_amalgamation.h"

writeln "\t@copy /Y nul: headers"

close $output_file
#
# End of the win/Makefile.dmc output
##############################################################################
##############################################################################

  writeln "\ttranslate\$E \$** > \$@\n"
}

writeln -nonewline "headers: makeheaders\$E page_index.h VERSION.h\n\tmakeheaders\$E "
foreach s [lsort $src] {
  writeln -nonewline "${s}_.c:$s.h "
}
writeln "\$(SRCDIR)\\sqlite3.h \$(SRCDIR)\\th.h VERSION.h \$(SRCDIR)\\cson_amalgamation.h"
writeln "\t@copy /Y nul: headers"


close $output_file
#
# End of the win/Makefile.msc output
##############################################################################

	mkindex.exe $(TRANSLATEDSRC) >$@

# extracting version info from manifest
VERSION.h:	version.exe ..\manifest.uuid ..\manifest ..\VERSION
	version.exe ..\manifest.uuid ..\manifest ..\VERSION  > $@

# generate the simplified headers
headers: makeheaders.exe page_index.h VERSION.h ../src/sqlite3.h ../src/th.h VERSION.h
	makeheaders.exe $(foreach ts,$(TRANSLATEDSRC),$(ts):$(ts:_.c=.h)) ../src/sqlite3.h ../src/th.h VERSION.h
	echo Done >$@

# compile C sources with relevant options

$(TRANSLATEDOBJ):	%_.obj:	%_.c %.h
	$(CC) $(CCFLAGS) $(INCLUDE) "$<" -Fo"$@"

$(SQLITEOBJ):	%.obj:	$(SRCDIR)%.c $(SRCDIR)%.h
	$(CC) $(CCFLAGS) $(SQLITEDEFINES) $(INCLUDE) "$<" -Fo"$@"

$(SQLITESHELLOBJ):	%.obj:	$(SRCDIR)%.c
	$(CC) $(CCFLAGS) $(SQLITESHELLDEFINES) $(INCLUDE) "$<" -Fo"$@"

$(THOBJ):	%.obj:	$(SRCDIR)%.c $(SRCDIR)th.h
	$(CC) $(CCFLAGS) $(INCLUDE) "$<" -Fo"$@"

$(ZLIBOBJ):	%.obj:	$(ZLIBSRCDIR)%.c
	$(CC) $(CCFLAGS) $(INCLUDE) "$<" -Fo"$@"

# create the windows resource with icon and version info
$(RESOURCE):	%.res:	../win/%.rc ../win/*.ico

    }
    db_finalize(&q);
    db_prepare(&q,
       "SELECT type, datetime(mtime,'localtime'),"
       "       coalesce(euser,user), coalesce(ecomment,comment)"
       "  FROM event WHERE objid=%d", rid);
    if( db_step(&q)==SQLITE_ROW ){
      const char *zType;
      switch( db_column_text(&q,0)[0] ){
        case 'c':  zType = "Check-in";       break;
        case 'w':  zType = "Wiki-edit";      break;
        case 'e':  zType = "Event";          break;
        case 't':  zType = "Ticket-change";  break;
        case 'g':  zType = "Tag-change";     break;
        default:   zType = "Unknown";        break;

/*
** The implementation of the TH core. This file contains the parser, and 
** the implementation of the interface in th.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;

/*
** Interpreter structure.
*/
struct Th_Interp {
  Th_Vtab *pVtab;     /* Copy of the argument passed to Th_CreateInterp() */
  char *zResult;     /* Current interpreter result (Th_Malloc()ed) */
  int nResult;        /* number of bytes in zResult */
  Th_Hash *paCmd;     /* Table of registered commands */
  Th_Frame *pFrame;   /* Current execution frame */
  int isListMode;     /* True if thSplitList() should operate in "list" mode */
};

/*
** Each TH command registered using Th_CreateCommand() is represented
** by an instance of the following structure stored in the Th_Interp.paCmd
** hash-table.
*/
struct Th_Command {
  int (*xProc)(Th_Interp *, void *, int, const char **, int *);
  void *pContext;
  void (*xDel)(Th_Interp *, void *);
};

/*
** Each stack frame (variable scope) is represented by an instance
** of this structure. Variable values set using the Th_SetVar command
** are stored in the Th_Frame.paVar hash table member of the associated
** stack frame object.
**
** When an interpreter is created, a single Th_Frame structure is also
** allocated - the global variable scope. Th_Interp.pFrame (the current
** interpreter frame) is initialised to point to this Th_Frame. It is 
** not deleted for the lifetime of the interpreter (because the global 
** frame never goes out of scope).
**
** New stack frames are created by the Th_InFrame() function. Before
** invoking its callback function, Th_InFrame() allocates a new Th_Frame
** structure with pCaller set to the current frame (Th_Interp.pFrame),
** and sets the current frame to the new frame object. After the callback
** has been invoked, the allocated Th_Frame is deleted and the value
** of the current frame pointer restored.
** 
** By default, the Th_SetVar(), Th_UnsetVar() and Th_GetVar() functions 
** access variable values in the current frame. If they need to access 
** the global frame, they do so by traversing the pCaller pointer list.
** Likewise, the Th_LinkVar() function uses the pCaller pointers to 
** link to variables located in the global or other stack frames.
*/
struct Th_Frame {
  Th_Hash *paVar;               /* Variables defined in this scope */
  Th_Frame *pCaller;            /* Calling frame */
};

/*
** This structure represents a value assigned to a th1 variable.
**
** The Th_Frame.paVar hash table maps from variable name (a th1 string)
** to a pointer to an instance of the following structure. More than
** one hash table entry may map to a single structure if variable
** links have been created using Th_LinkVar(). The number of references
** is stored in Th_Variable.nRef.
**
** For scalar variables, Th_Variable.zData is never 0. Th_Variable.nData
** stores the number of bytes in the value pointed to by zData.
**
** For an array variable, Th_Variable.zData is 0 and pHash points to
** a hash table mapping between array key name (a th1 string) and
** a the pointer to the Th_Variable structure holding the scalar
** value.
*/
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 */
};

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

static int thEvalLocal(Th_Interp *, const char *, int);
static int thSplitList(Th_Interp*, const char*, int, char***, int **, int*);

static int thHexdigit(char c);
static int thEndOfLine(const char *, int);

static int  thPushFrame(Th_Interp*, Th_Frame*);
static void thPopFrame(Th_Interp*);

static void thFreeVariable(Th_HashEntry*, void*);
static void thFreeCommand(Th_HashEntry*, void*);

/*
** The following are used by both the expression and language parsers.
** Given that the start of the input string (z, n) is a language 
** construct of the relevant type (a command enclosed in [], an escape
** sequence etc.), these functions determine the number of bytes
** of the input consumed by the construct. For example:
**
**   int nByte;
**   thNextCommand(interp, "[expr $a+1] $nIter", 18, &nByte);
**
** results in variable nByte being set to 11. Or, 
**
**   thNextVarname(interp, "$a+1", 4, &nByte);
**
** results in nByte being set to 2.
*/
static int thNextCommand(Th_Interp*, const char *z, int n, int *pN);
static int thNextEscape (Th_Interp*, const char *z, int n, int *pN);
static int thNextVarname(Th_Interp*, const char *z, int n, int *pN);
static int thNextNumber (Th_Interp*, const char *z, int n, int *pN);
static int thNextSpace  (Th_Interp*, const char *z, int n, int *pN);

/*
** Given that the input string (z, n) contains a language construct of
** the relevant type (a command enclosed in [], an escape sequence 
** like "\xFF" or a variable reference like "${varname}", perform
** substitution on the string and store the resulting string in
** the interpreter result.
*/
static int thSubstCommand(Th_Interp*, const char *z, int n);
static int thSubstEscape (Th_Interp*, const char *z, int n);
static int thSubstVarname(Th_Interp*, const char *z, int n);

/*
** Given that there is a th1 word located at the start of the input 
** string (z, n), determine the length in bytes of that word. If the
** isCmd argument is non-zero, then an unescaped ";" byte not 
** located inside of a block or quoted string is considered to mark 
** the end of the word.
*/
static int thNextWord(Th_Interp*, const char *z, int n, int *pN, int isCmd);

/*
** Perform substitution on the word contained in the input string (z, n).
** Store the resulting string in the interpreter result.
*/
static int thSubstWord(Th_Interp*, const char *z, int n);

/*
** The Buffer structure and the thBufferXXX() functions are used to make
** memory allocation easier when building up a result.
*/
struct Buffer {
  char *zBuf;
  int nBuf;
  int nBufAlloc;
};
typedef struct Buffer Buffer;
static int  thBufferWrite(Th_Interp *interp, Buffer *, const char *, int);
static void thBufferInit(Buffer *);
static void thBufferFree(Th_Interp *interp, Buffer *);

/*
** Append nAdd bytes of content copied from zAdd to the end of buffer
** pBuffer. If there is not enough space currently allocated, resize
** the allocation to make space.
*/
static int thBufferWrite(
  Th_Interp *interp, 
  Buffer *pBuffer, 
  const char *zAdd, 
  int nAdd
){
  int nReq;

  if( nAdd<0 ){
    nAdd = th_strlen(zAdd);
  }
  nReq = pBuffer->nBuf+nAdd+1;

  if( nReq>pBuffer->nBufAlloc ){
    char *zNew;
    int nNew;

    nNew = nReq*2;
    zNew = (char *)Th_Malloc(interp, nNew);
    memcpy(zNew, pBuffer->zBuf, pBuffer->nBuf);
    Th_Free(interp, pBuffer->zBuf);
    pBuffer->nBufAlloc = nNew;
    pBuffer->zBuf = zNew;
  }

  memcpy(&pBuffer->zBuf[pBuffer->nBuf], zAdd, nAdd);
  pBuffer->nBuf += nAdd;
  pBuffer->zBuf[pBuffer->nBuf] = '\0';

  return TH_OK;
}
#define thBufferWrite(a,b,c,d) thBufferWrite(a,b,(const char *)c,d)

/*
** Initialize the Buffer structure pointed to by pBuffer.
*/
static void thBufferInit(Buffer *pBuffer){
  memset(pBuffer, 0, sizeof(Buffer));
}

/*
** Zero the buffer pointed to by pBuffer and free the associated memory
** allocation.
*/
static void thBufferFree(Th_Interp *interp, Buffer *pBuffer){
  Th_Free(interp, pBuffer->zBuf);
  thBufferInit(pBuffer);
}

/*
** Assuming parameter c contains a hexadecimal digit character,
** return the corresponding value of that digit. If c is not
** a hexadecimal digit character, -1 is returned.
*/
static int thHexdigit(char c){
  switch (c) {
    case '0': return 0;
    case '1': return 1;
    case '2': return 2;
    case '3': return 3;
    case '4': return 4;
    case '5': return 5;
    case '6': return 6;
    case '7': return 7;
    case '8': return 8;
    case '9': return 9;
    case 'a': case 'A': return 10;
    case 'b': case 'B': return 11;
    case 'c': case 'C': return 12;
    case 'd': case 'D': return 13;
    case 'e': case 'E': return 14;
    case 'f': case 'F': return 15;
  }
  return -1;
}

/*
** Argument pEntry points to an entry in a stack frame hash table
** (Th_Frame.paVar). Decrement the refrerence count of the Th_Variable
** structure that the entry points to. Free the Th_Variable if its
** reference count reaches 0.
**
** Argument pContext is a pointer to the interpreter structure.
*/
static void thFreeVariable(Th_HashEntry *pEntry, void *pContext){
  Th_Variable *pValue = (Th_Variable *)pEntry->pData;
  pValue->nRef--;
  assert( pValue->nRef>=0 );
  if( pValue->nRef==0 ){
    Th_Interp *interp = (Th_Interp *)pContext;
    Th_Free(interp, pValue->zData);
    if( pValue->pHash ){
      Th_HashIterate(interp, pValue->pHash, thFreeVariable, pContext);
      Th_HashDelete(interp, pValue->pHash);
    }
    Th_Free(interp, pValue);
  }
}

/*
** Argument pEntry points to an entry in the command hash table
** (Th_Interp.paCmd). Delete the Th_Command structure that the
** entry points to.
**
** Argument pContext is a pointer to the interpreter structure.
*/
static void thFreeCommand(Th_HashEntry *pEntry, void *pContext){
  Th_Command *pCommand = (Th_Command *)pEntry->pData;
  if( pCommand->xDel ){
    pCommand->xDel((Th_Interp *)pContext, pCommand->pContext);
  }
  Th_Free((Th_Interp *)pContext, pEntry->pData);
  pEntry->pData = 0;
}

/*
** 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;
  interp->pFrame = pFrame;
  return TH_OK;
}

/*
** Pop a frame off the top of the stack.
*/
static void thPopFrame(Th_Interp *interp){
  Th_Frame *pFrame = interp->pFrame;
  Th_HashIterate(interp, pFrame->paVar, thFreeVariable, (void *)interp);
  Th_HashDelete(interp, pFrame->paVar);
  interp->pFrame = pFrame->pCaller;
}

/*
** The first part of the string (zInput,nInput) contains an escape 
** sequence. Set *pnEscape to the number of bytes in the escape sequence.
** If there is a parse error, return TH_ERROR and set the interpreter
** result to an error message. Otherwise return TH_OK.
*/
static int thNextEscape(
  Th_Interp *interp,
  const char *zInput, 
  int nInput, 
  int *pnEscape
){
  int i = 2;

  assert(nInput>0);
  assert(zInput[0]=='\\');

  if( nInput<=1 ){
    return TH_ERROR;
  }

  switch( zInput[1] ){
    case 'x': i = 4;
  }

  if( i>nInput ){
    return TH_ERROR;
  }
  *pnEscape = i;
  return TH_OK;
}

/*
** The first part of the string (zInput,nInput) contains a variable
** reference. Set *pnVarname to the number of bytes in the variable 
** reference. If there is a parse error, return TH_ERROR and set the 
** interpreter result to an error message. Otherwise return TH_OK.
*/
int thNextVarname(
  Th_Interp *interp,
  const char *zInput, 
  int nInput, 
  int *pnVarname
){
  int i;

  assert(nInput>0);
  assert(zInput[0]=='$');

  if( nInput>0 && zInput[1]=='{' ){
    for(i=2; i<nInput && zInput[i]!='}'; i++);
    if( i==nInput ){
      return TH_ERROR;
    }
    i++;
  }else{
    i = 1;
    if( nInput>2 && zInput[1]==':' && zInput[2]==':' ){
      i += 2;
    }
    for(; i<nInput; i++){
      if( zInput[i]=='(' ){
        for(i++; i<nInput; i++){
          if( zInput[i]==')' ) break;
          if( zInput[i]=='\\' ) i++;
          if( zInput[i]=='{' || zInput[i]=='[' || zInput[i]=='"' ){
            int nWord;
            int rc = thNextWord(interp, &zInput[i], nInput-i, &nWord, 0);
            if( rc!=TH_OK ){
              return rc;
            }
            i += nWord;
          }
        }
        if( i>=nInput ){
          Th_ErrorMessage(interp, "Unmatched brackets:", zInput, nInput);
          return TH_ERROR;
        }
        i++;
        break;
      }
      if( !th_isalnum(zInput[i]) && zInput[i]!='_' ) break;
    }
  }

  *pnVarname = i;
  return TH_OK;
}

/*
** The first part of the string (zInput,nInput) contains a command
** enclosed in a "[]" block. Set *pnCommand to the number of bytes in 
** the variable reference. If there is a parse error, return TH_ERROR 
** and set the interpreter result to an error message. Otherwise return 
** TH_OK.
*/
int thNextCommand(
  Th_Interp *interp,
  const char *zInput, 
  int nInput, 
  int *pnCommand
){
  int nBrace = 0;
  int nSquare = 0;
  int i;

  assert(nInput>0);
  assert( zInput[0]=='[' || zInput[0]=='{' );

  for(i=0; i<nInput && (i==0 || nBrace>0 || nSquare>0); i++){
    switch( zInput[i] ){
      case '\\': i++; break;
      case '{': nBrace++; break;
      case '}': nBrace--; break;
      case '[': nSquare++; break;
      case ']': nSquare--; break;
    }
  }
  if( nBrace || nSquare ){
    return TH_ERROR;
  }

  *pnCommand = i;

  return TH_OK;
}

/*
** Set *pnSpace to the number of whitespace bytes at the start of 
** input string (zInput, nInput). Always return TH_OK.
*/
int thNextSpace(
  Th_Interp *interp,
  const char *zInput, 
  int nInput, 
  int *pnSpace
){
  int i;
  for(i=0; i<nInput && th_isspace(zInput[i]); i++);
  *pnSpace = i;
  return TH_OK;
}

/*
** The first byte of the string (zInput,nInput) is not white-space.
** Set *pnWord to the number of bytes in the th1 word that starts
** with this byte. If a complete word cannot be parsed or some other
** error occurs, return TH_ERROR and set the interpreter result to 
** an error message. Otherwise return TH_OK.
**
** If the isCmd argument is non-zero, then an unescaped ";" byte not 
** located inside of a block or quoted string is considered to mark 
** the end of the word.
*/
static int thNextWord(
  Th_Interp *interp,
  const char *zInput, 
  int nInput, 
  int *pnWord,
  int isCmd
){
  int iEnd = 0;

  assert( !th_isspace(zInput[0]) );

  if( zInput[0]=='"' ){
    /* The word is terminated by the next unescaped '"' character. */
    iEnd++;
    while( iEnd<nInput && zInput[iEnd]!='"' ){
      if( zInput[iEnd]=='\\' ){
        iEnd++;
      }
      iEnd++;
    }
    iEnd++;
  }else{
    int nBrace = 0;
    int nSq = 0;
    while( iEnd<nInput && (nBrace>0 || nSq>0 ||
      (!th_isspace(zInput[iEnd]) && (!isCmd || zInput[iEnd]!=';'))
    )){
      switch( zInput[iEnd] ){
        case '\\': iEnd++; break;
        case '{': if( nSq==0 ) nBrace++; break;
        case '}': if( nSq==0 ) nBrace--; break;
        case '[': if( nBrace==0 ) nSq++; break;
        case ']': if( nBrace==0 ) nSq--; break;
      }
      iEnd++;
    }
    if( nBrace>0 || nSq>0 ){
      /* Parse error */
      return TH_ERROR;
    }
  }

  if( iEnd>nInput ){
    /* Parse error */
    return TH_ERROR;
  }
  *pnWord = iEnd;
  return TH_OK;
}

/*
** The input string (zWord, nWord) contains a th1 script enclosed in
** a [] block. Perform substitution on the input string and store the
** resulting string in the interpreter result.
*/
static int thSubstCommand(
  Th_Interp *interp,
  const char *zWord,
  int nWord
){
  assert(nWord>=2);
  assert(zWord[0]=='[' && zWord[nWord-1]==']');
  return thEvalLocal(interp, &zWord[1], nWord-2);
}

/*
** The input string (zWord, nWord) contains a th1 variable reference
** (a '$' byte followed by a variable name). Perform substitution on 
** the input string and store the resulting string in the interpreter 
** result.
*/
static int thSubstVarname(
  Th_Interp *interp,
  const char *zWord,
  int nWord
){
  assert(nWord>=1);
  assert(zWord[0]=='$');
  assert(nWord==1 || zWord[1]!='{' || zWord[nWord-1]=='}');
  if( nWord>1 && zWord[1]=='{' ){
    zWord++;
    nWord -= 2;
  }else if( zWord[nWord-1]==')' ){
    int i;
    for(i=1; i<nWord && zWord[i]!='('; i++);
    if( i<nWord ){
      Buffer varname;
      int nInner;
      const char *zInner;

      int rc = thSubstWord(interp, &zWord[i+1], nWord-i-2);
      if( rc!=TH_OK ) return rc;

      zInner = Th_GetResult(interp, &nInner);
      thBufferInit(&varname);
      thBufferWrite(interp, &varname, &zWord[1], i);
      thBufferWrite(interp, &varname, zInner, nInner);
      thBufferWrite(interp, &varname, ")", 1);
      rc = Th_GetVar(interp, varname.zBuf, varname.nBuf);
      thBufferFree(interp, &varname);
      return rc;
    }
  }
  return Th_GetVar(interp, &zWord[1], nWord-1);
}

/*
** The input string (zWord, nWord) contains a th1 escape sequence.
** Perform substitution on the input string and store the resulting 
** string in the interpreter result.
*/
static int thSubstEscape(
  Th_Interp *interp,
  const char *zWord,
  int nWord
){
  char c;

  assert(nWord>=2);
  assert(zWord[0]=='\\');

  switch( zWord[1] ){
    case 'x': {
      assert(nWord==4);
      c = ((thHexdigit(zWord[2])<<4) + thHexdigit(zWord[3]));
      break;
    }
    case 'n': {
      c = '\n';
      break;
    }
    default: {
      assert(nWord==2);
      c = zWord[1];
      break;
    }
  }

  Th_SetResult(interp, &c, 1);
  return TH_OK;
}

/*
** The input string (zWord, nWord) contains a th1 word. Perform
** substitution on the input string and store the resulting 
** string in the interpreter result.
*/
static int thSubstWord(
  Th_Interp *interp,
  const char *zWord,
  int nWord
){
  int rc = TH_OK;
  Buffer output;
  int i;

  thBufferInit(&output);

  if( nWord>1 && (zWord[0]=='{' && zWord[nWord-1]=='}') ){
    rc = thBufferWrite(interp, &output, &zWord[1], nWord-2);
  }else{

    /* If the word is surrounded by double-quotes strip these away. */
    if( nWord>1 && (zWord[0]=='"' && zWord[nWord-1]=='"') ){
      zWord++;
      nWord -= 2;
    }

    for(i=0; rc==TH_OK && i<nWord; i++){
      int nGet;

      int (*xGet)(Th_Interp *, const char*, int, int *) = 0;
      int (*xSubst)(Th_Interp *, const char*, int) = 0;

      switch( zWord[i] ){
        case '\\':
          xGet = thNextEscape; xSubst = thSubstEscape; 
          break;
        case '[':
          if( !interp->isListMode ){
            xGet = thNextCommand; xSubst = thSubstCommand; 
            break;
          }
        case '$':
          if( !interp->isListMode ){
            xGet = thNextVarname; xSubst = thSubstVarname; 
            break;
          }
        default: {
          thBufferWrite(interp, &output, &zWord[i], 1);
          continue; /* Go to the next iteration of the for(...) loop */
        }
      }

      rc = xGet(interp, &zWord[i], nWord-i, &nGet);
      if( rc==TH_OK ){
        rc = xSubst(interp, &zWord[i], nGet);
      }
      if( rc==TH_OK ){
        const char *zRes;
        int nRes;
        zRes = Th_GetResult(interp, &nRes);
        rc = thBufferWrite(interp, &output, zRes, nRes);
        i += (nGet-1);
      }
    }
  }

  if( rc==TH_OK ){
    Th_SetResult(interp, output.zBuf, output.nBuf);
  }
  thBufferFree(interp, &output);
  return rc;
}

/*
** Return true if one of the following is true of the buffer pointed
** to by zInput, length nInput:
**
**   + It is empty, or
**   + It contains nothing but white-space, or
**   + It contains no non-white-space characters before the first 
**     newline character.
**
** Otherwise return false.
*/
static int thEndOfLine(const char *zInput, int nInput){
  int i;
  for(i=0; i<nInput && zInput[i]!='\n' && th_isspace(zInput[i]); i++);
  return ((i==nInput || zInput[i]=='\n')?1:0);
}

/*
** This function splits the supplied th1 list (contained in buffer zList,
** size nList) into elements and performs word-substitution on each
** element. If the Th_Interp.isListMode variable is true, then only
** escape sequences are substituted (used by the Th_SplitList() function).
** If Th_Interp.isListMode is false, then variable and command substitution
** is also performed (used by Th_Eval()).
**
** If zList/nList does not contain a valid list, TH_ERROR is returned
** and an error message stored in interp.
**
** If TH_OK is returned and pazElem is not NULL, the caller should free the
** pointer written to (*pazElem) using Th_Free(). This releases memory
** allocated for both the (*pazElem) and (*panElem) arrays. Example:
**
**     char **argv;
**     int *argl;
**     int argc;
**
**     // After this call, argv and argl point to valid arrays. The
**     // number of elements in each is argc.
**     //
**     Th_SplitList(interp, zList, nList, &argv, &argl, &argc);
**
**     // Free all memory allocated by Th_SplitList(). The arrays pointed
**     // to by argv and argl are invalidated by this call.
**     //
**     Th_Free(interp, argv);
**
*/ 
static int thSplitList(
  Th_Interp *interp,      /* Interpreter context */
  const char *zList,     /* Pointer to buffer containing input list */
  int nList,              /* Size of buffer pointed to by zList */
  char ***pazElem,       /* OUT: Array of list elements */
  int **panElem,          /* OUT: Lengths of each list element */
  int *pnCount            /* OUT: Number of list elements */
){
  int rc = TH_OK;

  Buffer strbuf;
  Buffer lenbuf;
  int nCount = 0;

  const char *zInput = zList;
  int nInput = nList;

  thBufferInit(&strbuf);
  thBufferInit(&lenbuf);

  while( nInput>0 ){
    const char *zWord;
    int nWord;

    thNextSpace(interp, zInput, nInput, &nWord);
    zInput += nWord;
    nInput = nList-(zInput-zList);

    if( TH_OK!=(rc = thNextWord(interp, zInput, nInput, &nWord, 0))
     || TH_OK!=(rc = thSubstWord(interp, zInput, nWord))
    ){
      goto finish;
    }
    zInput = &zInput[nWord];
    nInput = nList-(zInput-zList);
    if( nWord>0 ){
      zWord = Th_GetResult(interp, &nWord);
      thBufferWrite(interp, &strbuf, zWord, nWord);
      thBufferWrite(interp, &strbuf, "\0", 1);
      thBufferWrite(interp, &lenbuf, &nWord, sizeof(int));
      nCount++;
    }
  }
  assert((lenbuf.nBuf/sizeof(int))==nCount);

  assert((pazElem && panElem) || (!pazElem && !panElem));
  if( pazElem && rc==TH_OK ){
    int i;
    char *zElem; 
    int *anElem;
    char **azElem = Th_Malloc(interp,
      sizeof(char*) * nCount +      /* azElem */
      sizeof(int) * nCount +         /* anElem */
      strbuf.nBuf                    /* space for list element strings */
    );
    anElem = (int *)&azElem[nCount];
    zElem = (char *)&anElem[nCount];
    memcpy(anElem, lenbuf.zBuf, lenbuf.nBuf);
    memcpy(zElem, strbuf.zBuf, strbuf.nBuf);
    for(i=0; i<nCount;i++){
      azElem[i] = zElem;
      zElem += (anElem[i] + 1);
    }
    *pazElem = azElem;
    *panElem = anElem;
  }
  if( pnCount ){
    *pnCount = nCount;
  }
  
 finish:
  thBufferFree(interp, &strbuf);
  thBufferFree(interp, &lenbuf);
  return rc;
}

/*
** Evaluate the th1 script contained in the string (zProgram, nProgram)
** in the current stack frame.
*/
static int thEvalLocal(Th_Interp *interp, const char *zProgram, int nProgram){
  int rc = TH_OK;
  const char *zInput = zProgram;
  int nInput = nProgram;

  while( rc==TH_OK && nInput ){
    Th_HashEntry *pEntry;
    int nSpace;
    const char *zFirst;

    char **argv;
    int *argl;
    int argc;

    assert(nInput>=0);

    /* Skip a semi-colon */
    if( *zInput==';' ){
      zInput++;
      nInput--;
    }

    /* Skip past leading white-space. */
    thNextSpace(interp, zInput, nInput, &nSpace);
    zInput += nSpace;
    nInput -= nSpace;
    zFirst = zInput;

    /* Check for a comment. If found, skip to the end of the line. */
    if( zInput[0]=='#' ){
      while( !thEndOfLine(zInput, nInput) ){
        zInput++;
        nInput--;
      }
      continue;
    }

    /* Gobble up input a word at a time until the end of the command
    ** (a semi-colon or end of line).
    */
    while( rc==TH_OK && *zInput!=';' && !thEndOfLine(zInput, nInput) ){
      int nWord=0;
      thNextSpace(interp, zInput, nInput, &nSpace);
      rc = thNextWord(interp, &zInput[nSpace], nInput-nSpace, &nWord, 1);
      zInput += (nSpace+nWord);
      nInput -= (nSpace+nWord);
    }
    if( rc!=TH_OK ) continue;

    /* Split the command into an array of words. This call also does
    ** substitution of each individual word.
    */
    rc = thSplitList(interp, zFirst, zInput-zFirst, &argv, &argl, &argc);
    if( rc!=TH_OK ) continue;

    if( argc>0 ){

      /* Look up the command name in the command hash-table. */
      pEntry = Th_HashFind(interp, interp->paCmd, argv[0], argl[0], 0);
      if( !pEntry ){
        Th_ErrorMessage(interp, "no such command: ", argv[0], argl[0]);
        rc = TH_ERROR;
      }

      /* Call the command procedure. */
      if( rc==TH_OK ){
        Th_Command *p = (Th_Command *)(pEntry->pData);
        const char **azArg = (const char **)argv;
        rc = p->xProc(interp, p->pContext, argc, azArg, argl);
      }
  
      /* If an error occured, add this command to the stack trace report. */
      if( rc==TH_ERROR ){
        char *zRes;
        int nRes;
        char *zStack = 0;
        int nStack = 0;
  
        zRes = Th_TakeResult(interp, &nRes);
        if( TH_OK==Th_GetVar(interp, (char *)"::th_stack_trace", -1) ){
          zStack = Th_TakeResult(interp, &nStack);
        }
        Th_ListAppend(interp, &zStack, &nStack, zFirst, zInput-zFirst);
        Th_SetVar(interp, (char *)"::th_stack_trace", -1, zStack, nStack);
        Th_SetResult(interp, zRes, nRes);
        Th_Free(interp, zRes);
        Th_Free(interp, zStack);
      }
    }

    Th_Free(interp, argv);
  }

  return rc;
}

/*
** Interpret an integer frame identifier passed to either Th_Eval() or
** Th_LinkVar(). If successful, return a pointer to the identified
** Th_Frame structure. If unsuccessful (no such frame), return 0 and
** leave an error message in the interpreter result.
**
** Argument iFrame is interpreted as follows:
**
**   * If iFrame is 0, this means the current frame.
**
**   * If iFrame is negative, then the nth frame up the stack, where 
**     n is the absolute value of iFrame. A value of -1 means the 
**     calling procedure.
**
**   * If iFrame is +ve, then the nth frame from the bottom of the 
**     stack. An iFrame value of 1 means the toplevel (global) frame.
*/
static Th_Frame *getFrame(Th_Interp *interp, int iFrame){
  Th_Frame *p = interp->pFrame;
  int i;
  if( iFrame>0 ){
    for(i=0; p; i++){
      p = p->pCaller;
    }
    iFrame = (i*-1) + iFrame;
    p = interp->pFrame;
  }
  for(i=0; p && i<(iFrame*-1); i++){
    p = p->pCaller;
  }

  if( !p ){
    char *zFrame;
    int nFrame;
    Th_SetResultInt(interp, iFrame);
    zFrame = Th_TakeResult(interp, &nFrame);
    Th_ErrorMessage(interp, "no such frame:", zFrame, nFrame);
    Th_Free(interp, zFrame);
  }
  return p;
}


/*
** Evaluate th1 script (zProgram, nProgram) in the frame identified by
** argument iFrame. Leave either an error message or a result in the
** interpreter result and return a th1 error code (TH_OK, TH_ERROR, 
** TH_RETURN, TH_CONTINUE or TH_BREAK).
*/
int Th_Eval(Th_Interp *interp, int iFrame, const char *zProgram, int nProgram){
  int rc = TH_OK;
  Th_Frame *pSavedFrame = interp->pFrame;

  /* Set Th_Interp.pFrame to the frame that this script is to be 
  ** evaluated in. The current frame is saved in pSavedFrame and will
  ** be restored before this function returns.
  */
  interp->pFrame = getFrame(interp, iFrame);

  if( !interp->pFrame ){
    rc = TH_ERROR;
  }else{
    int nInput = nProgram;
  
    if( nInput<0 ){
      nInput = th_strlen(zProgram);
    }
    rc = thEvalLocal(interp, zProgram, nInput);
  }

  interp->pFrame = pSavedFrame;
  return rc;
}

/*
** Input string (zVarname, nVarname) contains a th1 variable name. It
** may be a simple scalar variable name or it may be a reference
** to an array member. The variable name may or may not begin with
** "::", indicating that the name refers to a global variable, not
** a local scope one.
**
** This function inspects and categorizes the supplied variable name.
**
** If the name is a global reference, *pisGlobal is set to true. Otherwise
** false. Output string (*pzOuter, *pnOuter) is set to the variable name
** if it is a scalar reference, or the name of the array if it is an
** array variable. If the variable is a scalar, *pzInner is set to 0.
** If it is an array variable, (*pzInner, *pnInner) is set to the
** array key name.
*/
static int thAnalyseVarname(
  const char *zVarname,
  int nVarname,
  const char **pzOuter,     /* OUT: Pointer to scalar/array name */
  int *pnOuter,              /* OUT: Number of bytes at *pzOuter */
  const char **pzInner,     /* OUT: Pointer to array key (or null) */
  int *pnInner,              /* OUT: Number of bytes at *pzInner */
  int *pisGlobal             /* OUT: Set to true if this is a global ref */
){
  const char *zOuter = zVarname;
  int nOuter;
  const char *zInner = 0;
  int nInner = 0;
  int isGlobal = 0;
  int i;

  if( nVarname<0 ){
    nVarname = th_strlen(zVarname);
  }
  nOuter = nVarname;

  /* If the variable name starts with "::", then do the lookup is in the
  ** uppermost (global) frame.
  */
  if( nVarname>2 && zVarname[0]==':' && zVarname[1]==':' ){
    zOuter += 2;
    nOuter -= 2;
    isGlobal = 1;
  }

  /* Check if this is an array reference. */
  if( zOuter[nOuter-1]==')' ){
    for(i=0; i<nOuter; i++){
      if( zOuter[i]=='(' ){
        zInner = &zOuter[i+1];
        nInner = nOuter-i-2;
        nOuter = i;
        break;
      }
    }
  }

  *pzOuter = zOuter;
  *pnOuter = nOuter;
  *pzInner = zInner;
  *pnInner = nInner;
  *pisGlobal = isGlobal;
  return TH_OK;
}

/*
** Input string (zVar, nVar) contains a variable name. This function locates
** the Th_Variable structure associated with the named variable. The 
** variable name may be a global or local scalar or array variable
**
** If the create argument is non-zero and the named variable does not exist
** it is created. Otherwise, an error is left in the interpreter result
** and NULL returned.
**
** If the arrayok argument is false and the named variable is an array,
** an error is left in the interpreter result and NULL returned. If
** arrayok is true an array name is Ok.
*/
static Th_Variable *thFindValue(
  Th_Interp *interp,
  const char *zVar,     /* Pointer to variable name */
  int nVar,              /* Number of bytes at nVar */
  int create,            /* If true, create the variable if not found */
  int arrayok            /* If true, an array is Ok. Othewise array==error */
){
  const char *zOuter;
  int nOuter;
  const char *zInner;
  int nInner;
  int isGlobal;

  Th_HashEntry *pEntry;
  Th_Frame *pFrame = interp->pFrame;
  Th_Variable *pValue;

  thAnalyseVarname(zVar, nVar, &zOuter, &nOuter, &zInner, &nInner, &isGlobal);
  if( isGlobal ){
    while( pFrame->pCaller ) pFrame = pFrame->pCaller;
  }

  pEntry = Th_HashFind(interp, pFrame->paVar, zOuter, nOuter, create);
  assert(pEntry || !create);
  if( !pEntry ){
    goto no_such_var;
  }

  pValue = (Th_Variable *)pEntry->pData;
  if( !pValue ){
    assert(create);
    pValue = Th_Malloc(interp, sizeof(Th_Variable));
    pValue->nRef = 1;
    pEntry->pData = (void *)pValue;
  }

  if( zInner ){
    if( pValue->zData ){
      Th_ErrorMessage(interp, "variable is a scalar:", zOuter, nOuter);
      return 0;
    }
    if( !pValue->pHash ){
      if( !create ){
        goto no_such_var;
      }
      pValue->pHash = Th_HashNew(interp);
    }
    pEntry = Th_HashFind(interp, pValue->pHash, zInner, nInner, create);
    if( !pEntry ){
      goto no_such_var;
    }
    pValue = (Th_Variable *)pEntry->pData;
    if( !pValue ){
      assert(create);
      pValue = Th_Malloc(interp, sizeof(Th_Variable));
      pValue->nRef = 1;
      pEntry->pData = (void *)pValue;
    }
  }else{
    if( pValue->pHash && !arrayok ){
      Th_ErrorMessage(interp, "variable is an array:", zOuter, nOuter);
      return 0;
    }
  }

  return pValue;

no_such_var:
  Th_ErrorMessage(interp, "no such variable:", zVar, nVar);
  return 0;
}

/*
** String (zVar, nVar) must contain the name of a scalar variable or 
** array member. Look up the variable, store its current value in 
** the interpreter result and return TH_OK.
**
** If the named variable does not exist, return TH_ERROR and leave
** an error message in the interpreter result.
*/
int Th_GetVar(Th_Interp *interp, const char *zVar, int nVar){
  Th_Variable *pValue;

  pValue = thFindValue(interp, zVar, nVar, 0, 0);
  if( !pValue ){
    return TH_ERROR;
  }
  if( !pValue->zData ){
    Th_ErrorMessage(interp, "no such variable:", zVar, nVar);
    return TH_ERROR;
  }

  return Th_SetResult(interp, pValue->zData, pValue->nData);
}

/*
** String (zVar, nVar) must contain the name of a scalar variable or
** array member. If the variable does not exist it is created. The
** variable is set to the value supplied in string (zValue, nValue).
**
** If (zVar, nVar) refers to an existing array, TH_ERROR is returned
** and an error message left in the interpreter result.
*/
int Th_SetVar(
  Th_Interp *interp, 
  const char *zVar, 
  int nVar,
  const char *zValue,
  int nValue
){
  Th_Variable *pValue;

  pValue = thFindValue(interp, zVar, nVar, 1, 0);
  if( !pValue ){
    return TH_ERROR;
  }

  if( nValue<0 ){
    nValue = th_strlen(zValue);
  }
  if( pValue->zData ){
    Th_Free(interp, pValue->zData);
    pValue->zData = 0;
  }

  assert(zValue || nValue==0);
  pValue->zData = Th_Malloc(interp, nValue+1);
  pValue->zData[nValue] = '\0';
  memcpy(pValue->zData, zValue, nValue);
  pValue->nData = nValue;

  return TH_OK;
}

/*
** Create a variable link so that accessing variable (zLocal, nLocal) is
** the same as accessing variable (zLink, nLink) in stack frame iFrame.
*/
int Th_LinkVar(
  Th_Interp *interp,                 /* Interpreter */
  const char *zLocal, int nLocal,   /* Local varname */
  int iFrame,                        /* Stack frame of linked var */
  const char *zLink, int nLink      /* Linked varname */
){
  Th_Frame *pSavedFrame = interp->pFrame;
  Th_Frame *pFrame;
  Th_HashEntry *pEntry;
  Th_Variable *pValue;

  pFrame = getFrame(interp, iFrame);
  if( !pFrame ){
    return TH_ERROR;
  }
  pSavedFrame = interp->pFrame;
  interp->pFrame = pFrame;
  pValue = thFindValue(interp, zLink, nLink, 1, 1);
  interp->pFrame = pSavedFrame;

  pEntry = Th_HashFind(interp, interp->pFrame->paVar, zLocal, nLocal, 1);
  if( pEntry->pData ){
    Th_ErrorMessage(interp, "variable exists:", zLocal, nLocal);
    return TH_ERROR;
  }
  pEntry->pData = (void *)pValue;
  pValue->nRef++;

  return TH_OK;
}

/*
** Input string (zVar, nVar) must contain the name of a scalar variable,
** an array, or an array member. If the identified variable exists, it
** is deleted and TH_OK returned. Otherwise, an error message is left
** in the interpreter result and TH_ERROR is returned.
*/
int Th_UnsetVar(Th_Interp *interp, const char *zVar, int nVar){
  Th_Variable *pValue;

  pValue = thFindValue(interp, zVar, nVar, 1, 1);
  if( !pValue ){
    return TH_ERROR;
  }

  Th_Free(interp, pValue->zData);
  pValue->zData = 0;
  if( pValue->pHash ){
    Th_HashIterate(interp, pValue->pHash, thFreeVariable, (void *)interp);
    Th_HashDelete(interp, pValue->pHash);
    pValue->pHash = 0;
  }
  return TH_OK;
}

/*
** Return an allocated buffer containing a copy of string (z, n). The
** caller is responsible for eventually calling Th_Free() to free
** the returned buffer.
*/
char *th_strdup(Th_Interp *interp, const char *z, int n){
  char *zRes;
  if( n<0 ){
    n = th_strlen(z);
  }
  zRes = Th_Malloc(interp, n+1);
  memcpy(zRes, z, n);
  zRes[n] = '\0';
  return zRes;
}

/*
** Argument zPre must be a nul-terminated string. Set the interpreter
** result to a string containing the contents of zPre, followed by
** a space (" ") character, followed by a copy of string (z, n).
**
** In other words, the equivalent of:
*
**     printf("%s %.*s", zPre, n, z);
**
** Example:
**
**     Th_ErrorMessage(interp, "no such variable:", zVarname, nVarname);
**
*/
int Th_ErrorMessage(Th_Interp *interp, const char *zPre, const char *z, int n){
  if( interp ){
    char *zRes = 0;
    int nRes = 0;

    Th_SetVar(interp, (char *)"::th_stack_trace", -1, 0, 0);
  
    Th_StringAppend(interp, &zRes, &nRes, zPre, -1);
    if( zRes[nRes-1]=='"' ){
      Th_StringAppend(interp, &zRes, &nRes, z, n);
      Th_StringAppend(interp, &zRes, &nRes, (const char *)"\"", 1);
    }else{
      Th_StringAppend(interp, &zRes, &nRes, (const char *)" ", 1);
      Th_StringAppend(interp, &zRes, &nRes, z, n);
    }

    Th_SetResult(interp, zRes, nRes);
    Th_Free(interp, zRes);
  }

  return TH_OK;
}

/*
** Set the current interpreter result by taking a copy of the buffer
** pointed to by z, size n bytes. TH_OK is always returned.
*/
int Th_SetResult(Th_Interp *pInterp, const char *z, int n){

  /* Free the current result */
  Th_Free(pInterp, pInterp->zResult);
  pInterp->zResult = 0;
  pInterp->nResult = 0;

  if( n<0 ){
    n = th_strlen(z);
  }

  if( z && n>0 ){
    char *zResult;
    zResult = Th_Malloc(pInterp, n+1);
    memcpy(zResult, z, n);
    zResult[n] = '\0';
    pInterp->zResult = zResult;
    pInterp->nResult = n;
  }

  return TH_OK;
}

/*
** Return a pointer to the buffer containing the current interpreter
** result. If pN is not NULL, set *pN to the size of the returned
** buffer.
*/
const char *Th_GetResult(Th_Interp *pInterp, int *pN){
  assert(pInterp->zResult || pInterp->nResult==0);
  if( pN ){
    *pN = pInterp->nResult;
  }
  return (pInterp->zResult ? pInterp->zResult : (const char *)"");
}

/*
** Return a pointer to the buffer containing the current interpreter
** result. If pN is not NULL, set *pN to the size of the returned
** buffer.
**
** This function is the same as Th_GetResult() except that the
** caller is responsible for eventually calling Th_Free() on the
** returned buffer. The internal interpreter result is cleared
** after this function is called.
*/
char *Th_TakeResult(Th_Interp *pInterp, int *pN){
  if( pN ){
    *pN = pInterp->nResult;
  }
  if( pInterp->zResult ){
    char *zResult = pInterp->zResult;
    pInterp->zResult = 0;
    pInterp->nResult = 0;
    return zResult;
  }else{
    return (char *)Th_Malloc(pInterp, 1);
  }
}


/* 
** Wrappers around the supplied malloc() and free() 
*/
void *Th_Malloc(Th_Interp *pInterp, int nByte){
  void *p = pInterp->pVtab->xMalloc(nByte);
  if( p ){
    memset(p, 0, nByte);
  }
  return p;
}
void Th_Free(Th_Interp *pInterp, void *z){
  if( z ){
    pInterp->pVtab->xFree(z);
  }
}

/*
** Install a new th1 command. 
**
** If a command of the same name already exists, it is deleted automatically.
*/
int Th_CreateCommand(
  Th_Interp *interp, 
  const char *zName,                 /* New command name */
  Th_CommandProc xProc,              /* Command callback proc */
  void *pContext,                    /* Value to pass as second arg to xProc */
  void (*xDel)(Th_Interp *, void *)  /* Command destructor callback */
){
  Th_HashEntry *pEntry;
  Th_Command *pCommand;

  pEntry = Th_HashFind(interp, interp->paCmd, (const char *)zName, -1, 1);
  if( pEntry->pData ){
    pCommand = pEntry->pData;
    if( pCommand->xDel ){
      pCommand->xDel(interp, pCommand->pContext);
    }
  }else{
    pCommand = Th_Malloc(interp, sizeof(Th_Command));
  }
  pCommand->xProc = xProc;
  pCommand->pContext = pContext;
  pCommand->xDel = xDel;
  pEntry->pData = (void *)pCommand;
 
  return TH_OK;
}

/*
** Rename the existing command (zName, nName) to (zNew, nNew). If nNew is 0, 
** the command is deleted instead of renamed.
**
** If successful, TH_OK is returned. If command zName does not exist, or
** if command zNew already exists, an error message is left in the 
** interpreter result and TH_ERROR is returned.
*/
int Th_RenameCommand(
  Th_Interp *interp, 
  const char *zName,            /* Existing command name */
  int nName,                     /* Number of bytes at zName */
  const char *zNew,             /* New command name */
  int nNew                       /* Number of bytes at zNew */
){
  Th_HashEntry *pEntry;
  Th_HashEntry *pNewEntry;

  pEntry = Th_HashFind(interp, interp->paCmd, zName, nName, 0);
  if( !pEntry ){
    Th_ErrorMessage(interp, "no such command:", zName, nName);
    return TH_ERROR;
  }
  assert(pEntry->pData);

  if( nNew>0 ){
    pNewEntry = Th_HashFind(interp, interp->paCmd, zNew, nNew, 1);
    if( pNewEntry->pData ){
      Th_ErrorMessage(interp, "command exists:", zNew, nNew);
      return TH_ERROR;
    }
    pNewEntry->pData = pEntry->pData;
  }else{
    Th_Command *pCommand = (Th_Command *)(pEntry->pData);
    if( pCommand->xDel ){
      pCommand->xDel(interp, pCommand->pContext);
    }
    Th_Free(interp, pCommand);
  }

  Th_HashFind(interp, interp->paCmd, zName, nName, -1);
  return TH_OK;
}

/*
** Push a stack frame onto the interpreter stack, invoke the
** callback, and pop the frame back off again. See the implementation
** of [proc] (th_lang.c) for an example.
*/
int Th_InFrame(Th_Interp *interp,
  int (*xCall)(Th_Interp *, void *pContext1, void *pContext2),
  void *pContext1,
  void *pContext2
){
  Th_Frame frame;
  int rc;
  thPushFrame(interp, &frame);
  rc = xCall(interp, pContext1, pContext2);
  thPopFrame(interp);
  return rc;
}

/*
** Split a th1 list into its component elements. The list to split is
** passed via arguments (zList, nList). If successful, TH_OK is returned.
** If an error occurs (if (zList, nList) is not a valid list) an error
** message is left in the interpreter result and TH_ERROR returned.
**
** If successful, *pnCount is set to the number of elements in the list.
** panElem is set to point at an array of *pnCount integers - the lengths
** of the element values. *pazElem is set to point at an array of 
** pointers to buffers containing the array element's data.
**
** To free the arrays allocated at *pazElem and *panElem, the caller
** should call Th_Free() on *pazElem only. Exactly one such call to
** Th_Free() must be made per call to Th_SplitList().
**
** Example:
**
**     int nElem;
**     int *anElem;
**     char **azElem;
**     int i;
**
**     Th_SplitList(interp, zList, nList, &azElem, &anElem, &nElem);
**     for(i=0; i<nElem; i++){
**       int nData = anElem[i];
**       char *zData = azElem[i];
**       ...
**     }
**
**     Th_Free(interp, azElem);
**
*/
int Th_SplitList(
  Th_Interp *interp,
  const char *zList,             /* Pointer to buffer containing list */
  int nList,                      /* Number of bytes at zList */
  char ***pazElem,               /* OUT: Array of pointers to element data */
  int **panElem,                  /* OUT: Array of element data lengths */
  int *pnCount                    /* OUT: Number of elements in list */
){
  int rc;
  interp->isListMode = 1;
  rc = thSplitList(interp, zList, nList, pazElem, panElem, pnCount);
  interp->isListMode = 0;
  if( rc ){
    Th_ErrorMessage(interp, "Expected list, got: \"", zList, nList);
  }
  return rc;
}

/*
** Append a new element to an existing th1 list. The element to append 
** to the list is (zElem, nElem).
**
** A pointer to the existing list must be stored at *pzList when this
** function is called. The length must be stored in *pnList. The value 
** of *pzList must either be NULL (in which case *pnList must be 0), or 
** a pointer to memory obtained from Th_Malloc().
**
** This function calls Th_Free() to free the buffer at *pzList and sets
** *pzList to point to a new buffer containing the new list value. *pnList
** is similarly updated before returning. The return value is always TH_OK.
**
** Example:
**
**     char *zList = 0;
**     int nList = 0;
**     for (...) {
**       char *zElem = <some expression>;
**       Th_ListAppend(interp, &zList, &nList, zElem, -1);
**     }
**     Th_SetResult(interp, zList, nList);
**     Th_Free(interp, zList);
**
*/
int Th_ListAppend(
  Th_Interp *interp,           /* Interpreter context */
  char **pzList,              /* IN/OUT: Ptr to ptr to list */
  int *pnList,                 /* IN/OUT: Current length of *pzList */
  const char *zElem,          /* Data to append */
  int nElem                    /* Length of nElem */
){
  Buffer output;
  int i;

  int hasSpecialChar = 0;
  int hasEscapeChar = 0;
  int nBrace = 0;

  output.zBuf = *pzList;
  output.nBuf = *pnList;
  output.nBufAlloc = output.nBuf;

  if( nElem<0 ){
    nElem = th_strlen(zElem);
  }
  if( output.nBuf>0 ){
    thBufferWrite(interp, &output, " ", 1);
  }

  for(i=0; i<nElem; i++){
    char c = zElem[i];
    if( th_isspecial(c) ) hasSpecialChar = 1;
    if( c=='\\' ) hasEscapeChar = 1;
    if( c=='{' ) nBrace++;
    if( c=='}' ) nBrace--;
  }

  if( nElem==0 || (!hasEscapeChar && hasSpecialChar && nBrace==0) ){
    thBufferWrite(interp, &output, "{", 1);
    thBufferWrite(interp, &output, zElem, nElem);
    thBufferWrite(interp, &output, "}", 1);
  }else{
    for(i=0; i<nElem; i++){
      char c = zElem[i];
      if( th_isspecial(c) ) thBufferWrite(interp, &output, "\\", 1);
      thBufferWrite(interp, &output, &c, 1);
    }
  }

  *pzList = output.zBuf;
  *pnList = output.nBuf;

  return TH_OK;
}

/*
** Append a new element to an existing th1 string. This function uses
** the same interface as the Th_ListAppend() function.
*/
int Th_StringAppend(
  Th_Interp *interp,           /* Interpreter context */
  char **pzStr,               /* IN/OUT: Ptr to ptr to list */
  int *pnStr,                  /* IN/OUT: Current length of *pzStr */
  const char *zElem,          /* Data to append */
  int nElem                    /* Length of nElem */
){
  char *zNew;
  int nNew;

  if( nElem<0 ){
    nElem = th_strlen(zElem);
  }

  nNew = *pnStr + nElem;
  zNew = Th_Malloc(interp, nNew);
  memcpy(zNew, *pzStr, *pnStr);
  memcpy(&zNew[*pnStr], zElem, nElem);

  Th_Free(interp, *pzStr);
  *pzStr = zNew;
  *pnStr = nNew;

  return TH_OK;
}

/* 
** Delete an interpreter.
*/
void Th_DeleteInterp(Th_Interp *interp){
  assert(interp->pFrame);
  assert(0==interp->pFrame->pCaller);

  /* Delete the contents of the global frame. */
  thPopFrame(interp);

  /* Delete any result currently stored in the interpreter. */
  Th_SetResult(interp, 0, 0);

  /* Delete all registered commands and the command hash-table itself. */
  Th_HashIterate(interp, interp->paCmd, thFreeCommand, (void *)interp);
  Th_HashDelete(interp, interp->paCmd);

  /* Delete the interpreter structure itself. */
  Th_Free(interp, (void *)interp);
}

/* 
** Create a new interpreter.
*/
Th_Interp * Th_CreateInterp(Th_Vtab *pVtab){
  Th_Interp *p;

  /* Allocate and initialise the interpreter and the global frame */
  p = pVtab->xMalloc(sizeof(Th_Interp) + sizeof(Th_Frame));
  memset(p, 0, sizeof(Th_Interp));
  p->pVtab = pVtab;
  p->paCmd = Th_HashNew(p);
  thPushFrame(p, (Th_Frame *)&p[1]);

  return p;
}

/*
** These two types are used only by the expression module, where
** the expression module means the Th_Expr() and exprXXX() functions.
*/
typedef struct Operator Operator;
struct Operator {
  const char *zOp;
  int eOp;
  int iPrecedence;
  int eArgType;
};
typedef struct Expr Expr;
struct Expr {
  Operator *pOp;
  Expr *pParent;
  Expr *pLeft;
  Expr *pRight;

  char *zValue;     /* Pointer to literal value */
  int nValue;        /* Length of literal value buffer */
};

/* Unary operators */
#define OP_UNARY_MINUS  2
#define OP_UNARY_PLUS   3
#define OP_BITWISE_NOT  4
#define OP_LOGICAL_NOT  5

/* Binary operators */
#define OP_MULTIPLY     6
#define OP_DIVIDE       7
#define OP_MODULUS      8
#define OP_ADD          9
#define OP_SUBTRACT    10
#define OP_LEFTSHIFT   11
#define OP_RIGHTSHIFT  12
#define OP_LT          13
#define OP_GT          14
#define OP_LE          15
#define OP_GE          16
#define OP_EQ          17
#define OP_NE          18
#define OP_SEQ         19
#define OP_SNE         20
#define OP_BITWISE_AND 21
#define OP_BITWISE_XOR 22
#define OP_BITWISE_OR  24
#define OP_LOGICAL_AND 25
#define OP_LOGICAL_OR  26

/* Other symbols */
#define OP_OPEN_BRACKET  27
#define OP_CLOSE_BRACKET 28

/* Argument types. Each operator in the expression syntax is defined
** as requiring either integer, number (real or integer) or string
** operands.
*/
#define ARG_INTEGER 1
#define ARG_NUMBER  2
#define ARG_STRING  3

static Operator aOperator[] = {

  {"(",  OP_OPEN_BRACKET,   -1, 0},
  {")",  OP_CLOSE_BRACKET, -1, 0},

  /* Note: all unary operators have (iPrecedence==1) */
  {"-",  OP_UNARY_MINUS,    1, ARG_NUMBER},
  {"+",  OP_UNARY_PLUS,     1, ARG_NUMBER},
  {"~",  OP_BITWISE_NOT,    1, ARG_INTEGER},
  {"!",  OP_LOGICAL_NOT,    1, ARG_INTEGER},

  /* Binary operators. It is important to the parsing in Th_Expr() that
   * the two-character symbols ("==") appear before the one-character 
   * ones ("="). And that the priorities of all binary operators are
   * integers between 2 and 12.
   */
  {"<<", OP_LEFTSHIFT,      4, ARG_INTEGER},
  {">>", OP_RIGHTSHIFT,     4, ARG_INTEGER},
  {"<=", OP_LE,             5, ARG_NUMBER},
  {">=", OP_GE,             5, ARG_NUMBER},
  {"==", OP_EQ,             6, ARG_NUMBER},
  {"!=", OP_NE,             6, ARG_NUMBER},
  {"eq", OP_SEQ,            7, ARG_STRING},
  {"ne", OP_SNE,            7, ARG_STRING},
  {"&&", OP_LOGICAL_AND,   11, ARG_INTEGER},
  {"||", OP_LOGICAL_OR,    12, ARG_INTEGER},

  {"*",  OP_MULTIPLY,       2, ARG_NUMBER},
  {"/",  OP_DIVIDE,         2, ARG_NUMBER},
  {"%",  OP_MODULUS,        2, ARG_INTEGER},
  {"+",  OP_ADD,            3, ARG_NUMBER},
  {"-",  OP_SUBTRACT,       3, ARG_NUMBER},
  {"<",  OP_LT,             5, ARG_NUMBER},
  {">",  OP_GT,             5, ARG_NUMBER},
  {"&",  OP_BITWISE_AND,    8, ARG_INTEGER},
  {"^",  OP_BITWISE_XOR,    9, ARG_INTEGER},
  {"|",  OP_BITWISE_OR,    10, ARG_INTEGER},

  {0,0,0}
};

/*
** The first part of the string (zInput,nInput) contains a number.
** Set *pnVarname to the number of bytes in the numeric string. 
*/
static int thNextNumber(
  Th_Interp *interp, 
  const char *zInput, 
  int nInput, 
  int *pnLiteral
){
  int i;
  int seenDot = 0;
  for(i=0; i<nInput; i++){
    char c = zInput[i];
    if( (seenDot || c!='.') && !th_isdigit(c) ) break;
    if( c=='.' ) seenDot = 1;
  }
  *pnLiteral = i;
  return TH_OK;
}

/*
** Free an expression tree.
*/
static void exprFree(Th_Interp *interp, Expr *pExpr){
  if( pExpr ){
    exprFree(interp, pExpr->pLeft);
    exprFree(interp, pExpr->pRight);
    Th_Free(interp, pExpr->zValue);
    Th_Free(interp, pExpr);
  }
}

/*
** Evaluate an expression tree.
*/
static int exprEval(Th_Interp *interp, Expr *pExpr){
  int rc = TH_OK;

  if( pExpr->pOp==0 ){
    /* A literal */
    rc = thSubstWord(interp, pExpr->zValue, pExpr->nValue);
  }else{
    int eArgType = 0;           /* Actual type of arguments */

    /* Argument values */
    int iLeft = 0;
    int iRight = 0;
    double fLeft;
    double fRight;

    /* Left and right arguments as strings */
    char *zLeft = 0; int nLeft = 0;
    char *zRight = 0; int nRight = 0;

    /* Evaluate left and right arguments, if they exist. */
    if( pExpr->pLeft ){
      rc = exprEval(interp, pExpr->pLeft);
      if( rc==TH_OK ){
        zLeft = Th_TakeResult(interp, &nLeft);
      }
    }
    if( rc==TH_OK && pExpr->pRight ){
      rc = exprEval(interp, pExpr->pRight);
      if( rc==TH_OK ){
        zRight = Th_TakeResult(interp, &nRight);
      }
    }

    /* Convert arguments to their required forms. */
    if( rc==TH_OK ){
      eArgType = pExpr->pOp->eArgType;
      if( eArgType==ARG_NUMBER ){
        if( (zLeft==0 || TH_OK==Th_ToInt(0, zLeft, nLeft, &iLeft))
         && (zRight==0 || TH_OK==Th_ToInt(0, zRight, nRight, &iRight))
        ){
          eArgType = ARG_INTEGER;
        }else if( 
          (zLeft && TH_OK!=Th_ToDouble(interp, zLeft, nLeft, &fLeft)) ||
          (zRight && TH_OK!=Th_ToDouble(interp, zRight, nRight, &fRight))
        ){
          /* A type error. */
          rc = TH_ERROR;
        }
      }else if( eArgType==ARG_INTEGER ){
        rc = Th_ToInt(interp, zLeft, nLeft, &iLeft);
        if( rc==TH_OK && zRight ){
          rc = Th_ToInt(interp, zRight, nRight, &iRight);
        }
      }  
    }

    if( rc==TH_OK && eArgType==ARG_INTEGER ){
      int iRes = 0;
      switch( pExpr->pOp->eOp ) {
        case OP_MULTIPLY:     iRes = iLeft*iRight;  break;
        case OP_DIVIDE:       iRes = iLeft/iRight;  break;
        case OP_MODULUS:      iRes = iLeft%iRight;  break;
        case OP_ADD:          iRes = iLeft+iRight;  break;
        case OP_SUBTRACT:     iRes = iLeft-iRight;  break;
        case OP_LEFTSHIFT:    iRes = iLeft<<iRight; break;
        case OP_RIGHTSHIFT:   iRes = iLeft>>iRight; break;
        case OP_LT:           iRes = iLeft<iRight;  break;
        case OP_GT:           iRes = iLeft>iRight;  break;
        case OP_LE:           iRes = iLeft<=iRight; break;
        case OP_GE:           iRes = iLeft>=iRight; break;
        case OP_EQ:           iRes = iLeft==iRight; break;
        case OP_NE:           iRes = iLeft!=iRight; break;
        case OP_BITWISE_AND:  iRes = iLeft&iRight;  break;
        case OP_BITWISE_XOR:  iRes = iLeft^iRight;  break;
        case OP_BITWISE_OR:   iRes = iLeft|iRight;  break;
        case OP_LOGICAL_AND:  iRes = iLeft&&iRight; break;
        case OP_LOGICAL_OR:   iRes = iLeft||iRight; break;
        case OP_UNARY_MINUS:  iRes = -iLeft;        break;
        case OP_UNARY_PLUS:   iRes = +iLeft;        break;
        case OP_LOGICAL_NOT:  iRes = !iLeft;        break;
        default: assert(!"Internal error");
      }
      Th_SetResultInt(interp, iRes);
    }else if( rc==TH_OK && eArgType==ARG_NUMBER ){
      switch( pExpr->pOp->eOp ) {
        case OP_MULTIPLY: Th_SetResultDouble(interp, fLeft*fRight);  break;
        case OP_DIVIDE:   Th_SetResultDouble(interp, fLeft/fRight);  break;
        case OP_ADD:      Th_SetResultDouble(interp, fLeft+fRight);  break;
        case OP_SUBTRACT: Th_SetResultDouble(interp, fLeft-fRight);  break;
        case OP_LT:       Th_SetResultInt(interp, fLeft<fRight);  break;
        case OP_GT:       Th_SetResultInt(interp, fLeft>fRight);  break;
        case OP_LE:       Th_SetResultInt(interp, fLeft<=fRight); break;
        case OP_GE:       Th_SetResultInt(interp, fLeft>=fRight); break;
        case OP_EQ:       Th_SetResultInt(interp, fLeft==fRight); break;
        case OP_NE:       Th_SetResultInt(interp, fLeft!=fRight); break;
        default: assert(!"Internal error");
      }
    }else if( rc==TH_OK ){
      int iEqual = 0;
      assert( eArgType==ARG_STRING );
      if( nRight==nLeft && 0==memcmp(zRight, zLeft, nRight) ){
        iEqual = 1;
      }
      switch( pExpr->pOp->eOp ) {
        case OP_SEQ:       Th_SetResultInt(interp, iEqual); break;
        case OP_SNE:       Th_SetResultInt(interp, !iEqual); break;
        default: assert(!"Internal error");
      }
    }

    Th_Free(interp, zLeft);
    Th_Free(interp, zRight);
  }

  return rc;
}

/*
** Create an expression tree from an array of tokens. If successful,
** the root of the tree is stored in apToken[0].
*/
int exprMakeTree(Th_Interp *interp, Expr **apToken, int nToken){
  int iLeft;
  int i;
  int jj;

  assert(nToken>0);
#define ISTERM(x) (apToken[x] && (!apToken[x]->pOp || apToken[x]->pLeft))

  for(jj=0; jj<nToken; jj++){
    if( apToken[jj]->pOp && apToken[jj]->pOp->eOp==OP_OPEN_BRACKET ){
      int nNest = 1;
      int iLeft = jj; 

      for(jj++; jj<nToken; jj++){
        Operator *pOp = apToken[jj]->pOp;
        if( pOp && pOp->eOp==OP_OPEN_BRACKET ) nNest++;
        if( pOp && pOp->eOp==OP_CLOSE_BRACKET ) nNest--;
        if( nNest==0 ) break;
      }
      if( jj==nToken ){
        return TH_ERROR;
      }
      if( (jj-iLeft)>1 ){
        if( exprMakeTree(interp, &apToken[iLeft+1], jj-iLeft-1) ){
          return TH_ERROR;
        }
        exprFree(interp, apToken[jj]);
        exprFree(interp, apToken[iLeft]);
        apToken[jj] = 0;
        apToken[iLeft] = 0;
      }
    }
  }

  iLeft = 0;
  for(jj=nToken-1; jj>=0; jj--){
    if( apToken[jj] ){
      if( apToken[jj]->pOp && apToken[jj]->pOp->iPrecedence==1 && iLeft>0 ){
        apToken[jj]->pLeft = apToken[iLeft];
        apToken[jj]->pLeft->pParent = apToken[jj];
        apToken[iLeft] = 0;
      }
      iLeft = jj;
    }
  }
  for(i=2; i<=12; i++){
    iLeft = -1;
    for(jj=0; jj<nToken; jj++){
      Expr *pToken = apToken[jj];
      if( apToken[jj] ){
        if( pToken->pOp && !pToken->pLeft && pToken->pOp->iPrecedence==i ){
          int iRight = jj+1;

          iRight = jj+1;
          for(iRight=jj+1; !apToken[iRight] && iRight<nToken; iRight++);
          if( iRight==nToken || iLeft<0 || !ISTERM(iRight) || !ISTERM(iLeft) ){
            return TH_ERROR;
          }
          pToken->pLeft = apToken[iLeft];
          apToken[iLeft] = 0;
          pToken->pLeft->pParent = pToken;
          pToken->pRight = apToken[iRight];
          apToken[iRight] = 0;
          pToken->pRight->pParent = pToken;
        }
        iLeft = jj;
      }
    }
  }
  for(jj=1; jj<nToken; jj++){
    assert( !apToken[jj] || !apToken[0] );
    if( apToken[jj] ){
      apToken[0] = apToken[jj];
      apToken[jj] = 0;
    }
  }

  return TH_OK;
}

/*
** Parse a string containing a TH expression to a list of tokens.
*/
static int exprParse(
  Th_Interp *interp,        /* Interpreter to leave error message in */
  const char *zExpr,       /* Pointer to input string */
  int nExpr,                /* Number of bytes at zExpr */
  Expr ***papToken,         /* OUT: Array of tokens. */
  int *pnToken              /* OUT: Size of token array */
){
  int i;

  int rc = TH_OK;
  int nToken = 0;
  Expr **apToken = 0;

  for(i=0; rc==TH_OK && i<nExpr; ){
    char c = zExpr[i];
    if( th_isspace(c) ){                                /* White-space     */
      i++;
    }else{
      Expr *pNew = (Expr *)Th_Malloc(interp, sizeof(Expr));
      const char *z = &zExpr[i];

      switch (c) {
        case '0': case '1': case '2': case '3': case '4':
        case '5': case '6': case '7': case '8': case '9':
          thNextNumber(interp, z, nExpr-i, &pNew->nValue);
          break;

        case '$':
          thNextVarname(interp, z, nExpr-i, &pNew->nValue);
          break;

        case '{': case '[': {
          thNextCommand(interp, z, nExpr-i, &pNew->nValue);
          break;
        }

        case '"': {
          int iEnd = i;
          while( ++iEnd<nExpr && zExpr[iEnd]!='"' ){
            if( zExpr[iEnd]=='\\' ) iEnd++;
          }
          if( iEnd<nExpr ){
            pNew->nValue = iEnd+1-i;
          }
          break;
        }

        default: {
          int j;
          for(j=0; aOperator[j].zOp; j++){
            int nOp;
            if( aOperator[j].iPrecedence==1 && nToken>0 ){
              Expr *pPrev = apToken[nToken-1];
              if( !pPrev->pOp || pPrev->pOp->eOp==OP_CLOSE_BRACKET ){
                continue;
              }
            }
            nOp = th_strlen((const char *)aOperator[j].zOp);
            if( (nExpr-i)>=nOp && 0==memcmp(aOperator[j].zOp, &zExpr[i], nOp) ){
              pNew->pOp = &aOperator[j];
              i += nOp;
              break;
            }
          }
        }
      }

      if( pNew->pOp || pNew->nValue ){
        if( pNew->nValue ){
          /* A terminal. Copy the string value. */
          assert( !pNew->pOp );
          pNew->zValue = Th_Malloc(interp, pNew->nValue);
          memcpy(pNew->zValue, z, pNew->nValue);
          i += pNew->nValue;
        }
        if( (nToken%16)==0 ){
          /* Grow the apToken array. */
          Expr **apTokenOld = apToken; 
          apToken = Th_Malloc(interp, sizeof(Expr *)*(nToken+16));
          memcpy(apToken, apTokenOld, sizeof(Expr *)*nToken);
        }

        /* Put the new token at the end of the apToken array */
        apToken[nToken] = pNew;
        nToken++;
      }else{
        Th_Free(interp, pNew);
        rc = TH_ERROR;
      }
    }
  }

  *papToken = apToken;
  *pnToken = nToken;
  return rc;
}

/*
** Evaluate the string (zExpr, nExpr) as a Th expression. Store
** the result in the interpreter interp and return TH_OK if
** successful. If an error occurs, store an error message in
** the interpreter result and return an error code.
*/ 
int Th_Expr(Th_Interp *interp, const char *zExpr, int nExpr){
  int rc;                           /* Return Code */
  int i;                            /* Loop counter */

  int nToken = 0;
  Expr **apToken = 0;

  if( nExpr<0 ){
    nExpr = th_strlen(zExpr);
  }

  /* Parse the expression to a list of tokens. */
  rc = exprParse(interp, zExpr, nExpr, &apToken, &nToken);

  /* If the parsing was successful, create an expression tree from
  ** the parsed list of tokens. If successful, apToken[0] is set
  ** to point to the root of the expression tree. 
  */
  if( rc==TH_OK ){
    rc = exprMakeTree(interp, apToken, nToken);
  }

  if( rc!=TH_OK ){
    Th_ErrorMessage(interp, "syntax error in expression: \"", zExpr, nExpr);
  }

  /* Evaluate the expression tree. */
  if( rc==TH_OK ){
    rc = exprEval(interp, apToken[0]);
  }

  /* Free memory allocated by exprParse(). */
  for(i=0; i<nToken; i++){
    exprFree(interp, apToken[i]);
  }
  Th_Free(interp, apToken);

  return rc;
}

/*
** Allocate and return a pointer to a new hash-table. The caller should
** (eventually) delete the hash-table by passing it to Th_HashDelete().
*/
Th_Hash *Th_HashNew(Th_Interp *interp){
  Th_Hash *p;
  p = Th_Malloc(interp, sizeof(Th_Hash));
  return p;
}

/*
** Iterate through all values currently stored in the hash table. Invoke
** the callback function xCallback for each entry. The second argument
** passed to xCallback is a copy of the fourth argument passed to this
** function.
*/
void Th_HashIterate(
  Th_Interp *interp, 
  Th_Hash *pHash,
  void (*xCallback)(Th_HashEntry *pEntry, void *pContext),
  void *pContext
){
  int i;
  for(i=0; i<TH_HASHSIZE; i++){
    Th_HashEntry *pEntry;
    Th_HashEntry *pNext;
    for(pEntry=pHash->a[i]; pEntry; pEntry=pNext){
      pNext = pEntry->pNext;
      xCallback(pEntry, pContext);
    }
  }
}

/*
** Helper function for Th_HashDelete().
*/
static void xFreeHashEntry(Th_HashEntry *pEntry, void *pContext){
  Th_Free((Th_Interp *)pContext, (void *)pEntry);
}

/*
** Free a hash-table previously allocated by Th_HashNew().
*/
void Th_HashDelete(Th_Interp *interp, Th_Hash *pHash){
  if( pHash ){
    Th_HashIterate(interp, pHash, xFreeHashEntry, (void *)interp);
    Th_Free(interp, pHash);
  }
}

/*
** This function is used to insert or delete hash table items, or to 
** query a hash table for an existing item.
**
** If parameter op is less than zero, then the hash-table element 
** identified by (zKey, nKey) is removed from the hash-table if it
** exists. NULL is returned.
**
** Otherwise, if the hash-table contains an item with key (zKey, nKey),
** a pointer to the associated Th_HashEntry is returned. If parameter
** op is greater than zero, then a new entry is added if one cannot
** be found. If op is zero, then NULL is returned if the item is
** not already present in the hash-table.
*/
Th_HashEntry *Th_HashFind(
  Th_Interp *interp, 
  Th_Hash *pHash,
  const char *zKey,
  int nKey,
  int op                      /* -ve = delete, 0 = find, +ve = insert */
){
  unsigned int iKey = 0;
  int i;
  Th_HashEntry *pRet;
  Th_HashEntry **ppRet;

  if( nKey<0 ){
    nKey = th_strlen(zKey);
  }

  for(i=0; i<nKey; i++){
    iKey = (iKey<<3) ^ iKey ^ zKey[i];
  }
  iKey = iKey % TH_HASHSIZE;

  for(ppRet=&pHash->a[iKey]; (pRet=*ppRet); ppRet=&pRet->pNext){
    assert( pRet && ppRet && *ppRet==pRet );
    if( pRet->nKey==nKey && 0==memcmp(pRet->zKey, zKey, nKey) ) break;
  }

  if( op<0 && pRet ){
    assert( ppRet && *ppRet==pRet );
    *ppRet = pRet->pNext;
    Th_Free(interp, pRet);
    pRet = 0;
  }

  if( op>0 && !pRet ){
    pRet = (Th_HashEntry *)Th_Malloc(interp, sizeof(Th_HashEntry) + nKey);
    pRet->zKey = (char *)&pRet[1];
    pRet->nKey = nKey;
    memcpy(pRet->zKey, zKey, nKey);
    pRet->pNext = pHash->a[iKey];
    pHash->a[iKey] = pRet;
  }

  return pRet;
}

/*
** This function is the same as the standard strlen() function, except
** that it returns 0 (instead of being undefined) if the argument is
** a null pointer.
*/
int th_strlen(const char *zStr){
  int n = 0;
  if( zStr ){
    while( zStr[n] ) n++;
  }
  return n;
}

/* Whitespace characters:
**
**     ' '    0x20
**     '\t'   0x09
**     '\n'   0x0A
**     '\v'   0x0B
**     '\f'   0x0C
**     '\r'   0x0D
**
** Whitespace characters have the 0x01 flag set. Decimal digits have the
** 0x2 flag set. Single byte printable characters have the 0x4 flag set.
** Alphabet characters have the 0x8 bit set. 
**
** The special list characters have the 0x10 flag set
**
**    { } [ ] \ ; ' "
**
**    " 0x22
**
*/
static unsigned char aCharProp[256] = {
  0,  0,  0,  0,  0,  0,  0,  0,     0,  1,  1,  1,  1,  1,  0,  0,   /* 0x0. */
  0,  0,  1,  1,  0,  0,  0,  0,     0,  0,  0,  0,  0,  0,  0,  0,   /* 0x1. */
  5,  4, 20,  4,  4,  4,  4,  4,     4,  4,  4,  4,  4,  4,  4,  4,   /* 0x2. */
  6,  6,  6,  6,  6,  6,  6,  6,     6,  6,  4, 20,  4,  4,  4,  4,   /* 0x3. */
  4, 12, 12, 12, 12, 12, 12, 12,    12, 12, 12, 12, 12, 12, 12, 12,   /* 0x4. */
 12, 12, 12, 12, 12, 12, 12, 12,    12, 12, 12, 20, 20, 20,  4,  4,   /* 0x5. */
  4, 12, 12, 12, 12, 12, 12, 12,    12, 12, 12, 12, 12, 12, 12, 12,   /* 0x6. */
 12, 12, 12, 12, 12, 12, 12, 12,    12, 12, 12, 20,  4, 20,  4,  4,   /* 0x7. */

  0,  0,  0,  0,  0,  0,  0,  0,     0,  0,  0,  0,  0,  0,  0,  0,   /* 0x8. */
  0,  0,  0,  0,  0,  0,  0,  0,     0,  0,  0,  0,  0,  0,  0,  0,   /* 0x9. */
  0,  0,  0,  0,  0,  0,  0,  0,     0,  0,  0,  0,  0,  0,  0,  0,   /* 0xA. */
  0,  0,  0,  0,  0,  0,  0,  0,     0,  0,  0,  0,  0,  0,  0,  0,   /* 0xB. */
  0,  0,  0,  0,  0,  0,  0,  0,     0,  0,  0,  0,  0,  0,  0,  0,   /* 0xC. */
  0,  0,  0,  0,  0,  0,  0,  0,     0,  0,  0,  0,  0,  0,  0,  0,   /* 0xD. */
  0,  0,  0,  0,  0,  0,  0,  0,     0,  0,  0,  0,  0,  0,  0,  0,   /* 0xE. */
  0,  0,  0,  0,  0,  0,  0,  0,     0,  0,  0,  0,  0,  0,  0,  0    /* 0xF. */
};

/*
** Clone of the standard isspace() and isdigit function/macros.
*/
int th_isspace(char c){
  return (aCharProp[(unsigned char)c] & 0x01);
}
int th_isdigit(char c){
  return (aCharProp[(unsigned char)c] & 0x02);
}
int th_isspecial(char c){
  return (aCharProp[(unsigned char)c] & 0x11);
}
int th_isalnum(char c){
  return (aCharProp[(unsigned char)c] & 0x0A);
}

#ifndef LONGDOUBLE_TYPE
# define LONGDOUBLE_TYPE long double
#endif
typedef char u8;


/*
** Return TRUE if z is a pure numeric string.  Return FALSE if the
** string contains any character which is not part of a number. If
** the string is numeric and contains the '.' character, set *realnum
** to TRUE (otherwise FALSE).
**
** An empty string is considered non-numeric.
*/
static int sqlite3IsNumber(const char *z, int *realnum){
  int incr = 1;
  if( *z=='-' || *z=='+' ) z += incr;
  if( !th_isdigit(*(u8*)z) ){
    return 0;
  }
  z += incr;
  if( realnum ) *realnum = 0;
  while( th_isdigit(*(u8*)z) ){ z += incr; }
  if( *z=='.' ){
    z += incr;
    if( !th_isdigit(*(u8*)z) ) return 0;
    while( th_isdigit(*(u8*)z) ){ z += incr; }
    if( realnum ) *realnum = 1;
  }
  if( *z=='e' || *z=='E' ){
    z += incr;
    if( *z=='+' || *z=='-' ) z += incr;
    if( !th_isdigit(*(u8*)z) ) return 0;
    while( th_isdigit(*(u8*)z) ){ z += incr; }
    if( realnum ) *realnum = 1;
  }
  return *z==0;
}

/*
** The string z[] is an ascii representation of a real number.
** Convert this string to a double.
**
** This routine assumes that z[] really is a valid number.  If it
** is not, the result is undefined.
**
** This routine is used instead of the library atof() function because
** the library atof() might want to use "," as the decimal point instead
** of "." depending on how locale is set.  But that would cause problems
** for SQL.  So this routine always uses "." regardless of locale.
*/
static int sqlite3AtoF(const char *z, double *pResult){
  int sign = 1;
  const char *zBegin = z;
  LONGDOUBLE_TYPE v1 = 0.0;
  while( th_isspace(*(u8*)z) ) z++;
  if( *z=='-' ){
    sign = -1;
    z++;
  }else if( *z=='+' ){
    z++;
  }
  while( th_isdigit(*(u8*)z) ){
    v1 = v1*10.0 + (*z - '0');
    z++;
  }
  if( *z=='.' ){
    LONGDOUBLE_TYPE divisor = 1.0;
    z++;
    while( th_isdigit(*(u8*)z) ){
      v1 = v1*10.0 + (*z - '0');
      divisor *= 10.0;
      z++;
    }
    v1 /= divisor;
  }
  if( *z=='e' || *z=='E' ){
    int esign = 1;
    int eval = 0;
    LONGDOUBLE_TYPE scale = 1.0;
    z++;
    if( *z=='-' ){
      esign = -1;
      z++;
    }else if( *z=='+' ){
      z++;
    }
    while( th_isdigit(*(u8*)z) ){
      eval = eval*10 + *z - '0';
      z++;
    }
    while( eval>=64 ){ scale *= 1.0e+64; eval -= 64; }
    while( eval>=16 ){ scale *= 1.0e+16; eval -= 16; }
    while( eval>=4 ){ scale *= 1.0e+4; eval -= 4; }
    while( eval>=1 ){ scale *= 1.0e+1; eval -= 1; }
    if( esign<0 ){
      v1 /= scale;
    }else{
      v1 *= scale;
    }
  }
  *pResult = sign<0 ? -v1 : v1;
  return z - zBegin;
}

/*
** Try to convert the string passed as arguments (z, n) to an integer.
** If successful, store the result in *piOut and return TH_OK. 
**
** If the string cannot be converted to an integer, return TH_ERROR. 
** If the interp argument is not NULL, leave an error message in the 
** interpreter result too.
*/
int Th_ToInt(Th_Interp *interp, const char *z, int n, int *piOut){
  int i = 0;
  int iOut = 0;

  if( n<0 ){
    n = th_strlen(z);
  }

  if( n>0 && (z[0]=='-' || z[0]=='+') ){
    i = 1;
  }
  for(; i<n; i++){
    if( !th_isdigit(z[i]) ){
      Th_ErrorMessage(interp, "expected integer, got: \"", z, n);
      return TH_ERROR;
    }
    iOut = iOut * 10 + (z[i] - 48);
  }

  if( n>0 && z[0]=='-' ){
    iOut *= -1;
  }

  *piOut = iOut;
  return TH_OK;
}

/*
** Try to convert the string passed as arguments (z, n) to a double.
** If successful, store the result in *pfOut and return TH_OK. 
**
** If the string cannot be converted to a double, return TH_ERROR. 
** If the interp argument is not NULL, leave an error message in the 
** interpreter result too.
*/
int Th_ToDouble(
  Th_Interp *interp, 
  const char *z, 
  int n, 
  double *pfOut
){
  if( !sqlite3IsNumber((const char *)z, 0) ){
    Th_ErrorMessage(interp, "expected number, got: \"", z, n);
    return TH_ERROR;
  }

  sqlite3AtoF((const char *)z, pfOut);
  return TH_OK;
}

/*
** Set the result of the interpreter to the th1 representation of
** the integer iVal and return TH_OK.
*/
int Th_SetResultInt(Th_Interp *interp, int iVal){
  int isNegative = 0;
  char zBuf[32];
  char *z = &zBuf[32];

  if( iVal<0 ){
    isNegative = 1;
    iVal = iVal * -1;
  }
  *(--z) = '\0';
  *(--z) = (char)(48+(iVal%10));
  while( (iVal = (iVal/10))>0 ){
    *(--z) = (char)(48+(iVal%10));
    assert(z>zBuf);
  }
  if( isNegative ){
    *(--z) = '-';
  }

  return Th_SetResult(interp, z, -1);
}

/*
** Set the result of the interpreter to the th1 representation of
** the double fVal and return TH_OK.
*/
int Th_SetResultDouble(Th_Interp *interp, double fVal){
  int i;                /* Iterator variable */
  double v = fVal;      /* Input value */
  char zBuf[128];      /* Output buffer */
  char *z = zBuf;      /* Output cursor */
  int iDot = 0;         /* Digit after which to place decimal point */
  int iExp = 0;         /* Exponent (NN in eNN) */
  const char *zExp;    /* String representation of iExp */

  /* Precision: */
  #define INSIGNIFICANT 0.000000000001
  #define ROUNDER       0.0000000000005
  double insignificant = INSIGNIFICANT;

  /* If the real value is negative, write a '-' character to the
   * output and transform v to the corresponding positive number.
   */ 
  if( v<0.0 ){
    *z++ = '-';
    v *= -1.0;
  }

  /* Normalize v to a value between 1.0 and 10.0. Integer 
   * variable iExp is set to the exponent. i.e the original
   * value is (v * 10^iExp) (or the negative thereof).
   */ 
  if( v>0.0 ){
    while( (v+ROUNDER)>=10.0 ) { iExp++; v *= 0.1; }
    while( (v+ROUNDER)<1.0 )   { iExp--; v *= 10.0; }
  }
  v += ROUNDER;

  /* For a small (<12) positive exponent, move the decimal point
   * instead of using the "eXX" notation.
   */
  if( iExp>0 && iExp<12 ){
    iDot = iExp;
    iExp = 0;
  }

  /* For a small (>-4) negative exponent, write leading zeroes
   * instead of using the "eXX" notation.
   */
  if( iExp<0 && iExp>-4 ){
    *z++ = '0';
    *z++ = '.';
    for(i=0; i>(iExp+1); i--){
      *z++ = '0';
    }
    iDot = -1;
    iExp = 0;
  }

  /* Output the digits in real value v. The value of iDot determines
   * where (if at all) the decimal point is placed.
   */
  for(i=0; i<=(iDot+1) || v>=insignificant; i++){
    *z++ = (char)(48 + (int)v);
    v = (v - ((double)(int)v)) * 10.0;
    insignificant *= 10.0;
    if( iDot==i ){
      *z++ = '.';
    }
  }

  /* If the exponent is not zero, add the "eXX" notation to the
   * end of the string.
   */
  if( iExp!=0 ){
    *z++ = 'e';
    Th_SetResultInt(interp, iExp);
    zExp = Th_GetResult(interp, 0);
    for(i=0; zExp[i]; i++){
      *z++ = zExp[i];
    }
  }

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

/* This header file defines the external interface to the custom Scripting
** Language (TH) interpreter.  TH is very similar to TCL but is not an
** exact clone.
*/

/*
** Before creating an interpreter, the application must allocate and
** populate an instance of the following structure. It must remain valid
** for the lifetime of the interpreter.
*/
struct Th_Vtab {
  void *(*xMalloc)(unsigned int);
  void (*xFree)(void *);
};
typedef struct Th_Vtab Th_Vtab;

/*
** Opaque handle for interpeter.
*/
typedef struct Th_Interp Th_Interp;

/* 
** Create and delete interpreters. 
*/
Th_Interp * Th_CreateInterp(Th_Vtab *pVtab);
void Th_DeleteInterp(Th_Interp *);

/* 
** Evaluate an TH program in the stack frame identified by parameter
** iFrame, according to the following rules:
**
**   * If iFrame is 0, this means the current frame.
**
**   * If iFrame is negative, then the nth frame up the stack, where n is 
**     the absolute value of iFrame. A value of -1 means the calling
**     procedure.
**
**   * If iFrame is +ve, then the nth frame from the bottom of the stack.
**     An iFrame value of 1 means the toplevel (global) frame.
*/
int Th_Eval(Th_Interp *interp, int iFrame, const char *zProg, int nProg);

/*
** Evaluate a TH expression. The result is stored in the 
** interpreter result.
*/
int Th_Expr(Th_Interp *interp, const char *, int);

/* 
** Access TH variables in the current stack frame. If the variable name
** begins with "::", the lookup is in the top level (global) frame. 
*/
int Th_GetVar(Th_Interp *, const char *, int);
int Th_SetVar(Th_Interp *, const char *, int, const char *, int);
int Th_LinkVar(Th_Interp *, const char *, int, int, const char *, int);
int Th_UnsetVar(Th_Interp *, const char *, int);

typedef int (*Th_CommandProc)(Th_Interp *, void *, int, const char **, int *);

/* 
** Register new commands. 
*/
int Th_CreateCommand(
  Th_Interp *interp, 
  const char *zName, 
  /* int (*xProc)(Th_Interp *, void *, int, const char **, int *), */
  Th_CommandProc xProc,
  void *pContext,
  void (*xDel)(Th_Interp *, void *)
);

/* 
** Delete or rename commands.
*/
int Th_RenameCommand(Th_Interp *, const char *, int, const char *, int);

/* 
** Push a new stack frame (local variable context) onto the interpreter 
** stack, call the function supplied as parameter xCall with the two 
** context arguments, 
**
**   xCall(interp, pContext1, pContext2)
**
** , then pop the frame off of the interpreter stack. The value returned
** by the xCall() function is returned as the result of this function.
**
** This is intended for use by the implementation of commands such as
** those created by [proc].
*/
int Th_InFrame(Th_Interp *interp,
  int (*xCall)(Th_Interp *, void *pContext1, void *pContext2),
  void *pContext1,
  void *pContext2
);

/* 
** Valid return codes for xProc callbacks.
*/
#define TH_OK       0
#define TH_ERROR    1
#define TH_BREAK    2
#define TH_RETURN   3
#define TH_CONTINUE 4

/* 
** Set and get the interpreter result. 
*/
int Th_SetResult(Th_Interp *, const char *, int);
const char *Th_GetResult(Th_Interp *, int *);
char *Th_TakeResult(Th_Interp *, int *);

/*
** Set an error message as the interpreter result. This also
** sets the global stack-trace variable $::th_stack_trace.
*/
int Th_ErrorMessage(Th_Interp *, const char *, const char *, int);

/* 
** Access the memory management functions associated with the specified
** interpreter.
*/
void *Th_Malloc(Th_Interp *, int);
void Th_Free(Th_Interp *, void *);

/* 
** Functions for handling TH lists.
*/
int Th_ListAppend(Th_Interp *, char **, int *, const char *, int);
int Th_SplitList(Th_Interp *, const char *, int, char ***, int **, int *);

int Th_StringAppend(Th_Interp *, char **, int *, const char *, int);

/* 
** 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);

/*
** 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);
int th_isspecial(char);
char *th_strdup(Th_Interp *interp, const char *z, int n);

/*
** Interfaces to register the language extensions.
*/
int th_register_language(Th_Interp *interp);            /* th_lang.c */
int th_register_sqlite(Th_Interp *interp);              /* th_sqlite.c */
int th_register_vfs(Th_Interp *interp);                 /* th_vfs.c */
int th_register_testvfs(Th_Interp *interp);             /* th_testvfs.c */
int th_register_tcl(Th_Interp *interp, void *pContext); /* th_tcl.c */

/*
** General purpose hash table from th_lang.c.
*/
typedef struct Th_Hash      Th_Hash;
typedef struct Th_HashEntry Th_HashEntry;
struct Th_HashEntry {
  void *pData;
  char *zKey;
  int nKey;
  Th_HashEntry *pNext;     /* Internal use only */
};
Th_Hash *Th_HashNew(Th_Interp *);
void Th_HashDelete(Th_Interp *, Th_Hash *);
void Th_HashIterate(Th_Interp*,Th_Hash*,void (*x)(Th_HashEntry*, void*),void*);
Th_HashEntry *Th_HashFind(Th_Interp*, Th_Hash*, const char*, int, int);

/*
** Useful functions from th_lang.c.
*/
int Th_WrongNumArgs(Th_Interp *interp, const char *zMsg);

typedef struct Th_SubCommand {char *zName; Th_CommandProc xProc;} Th_SubCommand;
int Th_CallSubCommand(Th_Interp*,void*,int,const char**,int*,Th_SubCommand*);

/*
** This file contains the implementation of all of the TH language 
** built-in commands. 
**
** All built-in commands are implemented using the public interface 
** declared in th.h, so this file serves as both a part of the language 
** implementation and an example of how to extend the language with
** new commands.
*/

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

int Th_WrongNumArgs(Th_Interp *interp, const char *zMsg){
  Th_ErrorMessage(interp, "wrong # args: should be \"", zMsg, -1);
  return TH_ERROR;
}

/*
** Syntax: 
**
**   catch script ?varname?
*/
static int catch_command(
  Th_Interp *interp, 
  void *ctx, 
  int argc, 
  const char **argv, 
  int *argl
){
  int rc;

  if( argc!=2 && argc!=3 ){
    return Th_WrongNumArgs(interp, "catch script ?varname?");
  }

  rc = Th_Eval(interp, 0, argv[1], -1);
  if( argc==3 ){
    int nResult;
    const char *zResult = Th_GetResult(interp, &nResult);
    Th_SetVar(interp, argv[2], argl[2], zResult, nResult);
  }

  Th_SetResultInt(interp, rc);
  return TH_OK;
}

/*
** TH Syntax: 
**
**   if expr1 body1 ?elseif expr2 body2? ? ?else? bodyN?
*/
static int if_command(
  Th_Interp *interp, 
  void *ctx, 
  int argc, 
  const char **argv, 
  int *argl
){
  int rc = TH_OK;

  int iCond;           /* Result of evaluating expression */
  int i;

  const char *zResult;
  int nResult;

  if( argc<3 ){
    goto wrong_args;
  }

  for(i=0; i<argc && rc==TH_OK; i+=3){
    if( i>argc-3 ){
      i = argc-3;
      iCond = 1;
    }else{
      if( TH_OK!=Th_Expr(interp, argv[i+1], argl[i+1]) ){
        return TH_ERROR;
      }
      zResult = Th_GetResult(interp, &nResult);
      rc = Th_ToInt(interp, zResult, nResult, &iCond);
    }
    if( iCond && rc==TH_OK ){
      rc = Th_Eval(interp, 0, argv[i+2], -1);
      break;
    }
  }

  return rc;

wrong_args:
  return Th_WrongNumArgs(interp, "if ...");
}

/*
** TH Syntax: 
**
**   expr expr
*/
static int expr_command(
  Th_Interp *interp, 
  void *ctx, 
  int argc, 
  const char **argv, 
  int *argl
){
  if( argc!=2 ){
    return Th_WrongNumArgs(interp, "expr expression");
  }

  return Th_Expr(interp, argv[1], argl[1]);
}

/*
** Evaluate the th1 script (zBody, nBody) in the local stack frame. 
** Return the result of the evaluation, except if the result
** is TH_CONTINUE, return TH_OK instead.
*/
static int eval_loopbody(Th_Interp *interp, const char *zBody, int nBody){
  int rc = Th_Eval(interp, 0, zBody, nBody);
  if( rc==TH_CONTINUE ){
    rc = TH_OK;
  }
  return rc;
}

/*
** TH Syntax: 
**
**   for init condition incr script
*/
static int for_command(
  Th_Interp *interp, 
  void *ctx, 
  int argc, 
  const char **argv, 
  int *argl
){
  int rc;
  int iCond;

  if( argc!=5 ){
    return Th_WrongNumArgs(interp, "for init condition incr script");
  }

  /* Evaluate the 'init' script */
  rc = Th_Eval(interp, 0, argv[1], -1);

  while( rc==TH_OK 
     && TH_OK==(rc = Th_Expr(interp, argv[2], -1))
     && TH_OK==(rc = Th_ToInt(interp, Th_GetResult(interp, 0), -1, &iCond))
     && iCond
     && TH_OK==(rc = eval_loopbody(interp, argv[4], argl[4]))
  ){
    rc = Th_Eval(interp, 0, argv[3], -1);
  }

  if( rc==TH_BREAK ) rc = TH_OK;
  return rc;
}

/*
** TH Syntax: 
**
**   list ?arg1 ?arg2? ...?
*/
static int list_command(
  Th_Interp *interp, 
  void *ctx, 
  int argc, 
  const char **argv, 
  int *argl
){
  char *zList = 0;
  int nList = 0;
  int i;

  for(i=1; i<argc; i++){
    Th_ListAppend(interp, &zList, &nList, argv[i], argl[i]);
  }
 
  Th_SetResult(interp, zList, nList);
  Th_Free(interp, zList);

  return TH_OK;
}

/*
** TH Syntax: 
**
**   lindex list index
*/
static int lindex_command(
  Th_Interp *interp, 
  void *ctx, 
  int argc, 
  const char **argv, 
  int *argl
){
  int iElem;
  int rc;

  char **azElem;
  int *anElem;
  int nCount;

  if( argc!=3 ){
    return Th_WrongNumArgs(interp, "lindex list index");
  }

  if( TH_OK!=Th_ToInt(interp, argv[2], argl[2], &iElem) ){
    return TH_ERROR;
  }

  rc = Th_SplitList(interp, argv[1], argl[1], &azElem, &anElem, &nCount);
  if( rc==TH_OK ){
    if( iElem<nCount && iElem>=0 ){
      Th_SetResult(interp, azElem[iElem], anElem[iElem]);
    }else{
      Th_SetResult(interp, 0, 0);
    }
    Th_Free(interp, azElem);
  }

  return rc;
}

/*
** TH Syntax: 
**
**   llength list
*/
static int llength_command(
  Th_Interp *interp, 
  void *ctx, 
  int argc, 
  const char **argv, 
  int *argl
){
  int nElem;
  int rc;

  if( argc!=2 ){
    return Th_WrongNumArgs(interp, "llength list");
  }

  rc = Th_SplitList(interp, argv[1], argl[1], 0, 0, &nElem);
  if( rc==TH_OK ){
    Th_SetResultInt(interp, nElem);
  }

  return rc;
}

/*
** TH Syntax: 
**
**   set varname ?value?
*/
static int set_command(
  Th_Interp *interp, 
  void *ctx, 
  int argc, 
  const char **argv, 
  int *argl
){
  if( argc!=2 && argc!=3 ){
    return Th_WrongNumArgs(interp, "set varname ?value?");
  }

  if( argc==3 ){
    Th_SetVar(interp, argv[1], argl[1], argv[2], argl[2]);
  }
  return Th_GetVar(interp, argv[1], argl[1]);
}

/*
** When a new command is created using the built-in [proc] command, an
** instance of the following structure is allocated and populated. A 
** pointer to the structure is passed as the context (second) argument 
** to function proc_call1() when the new command is executed.
*/
typedef struct ProcDefn ProcDefn;
struct ProcDefn {
  int nParam;                /* Number of formal (non "args") parameters */
  char **azParam;           /* Parameter names */
  int *anParam;              /* Lengths of parameter names */
  char **azDefault;         /* Default values */
  int *anDefault;            /* Lengths of default values */
  int hasArgs;               /* True if there is an "args" parameter */
  char *zProgram;           /* Body of proc */
  int nProgram;              /* Number of bytes at zProgram */
  char *zUsage;             /* Usage message */
  int nUsage;                /* Number of bytes at zUsage */
};

/* This structure is used to temporarily store arguments passed to an 
** invocation of a command created using [proc]. A pointer to an 
** instance is passed as the second argument to the proc_call2() function.
*/
typedef struct ProcArgs ProcArgs;
struct ProcArgs {
  int argc;
  const char **argv;
  int *argl;
};

/*
** Each time a command created using [proc] is invoked, a new
** th1 stack frame is allocated (for the proc's local variables) and
** this function invoked.
**
** Argument pContext1 points to the associated ProcDefn structure.
** Argument pContext2  points to a ProcArgs structure that contains
** the arguments passed to this specific invocation of the proc.
*/
static int proc_call2(Th_Interp *interp, void *pContext1, void *pContext2){
  int i;
  ProcDefn *p = (ProcDefn *)pContext1;
  ProcArgs *pArgs = (ProcArgs *)pContext2;

  /* Check if there are the right number of arguments. If there are
  ** not, generate a usage message for the command.
  */
  if( (pArgs->argc>(p->nParam+1) && !p->hasArgs) 
   || (pArgs->argc<=(p->nParam) && !p->azDefault[pArgs->argc-1])
  ){
    char *zUsage = 0;
    int nUsage = 0;
    Th_StringAppend(interp, &zUsage, &nUsage, pArgs->argv[0], pArgs->argl[0]);
    Th_StringAppend(interp, &zUsage, &nUsage, p->zUsage, p->nUsage);
    Th_StringAppend(interp, &zUsage, &nUsage, (const char *)"", 1);
    Th_WrongNumArgs(interp, zUsage);
    Th_Free(interp, zUsage);
    return TH_ERROR;
  }

  /* Populate the formal proc parameters. */
  for(i=0; i<p->nParam; i++){
    const char *zVal;
    int nVal;
    if( pArgs->argc>(i+1) ){
      zVal = pArgs->argv[i+1];
      nVal = pArgs->argl[i+1];
    }else{
      zVal = p->azDefault[i];
      nVal = p->anDefault[i];
    }
    Th_SetVar(interp, p->azParam[i], p->anParam[i], zVal, nVal);
  }

  /* Populate the "args" parameter, if it exists */
  if( p->hasArgs ){
    char *zArgs = 0;
    int nArgs = 0;
    for(i=p->nParam+1; i<pArgs->argc; i++){
      Th_ListAppend(interp, &zArgs, &nArgs, pArgs->argv[i], pArgs->argl[i]);
    }
    Th_SetVar(interp, (const char *)"args", -1, zArgs, nArgs);
  }

  Th_SetResult(interp, 0, 0);
  return Th_Eval(interp, 0, p->zProgram, p->nProgram);
}

/*
** This function is the command callback registered for all commands
** created using the [proc] command. The second argument, pContext,
** is a pointer to the associated ProcDefn structure.
*/
static int proc_call1(
  Th_Interp *interp,
  void *pContext, 
  int argc, 
  const char **argv,
  int *argl
){
  int rc;

  ProcDefn *p = (ProcDefn *)pContext;
  ProcArgs procargs;

  /* Call function proc_call2(), which will call Th_Eval() to evaluate
  ** the body of the [proc], in a new Th stack frame. This is so that
  ** the proc body has its own local variable context.
  */
  procargs.argc = argc;
  procargs.argv = argv;
  procargs.argl = argl;
  rc = Th_InFrame(interp, proc_call2, (void *)p, (void *)&procargs);

  if( rc==TH_RETURN ){
    rc = TH_OK;
  }
  return rc;
}

/*
** This function is registered as the delete callback for all commands 
** created using the built-in [proc] command. It is called automatically 
** when a command created using [proc] is deleted. 
**
** It frees the ProcDefn structure allocated when the command was created.
*/ 
static void proc_del(Th_Interp *interp, void *pContext){
  ProcDefn *p = (ProcDefn *)pContext;
  Th_Free(interp, (void *)p->zUsage);
  Th_Free(interp, (void *)p);
}

/*
** TH Syntax: 
**
**   proc name arglist code
*/
static int proc_command(
  Th_Interp *interp, 
  void *ctx, 
  int argc,
  const char **argv, 
  int *argl
){
  int rc;
  char *zName;

  ProcDefn *p;
  int nByte;
  int i;
  char *zSpace;

  char **azParam;
  int *anParam;
  int nParam;

  char *zUsage = 0;               /* Build up a usage message here */
  int nUsage = 0;                  /* Number of bytes at zUsage */

  if( argc!=4 ){
    return Th_WrongNumArgs(interp, "proc name arglist code");
  }
  if( Th_SplitList(interp, argv[2], argl[2], &azParam, &anParam, &nParam) ){
    return TH_ERROR;
  }

  /* Allocate the new ProcDefn structure. */
  nByte = sizeof(ProcDefn) +                        /* ProcDefn structure */
      (sizeof(char *) + sizeof(int)) * nParam +    /* azParam, anParam */
      (sizeof(char *) + sizeof(int)) * nParam +    /* azDefault, anDefault */
      argl[3] +                                     /* zProgram */
      argl[2];     /* Space for copies of parameter names and default values */
  p = (ProcDefn *)Th_Malloc(interp, nByte);

  /* If the last parameter in the parameter list is "args", then set the
  ** ProcDefn.hasArgs flag. The "args" parameter does not require an
  ** entry in the ProcDefn.azParam[] or ProcDefn.azDefault[] arrays.
  */
  if( anParam[nParam-1]==4 && 0==memcmp(azParam[nParam-1], "args", 4) ){
    p->hasArgs = 1;
    nParam--;
  }

  p->nParam    = nParam;
  p->azParam   = (char **)&p[1];
  p->anParam   = (int *)&p->azParam[nParam];
  p->azDefault = (char **)&p->anParam[nParam];
  p->anDefault = (int *)&p->azDefault[nParam];
  p->zProgram = (char *)&p->anDefault[nParam];
  memcpy(p->zProgram, argv[3], argl[3]);
  p->nProgram = argl[3];
  zSpace = &p->zProgram[p->nProgram];
  
  for(i=0; i<nParam; i++){
    char **az;
    int *an;
    int n;
    if( Th_SplitList(interp, azParam[i], anParam[i], &az, &an, &n) ){
      goto error_out;
    }
    if( n<1 || n>2 ){
      const char expected[] = "expected parameter, got \"";
      Th_ErrorMessage(interp, expected, azParam[i], anParam[i]);
      Th_Free(interp, az);
      goto error_out;
    }
    p->anParam[i] = an[0];
    p->azParam[i] = zSpace;
    memcpy(zSpace, az[0], an[0]);
    zSpace += an[0];
    if( n==2 ){
      p->anDefault[i] = an[1];
      p->azDefault[i] = zSpace;
      memcpy(zSpace, az[1], an[1]);
      zSpace += an[1];
    }

    Th_StringAppend(interp, &zUsage, &nUsage, (const char *)" ", 1);
    if( n==2 ){
      Th_StringAppend(interp, &zUsage, &nUsage, (const char *)"?", 1);
      Th_StringAppend(interp, &zUsage, &nUsage, az[0], an[0]);
      Th_StringAppend(interp, &zUsage, &nUsage, (const char *)"?", 1);
    }else{
      Th_StringAppend(interp, &zUsage, &nUsage, az[0], an[0]);
    }

    Th_Free(interp, az);
  }
  assert( zSpace-(char *)p<=nByte );

  /* If there is an "args" parameter, append it to the end of the usage
  ** message. Set ProcDefn.zUsage to point at the usage message. It will
  ** be freed along with the rest of the proc-definition by proc_del().
  */
  if( p->hasArgs ){
    Th_StringAppend(interp, &zUsage, &nUsage, (const char *)" ?args...?", -1);
  }
  p->zUsage = zUsage;
  p->nUsage = nUsage;

  /* Register the new command with the th1 interpreter. */
  zName = (char *)argv[1];
  rc = Th_CreateCommand(interp, zName, proc_call1, (void *)p, proc_del);
  if( rc==TH_OK ){
    Th_SetResult(interp, 0, 0);
  }

  Th_Free(interp, azParam);
  return TH_OK;

 error_out:
  Th_Free(interp, azParam);
  Th_Free(interp, zUsage);
  return TH_ERROR;
}

/*
** TH Syntax: 
**
**   rename oldcmd newcmd
*/
static int rename_command(
  Th_Interp *interp, 
  void *ctx, 
  int argc,
  const char **argv, 
  int *argl
){
  if( argc!=3 ){
    return Th_WrongNumArgs(interp, "rename oldcmd newcmd");
  }
  return Th_RenameCommand(interp, argv[1], argl[1], argv[2], argl[2]);
}

/*
** TH Syntax: 
**
**   break    ?value...?
**   continue ?value...?
**   ok       ?value...?
**   error    ?value...?
*/
static int simple_command(
  Th_Interp *interp, 
  void *ctx, 
  int argc, 
  const char **argv, 
  int *argl
){
  if( argc!=1 && argc!=2 ){
    return Th_WrongNumArgs(interp, "return ?value?");
  }
  if( argc==2 ){
    Th_SetResult(interp, argv[1], argl[1]);
  }
  return FOSSIL_PTR_TO_INT(ctx);
}

/*
** TH Syntax: 
**
**   return ?-code code? ?value?
*/
static int return_command(
  Th_Interp *interp, 
  void *ctx, 
  int argc, 
  const char **argv, 
  int *argl
){
  int iCode = TH_RETURN;
  if( argc<1 || argc>4 ){
    return Th_WrongNumArgs(interp, "return ?-code code? ?value?");
  }
  if( argc>2 ){
    int rc = Th_ToInt(interp, argv[2], argl[2], &iCode);
    if( rc!=TH_OK ){
      return rc;
    }
  }
  if( argc==2 || argc==4 ){
    Th_SetResult(interp, argv[argc-1], argl[argc-1]);
  }
  return iCode;
}

/*
** TH Syntax:
**
**   string compare STRING1 STRING2
*/
static int string_compare_command(
  Th_Interp *interp, void *ctx, int argc, const char **argv, int *argl
){
  const char *zRight; int nRight;
  const char *zLeft; int nLeft;

  int i;
  int iRes = 0;

  if( argc!=4 ){
    return Th_WrongNumArgs(interp, "string compare str1 str2");
  }

  zLeft = argv[2];
  nLeft = argl[2];
  zRight = argv[3];
  nRight = argl[3];

  for(i=0; iRes==0 && i<nLeft && i<nRight; i++){
    iRes = zLeft[i]-zRight[i];
  }
  if( iRes==0 ){
    iRes = nLeft-nRight;
  }

  if( iRes<0 ) iRes = -1;
  if( iRes>0 ) iRes = 1;
  
  return Th_SetResultInt(interp, iRes);
}

/*
** TH Syntax:
**
**   string first NEEDLE HAYSTACK
*/
static int string_first_command(
  Th_Interp *interp, void *ctx, int argc, const char **argv, int *argl
){
  const char *zNeedle;
  int nNeedle;
  const char *zHaystack;
  int nHaystack;
  int i;
  int iRes = -1;

  if( argc!=4 ){
    return Th_WrongNumArgs(interp, "string first needle haystack");
  }

  zNeedle = argv[2];
  nNeedle = argl[2];
  zHaystack = argv[3];
  nHaystack = argl[3];

  for(i=0; i<(nHaystack-nNeedle); i++){
    if( 0==memcmp(zNeedle, &zHaystack[i], nNeedle) ){
      iRes = i;
      break;
    }
  }
  
  return Th_SetResultInt(interp, iRes);
}

/*
** TH Syntax:
**
**   string is CLASS STRING
*/
static int string_is_command(
  Th_Interp *interp, void *ctx, int argc, const char **argv, int *argl
){
  int i;
  int iRes = 1;
  if( argc!=4 ){
    return Th_WrongNumArgs(interp, "string is class string");
  }
  if( argl[2]!=5 || 0!=memcmp(argv[2], "alnum", 5) ){
    Th_ErrorMessage(interp, "Expected alnum, got: ", argv[2], argl[2]);
    return TH_ERROR;
  }

  for(i=0; i<argl[3]; i++){
    if( !th_isalnum(argv[3][i]) ){
      iRes = 0;
    }
  }

  return Th_SetResultInt(interp, iRes);
}

/*
** TH Syntax:
**
**   string last NEEDLE HAYSTACK
*/
static int string_last_command(
  Th_Interp *interp, void *ctx, int argc, const char **argv, int *argl
){
  const char *zNeedle;
  int nNeedle;
  const char *zHaystack;
  int nHaystack;
  int i;
  int iRes = -1;

  if( argc!=4 ){
    return Th_WrongNumArgs(interp, "string first needle haystack");
  }

  zNeedle = argv[2];
  nNeedle = argl[2];
  zHaystack = argv[3];
  nHaystack = argl[3];

  for(i=nHaystack-nNeedle-1; i>=0; i--){
    if( 0==memcmp(zNeedle, &zHaystack[i], nNeedle) ){
      iRes = i;
      break;
    }
  }
  
  return Th_SetResultInt(interp, iRes);
}

/*
** TH Syntax:
**
**   string length STRING
*/
static int string_length_command(
  Th_Interp *interp, void *ctx, int argc, const char **argv, int *argl
){
  if( argc!=3 ){
    return Th_WrongNumArgs(interp, "string length string");
  }
  return Th_SetResultInt(interp, argl[2]);
}

/*
** TH Syntax:
**
**   string range STRING FIRST LAST
*/
static int string_range_command(
  Th_Interp *interp, void *ctx, int argc, const char **argv, int *argl
){
  int iStart;
  int iEnd;

  if( argc!=5 ){
    return Th_WrongNumArgs(interp, "string range string first last");
  }

  if( argl[4]==3 && 0==memcmp("end", argv[4], 3) ){
    iEnd = argl[2];
  }else if( Th_ToInt(interp, argv[4], argl[4], &iEnd) ){
    Th_ErrorMessage(
        interp, "Expected \"end\" or integer, got:", argv[4], argl[4]);
    return TH_ERROR;
  }
  if( Th_ToInt(interp, argv[3], argl[3], &iStart) ){
    return TH_ERROR;
  }

  if( iStart<0 ) iStart = 0;
  if( iEnd>=argl[2] ) iEnd = argl[2]-1;
  if( iStart>iEnd ) iEnd = iStart-1;

  return Th_SetResult(interp, &argv[2][iStart], iEnd-iStart+1);
}

/*
** TH Syntax:
**
**   string repeat STRING COUNT
*/
static int string_repeat_command(
  Th_Interp *interp, void *ctx, int argc, const char **argv, int *argl
){
  int n;
  int i;
  int nByte;
  char *zByte;

  if( argc!=4 ){
    return Th_WrongNumArgs(interp, "string repeat string n");
  }
  if( Th_ToInt(interp, argv[3], argl[3], &n) ){
    return TH_ERROR;
  }

  nByte = argl[2] * n;
  zByte = Th_Malloc(interp, nByte+1);
  for(i=0; i<nByte; i+=argl[2]){
    memcpy(&zByte[i], argv[2], argl[2]);
  }

  Th_SetResult(interp, zByte, nByte);
  Th_Free(interp, zByte);
  return TH_OK;
}

/*
** TH Syntax:
**
**   info exists VAR
*/
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_GetVar(interp, argv[2], argl[2]);
  Th_SetResultInt(interp, rc?0:1);
  return TH_OK;
}

/*
** TH Syntax:
**
**   unset VAR
*/
static int unset_command(
  Th_Interp *interp, 
  void *ctx,
  int argc,
  const char **argv,
  int *argl
){
  if( argc!=2 ){
    return Th_WrongNumArgs(interp, "unset var");
  }
  return Th_UnsetVar(interp, argv[1], argl[1]);
}

int Th_CallSubCommand(
  Th_Interp *interp, 
  void *ctx,
  int argc,
  const char **argv,
  int *argl,
  Th_SubCommand *aSub
){
  int i;
  for(i=0; aSub[i].zName; i++){
    char *zName = (char *)aSub[i].zName;
    if( th_strlen(zName)==argl[1] && 0==memcmp(zName, argv[1], argl[1]) ){
      return aSub[i].xProc(interp, ctx, argc, argv, argl);
    }
  }

  Th_ErrorMessage(interp, "Expected sub-command, got:", argv[1], argl[1]);
  return TH_ERROR;
}

/*
** TH Syntax:
**
**   string compare STR1 STR2
**   string first   NEEDLE HAYSTACK ?STARTINDEX?
**   string is      CLASS STRING
**   string last    NEEDLE HAYSTACK ?STARTINDEX?
**   string length  STRING
**   string range   STRING FIRST LAST
**   string repeat  STRING COUNT
*/
static int string_command(
  Th_Interp *interp, 
  void *ctx,
  int argc,
  const char **argv,
  int *argl
){
  Th_SubCommand aSub[] = {
    { "compare", string_compare_command },
    { "first",   string_first_command },
    { "is",      string_is_command },
    { "last",    string_last_command },
    { "length",  string_length_command },
    { "range",   string_range_command },
    { "repeat",  string_repeat_command },
    { 0, 0 }
  };
  return Th_CallSubCommand(interp, ctx, argc, argv, argl, aSub);
}

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

/*
** Convert the script level frame specification (used by the commands 
** [uplevel] and [upvar]) in (zFrame, nFrame) to an integer frame as 
** used by Th_LinkVar() and Th_Eval(). If successful, write the integer
** frame level to *piFrame and return TH_OK. Otherwise, return TH_ERROR
** and leave an error message in the interpreter result.
*/
static int thToFrame(
  Th_Interp *interp, 
  const char *zFrame, 
  int nFrame, 
  int *piFrame
){
  int iFrame;
  if( th_isdigit(zFrame[0]) ){
    int rc = Th_ToInt(interp, zFrame, nFrame, &iFrame);
    if( rc!=TH_OK ) return rc;
    iFrame = iFrame * -1;
  }else if( zFrame[0]=='#' ){
    int rc = Th_ToInt(interp, &zFrame[1], nFrame-1, &iFrame);
    if( rc!=TH_OK ) return rc;
    iFrame = iFrame + 1;
  }else{
    return TH_ERROR;
  }
  *piFrame = iFrame;
  return TH_OK;
}

/*
** TH Syntax:
**
**   uplevel ?LEVEL? SCRIPT
*/
static int uplevel_command(
  Th_Interp *interp, 
  void *ctx,
  int argc,
  const char **argv,
  int *argl
){
  int iFrame = -1;

  if( argc!=2 && argc!=3 ){
    return Th_WrongNumArgs(interp, "uplevel ?level? script...");
  }
  if( argc==3 && TH_OK!=thToFrame(interp, argv[1], argl[1], &iFrame) ){
    return TH_ERROR;
  }
  return Th_Eval(interp, iFrame, argv[argc-1], -1);
}

/*
** TH Syntax: 
**
**   upvar ?FRAME? OTHERVAR MYVAR ?OTHERVAR MYVAR ...?
*/
static int upvar_command(
  Th_Interp *interp, 
  void *ctx, 
  int argc, 
  const char **argv, 
  int *argl
){
  int iVar = 1;
  int iFrame = -1;
  int rc = TH_OK;
  int i;

  if( TH_OK==thToFrame(0, argv[1], argl[1], &iFrame) ){
    iVar++;
  }
  if( argc==iVar || (argc-iVar)%2 ){
    return Th_WrongNumArgs(interp, 
        "upvar frame othervar myvar ?othervar myvar...?");
  }
  for(i=iVar; rc==TH_OK && i<argc; i=i+2){
    rc = Th_LinkVar(interp, argv[i+1], argl[i+1], iFrame, argv[i], argl[i]);
  }
  return rc;
}

/*
** TH Syntax: 
**
**   breakpoint ARGS
**
** This command does nothing at all. Its purpose in life is to serve
** as a point for setting breakpoints in a debugger.
*/
static int breakpoint_command(
  Th_Interp *interp, 
  void *ctx, 
  int argc, 
  const char **argv, 
  int *argl
){
  int cnt = 0;
  cnt++;
  return TH_OK;
}

/*
** Register the built-in th1 language commands with interpreter interp.
** Usually this is called soon after interpreter creation.
*/
int th_register_language(Th_Interp *interp){
  /* Array of built-in commands. */
  struct _Command {
    const char *zName;
    Th_CommandProc xProc;
    void *pContext;
  } aCommand[] = {
    {"catch",    catch_command,   0},
    {"expr",     expr_command,    0},
    {"for",      for_command,     0},
    {"if",       if_command,      0},
    {"info",     info_command,    0},
    {"lindex",   lindex_command,  0},
    {"list",     list_command,    0},
    {"llength",  llength_command, 0},
    {"proc",     proc_command,    0}, 
    {"rename",   rename_command,  0},
    {"set",      set_command,     0},
    {"string",   string_command,  0},
    {"unset",    unset_command,   0},
    {"uplevel",  uplevel_command, 0},
    {"upvar",    upvar_command,   0},

    {"breakpoint", breakpoint_command, 0},

    {"return",   return_command, 0},
    {"break",    simple_command, (void *)TH_BREAK}, 
    {"continue", simple_command, (void *)TH_CONTINUE}, 
    {"error",    simple_command, (void *)TH_ERROR}, 

    {0, 0, 0}
  };
  int i;

  /* Add the language commands. */
  for(i=0; i<(sizeof(aCommand)/sizeof(aCommand[0])); i++){
    void *ctx;
    if ( !aCommand[i].zName || !aCommand[i].xProc ) continue;
    ctx = aCommand[i].pContext;
    Th_CreateCommand(interp, aCommand[i].zName, aCommand[i].xProc, ctx, 0);
  }

  return TH_OK;
}

** This file contains an interface between the TH scripting language
** (an independent project) and fossil.
*/
#include "config.h"
#include "th_main.h"

/*
** Global variable counting the number of outstanding calls to malloc()
** made by the th1 implementation. This is used to catch memory leaks
** in the interpreter. Obviously, it also means th1 is not threadsafe.
*/
static int nOutstandingMalloc = 0;

/*
** Implementations of malloc() and free() to pass to the interpreter.
*/
static void *xMalloc(unsigned int n){
  void *p = fossil_malloc(n);
  if( p ){
    nOutstandingMalloc++;
  }
  return p;
}
static void xFree(void *p){
  if( p ){
    nOutstandingMalloc--;
  }
  free(p);
}
static Th_Vtab vtab = { xMalloc, xFree };

/*
** Generate a TH1 trace message if debugging is enabled.
*/
void Th_Trace(const char *zFormat, ...){
  va_list ap;
  va_start(ap, zFormat);
  blob_vappendf(&g.thLog, zFormat, ap);
  va_end(ap);
}


/*
** True if output is enabled.  False if disabled.
*/
static int enableOutput = 1;

/*
** TH command:     enable_output BOOLEAN
**
** Enable or disable the puts and hputs commands.
*/
static int enableOutputCmd(
  Th_Interp *interp, 
  void *p, 
  int argc, 
  const char **argv, 
  int *argl
){

  if( argc!=2 ){
    return Th_WrongNumArgs(interp, "enable_output BOOLEAN");

  }
  return Th_ToInt(interp, argv[1], argl[1], &enableOutput);
}

/*
** Send text to the appropriate output:  Either to the console
** or to the CGI reply buffer.
*/
static void sendText(const char *z, int n, int encode){

    }else{
      fwrite(z, 1, n, stdout);
      fflush(stdout);
    }
    if( encode ) free((char*)z);
  }
}






/*
** TH command:     puts STRING
** TH command:     html STRING
**
** Output STRING as HTML (html) or unchanged (puts).  
*/
static int putsCmd(
  Th_Interp *interp, 
  void *pConvert, 

  int argc, 
  const char **argv, 


  int *argl


){







  if( argc!=2 ){
    return Th_WrongNumArgs(interp, "puts STRING");

  }
  sendText((char*)argv[1], argl[1], pConvert!=0);
  return TH_OK;
}

/*
** TH command:      wiki STRING
**
** Render the input string as wiki.
*/
static int wikiCmd(
  Th_Interp *interp, 
  void *p, 
  int argc, 
  const char **argv, 
  int *argl
){

  if( argc!=2 ){
    return Th_WrongNumArgs(interp, "wiki STRING");

  }
  if( enableOutput ){
    Blob src;
    blob_init(&src, (char*)argv[1], argl[1]);
    wiki_convert(&src, 0, WIKI_INLINE);
    blob_reset(&src);
  }
  return TH_OK;
}

/*
** TH command:      htmlize STRING
**
** Escape all characters of STRING which have special meaning in HTML.
** Return a new string result.
*/
static int htmlizeCmd(
  Th_Interp *interp, 
  void *p, 
  int argc, 
  const char **argv, 
  int *argl
){

  char *zOut;
  if( argc!=2 ){
    return Th_WrongNumArgs(interp, "htmlize STRING");

  }
  zOut = htmlize((char*)argv[1], argl[1]);
  Th_SetResult(interp, zOut, -1);
  free(zOut);
  return TH_OK;
}

/*
** TH command:      date
**
** Return a string which is the current time and date.  If the
** -local option is used, the date appears using localtime instead
** of UTC.
*/
static int dateCmd(
  Th_Interp *interp, 
  void *p, 
  int argc, 
  const char **argv, 
  int *argl
){

  char *zOut;
  if( argc>=2 && argl[1]==6 && memcmp(argv[1],"-local",6)==0 ){
    zOut = db_text("??", "SELECT datetime('now','localtime')");
  }else{
    zOut = db_text("??", "SELECT datetime('now')");
  }
  Th_SetResult(interp, zOut, -1);
  free(zOut);
  return TH_OK;
}

/*
** TH command:     hascap STRING
**
** Return true if the user has all of the capabilities listed in STRING.
*/
static int hascapCmd(
  Th_Interp *interp, 
  void *p, 

  int argc, 
  const char **argv, 
  int *argl
){
  int rc;
  if( argc!=2 ){
    return Th_WrongNumArgs(interp, "hascap STRING");

  }

  rc = login_has_capability((char*)argv[1],argl[1]);
  if( g.thTrace ){
    Th_Trace("[hascap %#h] => %d<br />\n", argl[1], argv[1], rc);
  }
  Th_SetResultInt(interp, rc);
  return TH_OK;
}

/*
** TH command:     anycap STRING
**
** Return true if the user has any one of the capabilities listed in STRING.
*/
static int anycapCmd(

  Th_Interp *interp, 
  void *p, 
  int argc, 
  const char **argv, 
  int *argl
){
  int rc = 0;
  int i;
  if( argc!=2 ){
    return Th_WrongNumArgs(interp, "anycap STRING");

  }

  for(i=0; rc==0 && i<argl[1]; i++){
    rc = login_has_capability((char*)&argv[1][i],1);
  }
  if( g.thTrace ){
    Th_Trace("[hascap %#h] => %d<br />\n", argl[1], argv[1], rc);
  }
  Th_SetResultInt(interp, rc);
  return TH_OK;
}

/*
** TH1 command:  combobox NAME TEXT-LIST NUMLINES
**
** Generate an HTML combobox.  NAME is both the name of the
** CGI parameter and the name of a variable that contains the
** currently selected value.  TEXT-LIST is a list of possible
** values for the combobox.  NUMLINES is 1 for a true combobox.
** If NUMLINES is greater than one then the display is a listbox
** with the number of lines given.
*/
static int comboboxCmd(
  Th_Interp *interp,
  void *p, 
  int argc, 
  const char **argv, 
  int *argl
){

  if( argc!=4 ){
    return Th_WrongNumArgs(interp, "combobox NAME TEXT-LIST NUMLINES");

  }
  if( enableOutput ){
    int height;
    Blob name;
    int nValue;
    const char *zValue;
    char *z, *zH;
    int nElem;
    int *aszElem;
    char **azElem;
    int i;



    if( Th_ToInt(interp, argv[3], argl[3], &height) ) return TH_ERROR;
    Th_SplitList(interp, argv[2], argl[2], &azElem, &aszElem, &nElem);
    blob_init(&name, (char*)argv[1], argl[1]);
    zValue = Th_Fetch(blob_str(&name), &nValue);

    z = mprintf("<select name=\"%z\" size=\"%d\">", 
                 htmlize(blob_buffer(&name), blob_size(&name)), height);
    sendText(z, -1, 0);
    free(z);
    blob_reset(&name);
    for(i=0; i<nElem; i++){

      zH = htmlize((char*)azElem[i], aszElem[i]);
      if( zValue && aszElem[i]==nValue 
             && memcmp(zValue, azElem[i], nValue)==0 ){

        z = mprintf("<option value=\"%s\" selected=\"selected\">%s</option>",
                     zH, zH);
      }else{
        z = mprintf("<option value=\"%s\">%s</option>", zH, zH);
      }
      free(zH);
      sendText(z, -1, 0);
      free(z);
    }
    sendText("</select>", -1, 0);
    Th_Free(interp, azElem);
  }
  return TH_OK;
}

/*
** TH1 command:     linecount STRING MAX MIN
**
** Return one more than the number of \n characters in STRING.  But
** never return less than MIN or more than MAX.
*/
static int linecntCmd(
  Th_Interp *interp,
  void *p, 
  int argc, 
  const char **argv, 
  int *argl
){

  const char *z;
  int size, n, i;
  int iMin, iMax;
  if( argc!=4 ){
    return Th_WrongNumArgs(interp, "linecount STRING MAX MIN");

  }
  if( Th_ToInt(interp, argv[2], argl[2], &iMax) ) return TH_ERROR;
  if( Th_ToInt(interp, argv[3], argl[3], &iMin) ) return TH_ERROR;
  z = argv[1];
  size = argl[1];
  for(n=1, i=0; i<size; i++){
    if( z[i]=='\n' ){
      n++;
      if( n>=iMax ) break;
    }
  }
  if( n<iMin ) n = iMin;
  if( n>iMax ) n = iMax;
  Th_SetResultInt(interp, n);
  return TH_OK;
}

/*
** TH1 command:     repository ?BOOLEAN?
**
** Return the fully qualified file name of the open repository or an empty
** string if one is not currently open.  Optionally, it will attempt to open
** the repository if the boolean argument is non-zero.
*/
static int repositoryCmd(
  Th_Interp *interp,
  void *p, 
  int argc, 
  const char **argv, 
  int *argl
){

  int openRepository;

  if( argc!=1 && argc!=2 ){
    return Th_WrongNumArgs(interp, "repository ?BOOLEAN?");

  }
  if( argc==2 ){
    if( Th_ToInt(interp, argv[1], argl[1], &openRepository) ){
      return TH_ERROR;
    }
    if( openRepository ) db_find_and_open_repository(OPEN_OK_NOT_FOUND, 0);
  }
  Th_SetResult(interp, g.zRepositoryName, -1);
  return TH_OK;
}

/*
** Make sure the interpreter has been initialized.  Initialize it if
** it has not been already.
**
** The interpreter is stored in the g.interp global variable.
*/
void Th_FossilInit(void){
  static struct _Command {
    const char *zName;
    Th_CommandProc xProc;
    void *pContext;
  } aCommand[] = {
    {"anycap",        anycapCmd,            0},
    {"combobox",      comboboxCmd,          0},
    {"enable_output", enableOutputCmd,      0},
    {"linecount",     linecntCmd,           0},
    {"hascap",        hascapCmd,            0},
    {"htmlize",       htmlizeCmd,           0},
    {"date",          dateCmd,              0},
    {"html",          putsCmd,              0},
    {"puts",          putsCmd,       (void*)1},
    {"wiki",          wikiCmd,              0},
    {"repository",    repositoryCmd,        0},
    {0, 0, 0}
  };
  if( g.interp==0 ){
    int i;

    g.interp = Th_CreateInterp(&vtab);

    th_register_language(g.interp);       /* Basic scripting commands. */



#ifdef FOSSIL_ENABLE_TCL
    if( getenv("TH1_ENABLE_TCL")!=0 || db_get_boolean("tcl", 0) ){
      th_register_tcl(g.interp, &g.tcl);  /* Tcl integration commands. */
    }
#endif
    for(i=0; i<sizeof(aCommand)/sizeof(aCommand[0]); i++){
      if ( !aCommand[i].zName || !aCommand[i].xProc ) continue;
      Th_CreateCommand(g.interp, aCommand[i].zName, aCommand[i].xProc,
                       aCommand[i].pContext, 0);
    }
  }
}

/*
** Store a string value in a variable in the interpreter.
*/
void Th_Store(const char *zName, const char *zValue){
  Th_FossilInit();
  if( zValue ){
    if( g.thTrace ){
      Th_Trace("set %h {%h}<br />\n", zName, zValue);
    }
    Th_SetVar(g.interp, zName, -1, zValue, strlen(zValue));
  }
}

/*
** Unset a variable.
*/
void Th_Unstore(const char *zName){
  if( g.interp ){


    Th_UnsetVar(g.interp, (char*)zName, -1);
  }
}

/*
** Retrieve a string value from the interpreter.  If no such
** variable exists, return NULL.
*/
char *Th_Fetch(const char *zName, int *pSize){

  int rc;
  Th_FossilInit();
  rc = Th_GetVar(g.interp, (char*)zName, -1);

  if( rc==TH_OK ){
    return (char*)Th_GetResult(g.interp, pSize);

  }else{






    return 0;




  }

}

/*
** Return true if the string begins with the TH1 begin-script
** tag:  <th1>.
*/
static int isBeginScriptTag(const char *z){

  return z[0]=='<'
      && (z[1]=='t' || z[1]=='T')
      && (z[2]=='h' || z[2]=='H')
      && z[3]=='1'
      && z[4]=='>';
}

/*
** Return true if the string begins with the TH1 end-script
** tag:  </th1>.
*/
static int isEndScriptTag(const char *z){

  return z[0]=='<'
      && z[1]=='/'
      && (z[2]=='t' || z[2]=='T')
      && (z[3]=='h' || z[3]=='H')
      && z[4]=='1'
      && z[5]=='>';
}

**
** This routine processes the template and writes the results
** on either stdout or into CGI.
*/
int Th_Render(const char *z){
  int i = 0;
  int n;
  int rc = TH_OK;
  char *zResult;
  Th_FossilInit();
  while( z[i] ){
    if( z[i]=='$' && (n = validVarName(&z[i+1]))>0 ){
      const char *zVar;
      int nVar;
      int encode = 1;
      sendText(z, i, 0);
      if( z[i+1]=='<' ){
        /* Variables of the form $<aaa> are html escaped */
        zVar = &z[i+2];
        nVar = n-2;
      }else{
        /* Variables of the form $aaa are output raw */
        zVar = &z[i+1];
        nVar = n;
        encode = 0;
      }
      rc = Th_GetVar(g.interp, (char*)zVar, nVar);
      z += i+1+n;
      i = 0;
      zResult = (char*)Th_GetResult(g.interp, &n);
      sendText((char*)zResult, n, encode);

    }else if( z[i]=='<' && isBeginScriptTag(&z[i]) ){

      sendText(z, i, 0);
      z += i+5;
      for(i=0; z[i] && (z[i]!='<' || !isEndScriptTag(&z[i])); i++){}


      rc = Th_Eval(g.interp, 0, (const char*)z, i);
      if( rc!=TH_OK ) break;
      z += i;
      if( z[0] ){ z += 6; }
      i = 0;
    }else{
      i++;
    }
  }
  if( rc==TH_ERROR ){
    sendText("<hr><p class=\"thmainError\">ERROR: ", -1, 0);
    zResult = (char*)Th_GetResult(g.interp, &n);
    sendText((char*)zResult, n, 1);
    sendText("</p>", -1, 0);
  }else{
    sendText(z, i, 0);
  }
  return rc;
}

/*
** COMMAND: test-th-render
*/
void test_th_render(void){
  Blob in;
  if( g.argc<3 ){
    usage("FILE");
  }
  db_open_config(0); /* Needed for global "tcl" setting. */
  blob_zero(&in);
  blob_read_from_file(&in, g.argv[2]);
  Th_Render(blob_str(&in));
}

/*
** This program is free software; you can redistribute it and/or
** modify it under the terms of the Simplified BSD License (also
** known as the "2-Clause License" or "FreeBSD License".)
**
** This program is distributed in the hope that it will be useful,
** but without any warranty; without even the implied warranty of
** merchantability or fitness for a particular purpose.
**
*******************************************************************************
** This file contains code used to bridge the TH1 and Tcl scripting languages.
*/

#include "config.h"

#ifdef FOSSIL_ENABLE_TCL

#include "th.h"
#include "tcl.h"

/*
** Are we being compiled against Tcl 8.6 or higher?
 */
#if (TCL_MAJOR_VERSION > 8) || \
    ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 6))
/*
** Workaround NRE-specific issue in Tcl_EvalObjCmd (SF bug #3399564) by using
** Tcl_EvalObjv instead of invoking the objProc directly.
 */
#define USE_TCL_EVALOBJV   1
#endif

/*
** These macros are designed to reduce the redundant code required to marshal
** arguments from TH1 to Tcl.
 */
#define USE_ARGV_TO_OBJV() \
  int objc;                \
  Tcl_Obj **objv;          \
  int i;

#define COPY_ARGV_TO_OBJV()                                         \
  objc = argc-1;                                                    \
  objv = (Tcl_Obj **)ckalloc((unsigned)(objc * sizeof(Tcl_Obj *))); \
  for(i=1; i<argc; i++){                                            \
    objv[i-1] = Tcl_NewStringObj(argv[i], argl[i]);                 \
    Tcl_IncrRefCount(objv[i-1]);                                    \
  }

#define FREE_ARGV_TO_OBJV()      \
  for(i=1; i<argc; i++){         \
    Tcl_DecrRefCount(objv[i-1]); \
  }                              \
  ckfree((char *)objv);

/*
** Fetch the Tcl interpreter from the specified void pointer, cast to a Tcl
** context.
 */
#define GET_CTX_TCL_INTERP(ctx) \
  ((struct TclContext *)(ctx))->interp

/*
** Creates and initializes a Tcl interpreter for use with the specified TH1
** interpreter.  Stores the created Tcl interpreter in the Tcl context supplied
** by the caller.  This must be declared here because quite a few functions in
** this file need to use it before it can be defined.
 */
static int createTclInterp(Th_Interp *interp, void *pContext);

/*
** Returns the Tcl interpreter result as a string with the associated length.
** If the Tcl interpreter or the Tcl result are NULL, the length will be 0.
** If the length pointer is NULL, the length will not be stored.
 */
static char *getTclResult(

    if( pN ) *pN = 0;
    return 0;
  }
  return Tcl_GetStringFromObj(resultPtr, pN);
}

/*
** Tcl context information used by TH1.  This structure definition has been
** copied from and should be kept in sync with the one in "main.c".
*/
struct TclContext {
  int argc;
  char **argv;
  Tcl_Interp *interp;
};

/*
** Syntax:
**
**   tclEval arg ?arg ...?
*/
static int tclEval_command(
  Th_Interp *interp,
  void *ctx,
  int argc,
  const char **argv,
  int *argl
){
  Tcl_Interp *tclInterp;
  Tcl_Obj *objPtr;
  int rc;
  int nResult;
  const char *zResult;


  if ( createTclInterp(interp, ctx)!=TH_OK ){
    return TH_ERROR;
  }
  if( argc<2 ){
    return Th_WrongNumArgs(interp, "tclEval arg ?arg ...?");

  }
  tclInterp = GET_CTX_TCL_INTERP(ctx);
  if( !tclInterp || Tcl_InterpDeleted(tclInterp) ){
    Th_ErrorMessage(interp, "invalid Tcl interpreter", (const char *)"", 0);
    return TH_ERROR;
  }
  Tcl_Preserve((ClientData)tclInterp);
  if( argc==2 ){
    objPtr = Tcl_NewStringObj(argv[1], argl[1]);
    Tcl_IncrRefCount(objPtr);
    rc = Tcl_EvalObjEx(tclInterp, objPtr, 0);
    Tcl_DecrRefCount(objPtr);
  }else{
    USE_ARGV_TO_OBJV();
    COPY_ARGV_TO_OBJV();
    objPtr = Tcl_ConcatObj(objc, objv);
    Tcl_IncrRefCount(objPtr);
    rc = Tcl_EvalObjEx(tclInterp, objPtr, 0);
    Tcl_DecrRefCount(objPtr);
    FREE_ARGV_TO_OBJV();
  }
  zResult = getTclResult(tclInterp, &nResult);
  Th_SetResult(interp, zResult, nResult);
  Tcl_Release((ClientData)tclInterp);
  return rc;
}

/*
** Syntax:
**
**   tclExpr arg ?arg ...?
*/
static int tclExpr_command(
  Th_Interp *interp,
  void *ctx,
  int argc,
  const char **argv,
  int *argl
){
  Tcl_Interp *tclInterp;
  Tcl_Obj *objPtr;
  Tcl_Obj *resultObjPtr;
  int rc;
  int nResult;
  const char *zResult;


  if ( createTclInterp(interp, ctx)!=TH_OK ){
    return TH_ERROR;
  }
  if( argc<2 ){
    return Th_WrongNumArgs(interp, "tclExpr arg ?arg ...?");

  }
  tclInterp = GET_CTX_TCL_INTERP(ctx);
  if( !tclInterp || Tcl_InterpDeleted(tclInterp) ){
    Th_ErrorMessage(interp, "invalid Tcl interpreter", (const char *)"", 0);
    return TH_ERROR;
  }
  Tcl_Preserve((ClientData)tclInterp);
  if( argc==2 ){
    objPtr = Tcl_NewStringObj(argv[1], argl[1]);
    Tcl_IncrRefCount(objPtr);
    rc = Tcl_ExprObj(tclInterp, objPtr, &resultObjPtr);
    Tcl_DecrRefCount(objPtr);
  }else{
    USE_ARGV_TO_OBJV();
    COPY_ARGV_TO_OBJV();
    objPtr = Tcl_ConcatObj(objc, objv);
    Tcl_IncrRefCount(objPtr);
    rc = Tcl_ExprObj(tclInterp, objPtr, &resultObjPtr);
    Tcl_DecrRefCount(objPtr);
    FREE_ARGV_TO_OBJV();
  }
  if( rc==TCL_OK ){
    zResult = Tcl_GetStringFromObj(resultObjPtr, &nResult);
  }else{
    zResult = getTclResult(tclInterp, &nResult);
  }
  Th_SetResult(interp, zResult, nResult);
  if( rc==TCL_OK ) Tcl_DecrRefCount(resultObjPtr);
  Tcl_Release((ClientData)tclInterp);
  return rc;
}

/*
** Syntax:
**
**   tclInvoke command ?arg ...?
*/
static int tclInvoke_command(
  Th_Interp *interp,
  void *ctx,
  int argc,
  const char **argv,
  int *argl
){
  Tcl_Interp *tclInterp;
#ifndef USE_TCL_EVALOBJV
  Tcl_Command command;
  Tcl_CmdInfo cmdInfo;
#endif
  int rc;
  int nResult;
  const char *zResult;

#ifndef USE_TCL_EVALOBJV
  Tcl_Obj *objPtr;
#endif
  USE_ARGV_TO_OBJV();

  if ( createTclInterp(interp, ctx)!=TH_OK ){
    return TH_ERROR;
  }
  if( argc<2 ){
    return Th_WrongNumArgs(interp, "tclInvoke command ?arg ...?");

  }
  tclInterp = GET_CTX_TCL_INTERP(ctx);
  if( !tclInterp || Tcl_InterpDeleted(tclInterp) ){
    Th_ErrorMessage(interp, "invalid Tcl interpreter", (const char *)"", 0);
    return TH_ERROR;
  }
  Tcl_Preserve((ClientData)tclInterp);
#ifndef USE_TCL_EVALOBJV
  objPtr = Tcl_NewStringObj(argv[1], argl[1]);
  Tcl_IncrRefCount(objPtr);
  command = Tcl_GetCommandFromObj(tclInterp, objPtr);
  if( !command || Tcl_GetCommandInfoFromToken(command,&cmdInfo)==0 ){
    Th_ErrorMessage(interp, "Tcl command not found:", argv[1], argl[1]);
    Tcl_DecrRefCount(objPtr);
    Tcl_Release((ClientData)tclInterp);
    return TH_ERROR;
  }
  if( !cmdInfo.objProc ){
    Th_ErrorMessage(interp, "Cannot invoke Tcl command:", argv[1], argl[1]);

    Tcl_DecrRefCount(objPtr);
    Tcl_Release((ClientData)tclInterp);
    return TH_ERROR;
  }
  Tcl_DecrRefCount(objPtr);
#endif
  COPY_ARGV_TO_OBJV();
#ifdef USE_TCL_EVALOBJV
  rc = Tcl_EvalObjv(tclInterp, objc, objv, 0);
#else
  Tcl_ResetResult(tclInterp);
  rc = cmdInfo.objProc(cmdInfo.objClientData, tclInterp, objc, objv);
#endif
  FREE_ARGV_TO_OBJV();
  zResult = getTclResult(tclInterp, &nResult);
  Th_SetResult(interp, zResult, nResult);
  Tcl_Release((ClientData)tclInterp);
  return rc;
}

/*
** Syntax:
**
**   th1Eval arg
*/
static int Th1EvalObjCmd(
  ClientData clientData,
  Tcl_Interp *interp,
  int objc,
  Tcl_Obj *CONST objv[]
){
  Th_Interp *th1Interp;
  int nArg;
  const char *arg;
  int rc;



  if( objc!=2 ){
    Tcl_WrongNumArgs(interp, 1, objv, "arg");
    return TCL_ERROR;
  }
  th1Interp = (Th_Interp *)clientData;
  if( !th1Interp ){
    Tcl_AppendResult(interp, "invalid TH1 interpreter", NULL);
    return TCL_ERROR;
  }
  arg = Tcl_GetStringFromObj(objv[1], &nArg);
  rc = Th_Eval(th1Interp, 0, arg, nArg);



  arg = Th_GetResult(th1Interp, &nArg);

  Tcl_SetObjResult(interp, Tcl_NewStringObj(arg, nArg));
  return rc;
}

/*
** Syntax:
**
**   th1Expr arg
*/
static int Th1ExprObjCmd(
  ClientData clientData,
  Tcl_Interp *interp,
  int objc,
  Tcl_Obj *CONST objv[]
){
  Th_Interp *th1Interp;
  int nArg;
  const char *arg;
  int rc;



  if( objc!=2 ){
    Tcl_WrongNumArgs(interp, 1, objv, "arg");
    return TCL_ERROR;
  }
  th1Interp = (Th_Interp *)clientData;
  if( !th1Interp ){
    Tcl_AppendResult(interp, "invalid TH1 interpreter", NULL);
    return TCL_ERROR;
  }
  arg = Tcl_GetStringFromObj(objv[1], &nArg);
  rc = Th_Expr(th1Interp, arg, nArg);




  arg = Th_GetResult(th1Interp, &nArg);
  Tcl_SetObjResult(interp, Tcl_NewStringObj(arg, nArg));

  return rc;
}

/*
** Array of Tcl integration commands.  Used when adding or removing the Tcl
** integration commands from TH1.
*/
static struct _Command {
  const char *zName;
  Th_CommandProc xProc;
  void *pContext;
} aCommand[] = {
  {"tclEval",   tclEval_command,   0},
  {"tclExpr",   tclExpr_command,   0},
  {"tclInvoke", tclInvoke_command, 0},
  {0, 0, 0}
};

/*
** Called if the Tcl interpreter is deleted.  Removes the Tcl integration
** commands from the TH1 interpreter.
 */
static void Th1DeleteProc(
  ClientData clientData,
  Tcl_Interp *interp
){
  int i;
  Th_Interp *th1Interp = (Th_Interp *)clientData;
  if( !th1Interp ) return;
  /* Remove the Tcl integration commands. */
  for(i=0; i<(sizeof(aCommand)/sizeof(aCommand[0])); i++){
    Th_RenameCommand(th1Interp, aCommand[i].zName, -1, NULL, 0);
  }
}

/*
** Creates and initializes a Tcl interpreter for use with the specified TH1
** interpreter.  Stores the created Tcl interpreter in the Tcl context supplied
** by the caller.
 */
static int createTclInterp(
  Th_Interp *interp,
  void *pContext
){
  struct TclContext *tclContext = (struct TclContext *)pContext;
  Tcl_Interp *tclInterp;

  if ( !tclContext ){
    Th_ErrorMessage(interp,
        "Invalid Tcl context", (const char *)"", 0);
    return TH_ERROR;
  }
  if ( tclContext->interp ){
    return TH_OK;
  }
  if ( tclContext->argc>0 && tclContext->argv ) {
    Tcl_FindExecutable(tclContext->argv[0]);
  }
  tclInterp = tclContext->interp = Tcl_CreateInterp();
  if( !tclInterp || Tcl_InterpDeleted(tclInterp) ){
    Th_ErrorMessage(interp,
        "Could not create Tcl interpreter", (const char *)"", 0);
    return TH_ERROR;
  }
  if( Tcl_Init(tclInterp)!=TCL_OK ){
    Th_ErrorMessage(interp,
        "Tcl initialization error:", Tcl_GetStringResult(tclInterp), -1);
    Tcl_DeleteInterp(tclInterp);
    tclContext->interp = tclInterp = 0;
    return TH_ERROR;
  }
  /* Add the TH1 integration commands to Tcl. */
  Tcl_CallWhenDeleted(tclInterp, Th1DeleteProc, interp);
  Tcl_CreateObjCommand(tclInterp, "th1Eval", Th1EvalObjCmd, interp, NULL);
  Tcl_CreateObjCommand(tclInterp, "th1Expr", Th1ExprObjCmd, interp, NULL);
  return TH_OK;
}

/*
** Register the Tcl language commands with interpreter interp.
** Usually this is called soon after interpreter creation.
*/
int th_register_tcl(
  Th_Interp *interp,
  void *pContext
){
  int i;
  /* Add the Tcl integration commands to TH1. */
  for(i=0; i<(sizeof(aCommand)/sizeof(aCommand[0])); i++){
    void *ctx;
    if ( !aCommand[i].zName || !aCommand[i].xProc ) continue;
    ctx = aCommand[i].pContext;
    /* Use Tcl interpreter for context? */
    if( !ctx ) ctx = pContext;
    Th_CreateCommand(interp, aCommand[i].zName, aCommand[i].xProc, ctx, 0);
  }
  return TH_OK;
}

#endif /* FOSSIL_ENABLE_TCL */

** using the CONCEALED table so that the content legable.
** Otherwise, db_reveal() is a no-op and the content remains
** obscured.
*/
static void initializeVariablesFromDb(void){
  const char *zName;
  Stmt q;
  int i, n, size, j;

  zName = PD("name","-none-");
  db_prepare(&q, "SELECT datetime(tkt_mtime,'localtime') AS tkt_datetime, *"
                 "  FROM ticket WHERE tkt_uuid GLOB '%q*'", zName);
  if( db_step(&q)==SQLITE_ROW ){
    n = db_column_count(&q);
    for(i=0; i<n; i++){

      }
      for(j=0; j<nField; j++){
        if( fossil_strcmp(azField[j],zName)==0 ){
          azValue[j] = mprintf("%s", zVal);
          break;
        }
      }
      if( Th_Fetch(zName, &size)==0 ){
        Th_Store(zName, zVal);
      }
      free(zRevealed);
    }
  }else{
    db_finalize(&q);
    db_prepare(&q, "PRAGMA table_info(ticket)");
    if( Th_Fetch("tkt_uuid",&size)==0 ){
      Th_Store("tkt_uuid",zName);
    }
    while( db_step(&q)==SQLITE_ROW ){
      const char *zField = db_column_text(&q, 1);
      if( Th_Fetch(zField, &size)==0 ){
        Th_Store(zField, "");
      }
    }
    if( Th_Fetch("tkt_datetime",&size)==0 ){
      Th_Store("tkt_datetime","");
    }
  }
  db_finalize(&q);
}

/*

/*
** Create the subscript interpreter and load the "common" code.
*/
void ticket_init(void){
  const char *zConfig;
  Th_FossilInit();
  zConfig = ticket_common_code();
  Th_Eval(g.interp, 0, zConfig, -1);
}

/*
** Recreate the ticket table.
*/
void ticket_create_table(int separateConnection){
  const char *zSql;

** TH command:   append_field FIELD STRING
**
** FIELD is the name of a database column to which we might want
** to append text.  STRING is the text to be appended to that
** column.  The append does not actually occur until the
** submit_ticket command is run.
*/
static int appendRemarkCmd(
  Th_Interp *interp, 
  void *p, 

  int argc, 
  const char **argv, 
  int *argl
){
  int idx;

  if( argc!=3 ){
    return Th_WrongNumArgs(interp, "append_field FIELD STRING");

  }

  if( g.thTrace ){
    Th_Trace("append_field %#h {%#h}<br />\n",
              argl[1], argv[1], argl[2], argv[2]);
  }
  for(idx=0; idx<nField; idx++){
    if( strncmp(azField[idx], argv[1], argl[1])==0
        && azField[idx][argl[1]]==0 ){
      break;
    }
  }
  if( idx>=nField ){
    Th_ErrorMessage(g.interp, "no such TICKET column: ", argv[1], argl[1]);
    return TH_ERROR;
  }
  azAppend[idx] = mprintf("%.*s", argl[2], argv[2]);
  return TH_OK;
}

/*
** Subscript command:   submit_ticket
**
** Construct and submit a new ticket artifact.  The fields of the artifact
** are the names of the columns in the TICKET table.  The content is
** taken from TH variables.  If the content is unchanged, the field is
** omitted from the artifact.  Fields whose names begin with "private_"
** are concealed using the db_conceal() function.
*/
static int submitTicketCmd(
  Th_Interp *interp, 
  void *pUuid, 
  int argc, 
  const char **argv, 
  int *argl
){

  char *zDate;

  const char *zUuid;
  int i;
  int rid;
  Blob tktchng, cksum;

  login_verify_csrf_secret();
  zUuid = (const char *)pUuid;

                   fossilize(azAppend[i], -1));
    }
  }
  for(i=0; i<nField; i++){
    const char *zValue;
    int nValue;
    if( azAppend[i] ) continue;
    zValue = Th_Fetch(azField[i], &nValue);
    if( zValue ){

      while( nValue>0 && fossil_isspace(zValue[nValue-1]) ){ nValue--; }
      if( strncmp(zValue, azValue[i], nValue) || strlen(azValue[i])!=nValue ){
        if( strncmp(azField[i], "private_", 8)==0 ){
          zValue = db_conceal(zValue, nValue);
          blob_appendf(&tktchng, "J %s %s\n", azField[i], zValue);
        }else{
          blob_appendf(&tktchng, "J %s %#F\n", azField[i], nValue, zValue);

  blob_appendf(&tktchng, "Z %b\n", &cksum);
  if( g.zPath[0]=='d' ){
    /* If called from /debug_tktnew or /debug_tktedit... */
    @ <font color="blue">
    @ <p>Ticket artifact that would have been submitted:</p>
    @ <blockquote><pre>%h(blob_str(&tktchng))</pre></blockquote>
    @ <hr /></font>
    return TH_OK;
  }else if( g.thTrace ){
    Th_Trace("submit_ticket {\n<blockquote><pre>\n%h\n</pre></blockquote>\n"
             "}<br />\n",
       blob_str(&tktchng));
  }else{
    rid = content_put(&tktchng);
    if( rid==0 ){
      fossil_panic("trouble committing ticket: %s", g.zErrMsg);
    }
    manifest_crosslink_begin();
    manifest_crosslink(rid, &tktchng);
    assert( blob_is_reset(&tktchng) );
    manifest_crosslink_end();
  }
  return TH_RETURN;
}


/*
** WEBPAGE: tktnew
** WEBPAGE: debug_tktnew
**

  if( P("date_override") && g.perm.Setup ){
    @ <input type="hidden" name="date_override" value="%h(P("date_override"))">
  }
  @ </p>
  zScript = ticket_newpage_code();
  Th_Store("login", g.zLogin);
  Th_Store("date", db_text(0, "SELECT datetime('now')"));
  Th_CreateCommand(g.interp, "submit_ticket", submitTicketCmd,
                   (void*)&zNewUuid, 0);
  if( g.thTrace ) Th_Trace("BEGIN_TKTNEW_SCRIPT<br />\n", -1);
  if( Th_Render(zScript)==TH_RETURN && !g.thTrace && zNewUuid ){
    cgi_redirect(mprintf("%s/tktview/%s", g.zTop, zNewUuid));
    return;
  }
  @ </form>
  if( g.thTrace ) Th_Trace("END_TKTVIEW<br />\n", -1);
  style_footer();
}

  @ <form method="post" action="%s(g.zTop)/%s(g.zPath)"><p>
  @ <input type="hidden" name="name" value="%s(zName)" />
  login_insert_csrf_secret();
  @ </p>
  zScript = ticket_editpage_code();
  Th_Store("login", g.zLogin);
  Th_Store("date", db_text(0, "SELECT datetime('now')"));
  Th_CreateCommand(g.interp, "append_field", appendRemarkCmd, 0, 0);
  Th_CreateCommand(g.interp, "submit_ticket", submitTicketCmd, (void*)&zName,0);
  if( g.thTrace ) Th_Trace("BEGIN_TKTEDIT_SCRIPT<br />\n", -1);
  if( Th_Render(zScript)==TH_RETURN && !g.thTrace && zName ){
    cgi_redirect(mprintf("%s/tktview/%s", g.zTop, zName));
    return;
  }
  @ </form>
  if( g.thTrace ) Th_Trace("BEGIN_TKTEDIT<br />\n", -1);
  style_footer();
}

** from a server without authorization.
*/
static void server_private_xfer_not_authorized(void){
  @ error not\sauthorized\sto\ssync\sprivate\scontent
}

/*
** Run the specified TH1 script, if any, and returns the return code or TH_OK
** when there is no script.
*/
static int run_script(const char *zScript){
  if( !zScript ){
    return TH_OK; /* No script, return success. */
  }
  Th_FossilInit(); /* Make sure TH1 is ready. */
  return Th_Eval(g.interp, 0, zScript, -1);
}

/*
** Run the pre-transfer TH1 script, if any, and returns the return code.
*/
static int run_common_script(void){
  return run_script(db_get("xfer-common-script", 0));

  g.xferPanic = 1;

  db_begin_transaction();
  db_multi_exec(
     "CREATE TEMP TABLE onremote(rid INTEGER PRIMARY KEY);"
  );
  manifest_crosslink_begin();
  if( run_common_script()==TH_ERROR ){
    cgi_reset_content();
    @ error common\sscript\sfailed:\s%F(Th_GetResult(g.interp, 0))
    nErr++;
  }
  while( blob_line(xfer.pIn, &xfer.line) ){
    if( blob_buffer(&xfer.line)[0]=='#' ) continue;
    if( blob_size(&xfer.line)==0 ) continue;
    xfer.nToken = blob_tokenize(&xfer.line, xfer.aToken, count(xfer.aToken));

    {
      cgi_reset_content();
      @ error bad\scommand:\s%F(blob_str(&xfer.line))
    }
    blobarray_reset(xfer.aToken, xfer.nToken);
  }
  if( isPush ){
    if( run_push_script()==TH_ERROR ){
      cgi_reset_content();
      @ error push\sscript\sfailed:\s%F(Th_GetResult(g.interp, 0))
      nErr++;
    }
    request_phantoms(&xfer, 500);
  }
  if( isClone && nGimme==0 ){
    /* The initial "clone" message from client to server contains no
    ** "gimme" cards. On that initial message, send the client an "igot"

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

set env(TH1_ENABLE_TCL) 1; # Tcl integration must be enabled for this test.

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

fossil test-th-render [file nativename [file join $dir th1-tcl1.txt]]

test th1-tcl-1 {[regexp -- {^\d+
\d+
\d+
via Tcl invoke
4
4

\d+
one_word
three words now
$} [string map [list \r\n \n] $RESULT]]}

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

fossil test-th-render [file nativename [file join $dir th1-tcl2.txt]]

test th1-tcl-2 {[regexp -- {^\d+
$} [string map [list \r\n \n] $RESULT]]}

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

fossil test-th-render [file nativename [file join $dir th1-tcl3.txt]]

test th1-tcl-3 {$RESULT eq {<hr><p class="thmainError">ERROR:\
invalid command name &quot;bad_command&quot;</p>}}

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

fossil test-th-render [file nativename [file join $dir th1-tcl4.txt]]

test th1-tcl-4 {$RESULT eq {<hr><p class="thmainError">ERROR:\
divide by zero</p>}}

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

fossil test-th-render [file nativename [file join $dir th1-tcl5.txt]]

test th1-tcl-5 {$RESULT eq {<hr><p class="thmainError">ERROR:\
Tcl command not found: bad_command</p>} || $RESULT eq {<hr><p\
class="thmainError">ERROR: invalid command name &quot;bad_command&quot;</p>}}

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

fossil test-th-render [file nativename [file join $dir th1-tcl6.txt]]

test th1-tcl-6 {$RESULT eq {<hr><p class="thmainError">ERROR:\
no such command:  bad_command</p>}}

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

fossil test-th-render [file nativename [file join $dir th1-tcl7.txt]]

test th1-tcl-7 {$RESULT eq {<hr><p class="thmainError">ERROR:\
syntax error in expression: &quot;2**0&quot;</p>}}

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

fossil test-th-render [file nativename [file join $dir th1-tcl8.txt]]

test th1-tcl-8 {$RESULT eq {<hr><p class="thmainError">ERROR:\
Cannot invoke Tcl command: tailcall</p>} || $RESULT eq {<hr><p\
class="thmainError">ERROR: tailcall can only be called from a proc or\
lambda</p>}}

<th1>
  #
  # This is a "TH1 fragment" used to test the Tcl integration features of TH1.
  # The corresponding test file executes this file using the test-th-render
  # Fossil command.
  #
  set channel stdout; tclInvoke set channel $channel
  proc doOut {msg} {puts $msg; puts \n}
  doOut [tclEval clock seconds]
  doOut [tclEval {set x [clock seconds]}]
  tclEval {puts $channel "[clock seconds]"}
  tclInvoke puts $channel "via Tcl invoke"
  doOut [tclExpr 2+2]
  doOut [tclExpr 2 + 2]
  doOut [tclInvoke set x "two words"]
  doOut [tclInvoke eval set y one_word]
  doOut [tclInvoke eval {set z "three words now"}]
  doOut [set x [tclEval {set x [clock seconds]}]]
  doOut [tclInvoke th1Eval {set y "two words"}]
  doOut [set z [tclInvoke th1Expr {2+2}]]
  doOut $x
  doOut $y
  doOut $z
  doOut [tclEval set x]
  doOut [tclEval set y]
  doOut [tclEval set z]
</th1>

<th1>
  #
  # This is a "TH1 fragment" used to test the Tcl integration features of TH1.
  # The corresponding test file executes this file using the test-th-render
  # Fossil command.
  #
  # NOTE: This test requires that the SQLite package be available for the Tcl
  #       interpreter that is linked to the Fossil executable.
  #
  tclInvoke set repository_name [repository 1]
  proc doOut {msg} {puts $msg; puts \n}
  doOut [tclEval {

<th1>
  #
  # This is a "TH1 fragment" used to test the Tcl integration features of TH1.
  # The corresponding test file executes this file using the test-th-render
  # Fossil command.
  #
  proc doOut {msg} {puts $msg; puts \n}
  doOut [tclEval bad_command]
</th1>

<th1>
  #
  # This is a "TH1 fragment" used to test the Tcl integration features of TH1.
  # The corresponding test file executes this file using the test-th-render
  # Fossil command.
  #
  proc doOut {msg} {puts $msg; puts \n}
  doOut [tclExpr 2/0]
</th1>

<th1>
  #
  # This is a "TH1 fragment" used to test the Tcl integration features of TH1.
  # The corresponding test file executes this file using the test-th-render
  # Fossil command.
  #
  proc doOut {msg} {puts $msg; puts \n}
  doOut [tclInvoke bad_command]
</th1>

<th1>
  #
  # This is a "TH1 fragment" used to test the Tcl integration features of TH1.
  # The corresponding test file executes this file using the test-th-render
  # Fossil command.
  #
  proc doOut {msg} {puts $msg; puts \n}
  doOut [tclEval th1Eval bad_command]
</th1>