Initial commit

1 files changed, 1381 insertions, 0 deletions

diff --git a/vendor/x11iraf/obm/Tcl/tclBasic.c b/vendor/x11iraf/obm/Tcl/tclBasic.c
new file mode 100644
index 00000000..be5469db
--- /dev/null
+++ b/vendor/x11iraf/obm/Tcl/tclBasic.c
@@ -0,0 +1,1381 @@
+/* 
+ * tclBasic.c --
+ *
+ *	Contains the basic facilities for TCL command interpretation,
+ *	including interpreter creation and deletion, command creation
+ *	and deletion, and command parsing and execution.
+ *
+ * Copyright (c) 1987-1993 The Regents of the University of California.
+ * All rights reserved.
+ *
+ * Permission is hereby granted, without written agreement and without
+ * license or royalty fees, to use, copy, modify, and distribute this
+ * software and its documentation for any purpose, provided that the
+ * above copyright notice and the following two paragraphs appear in
+ * all copies of this software.
+ * 
+ * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
+ * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
+ * OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
+ * CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
+ * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
+ * AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
+ * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
+ * PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
+ */
+
+#ifndef lint
+static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclBasic.c,v 1.153 93/09/09 16:43:19 ouster Exp $ SPRITE (Berkeley)";
+#endif
+
+#include "tclInt.h"
+#ifndef TCL_GENERIC_ONLY
+#   include "tclUnix.h"
+#endif
+
+/*
+ * The following structure defines all of the commands in the Tcl core,
+ * and the C procedures that execute them.
+ */
+
+typedef struct {
+    char *name;			/* Name of command. */
+    Tcl_CmdProc *proc;		/* Procedure that executes command. */
+} CmdInfo;
+
+/*
+ * Built-in commands, and the procedures associated with them:
+ */
+
+static CmdInfo builtInCmds[] = {
+    /*
+     * Commands in the generic core:
+     */
+
+    {"append",		Tcl_AppendCmd},
+    {"array",		Tcl_ArrayCmd},
+    {"break",		Tcl_BreakCmd},
+    {"case",		Tcl_CaseCmd},
+    {"catch",		Tcl_CatchCmd},
+    {"concat",		Tcl_ConcatCmd},
+    {"continue",	Tcl_ContinueCmd},
+    {"error",		Tcl_ErrorCmd},
+    {"eval",		Tcl_EvalCmd},
+    {"expr",		Tcl_ExprCmd},
+    {"for",		Tcl_ForCmd},
+    {"foreach",		Tcl_ForeachCmd},
+    {"format",		Tcl_FormatCmd},
+    {"global",		Tcl_GlobalCmd},
+    {"history",		Tcl_HistoryCmd},
+    {"if",		Tcl_IfCmd},
+    {"incr",		Tcl_IncrCmd},
+    {"info",		Tcl_InfoCmd},
+    {"join",		Tcl_JoinCmd},
+    {"lappend",		Tcl_LappendCmd},
+    {"lindex",		Tcl_LindexCmd},
+    {"linsert",		Tcl_LinsertCmd},
+    {"list",		Tcl_ListCmd},
+    {"llength",		Tcl_LlengthCmd},
+    {"lrange",		Tcl_LrangeCmd},
+    {"lreplace",	Tcl_LreplaceCmd},
+    {"lsearch",		Tcl_LsearchCmd},
+    {"lsort",		Tcl_LsortCmd},
+    {"proc",		Tcl_ProcCmd},
+    {"regexp",		Tcl_RegexpCmd},
+    {"regsub",		Tcl_RegsubCmd},
+    {"rename",		Tcl_RenameCmd},
+    {"return",		Tcl_ReturnCmd},
+    {"scan",		Tcl_ScanCmd},
+    {"set",		Tcl_SetCmd},
+    {"split",		Tcl_SplitCmd},
+    {"string",		Tcl_StringCmd},
+    {"switch",		Tcl_SwitchCmd},
+    {"trace",		Tcl_TraceCmd},
+    {"unset",		Tcl_UnsetCmd},
+    {"uplevel",		Tcl_UplevelCmd},
+    {"upvar",		Tcl_UpvarCmd},
+    {"while",		Tcl_WhileCmd},
+
+    /*
+     * Commands in the UNIX core:
+     */
+
+#ifndef TCL_GENERIC_ONLY
+    {"cd",		Tcl_CdCmd},
+    {"close",		Tcl_CloseCmd},
+    {"eof",		Tcl_EofCmd},
+    {"exec",		Tcl_ExecCmd},
+    {"exit",		Tcl_ExitCmd},
+    {"file",		Tcl_FileCmd},
+    {"flush",		Tcl_FlushCmd},
+    {"gets",		Tcl_GetsCmd},
+    {"glob",		Tcl_GlobCmd},
+    {"open",		Tcl_OpenCmd},
+    {"pid",		Tcl_PidCmd},
+    {"puts",		Tcl_PutsCmd},
+    {"pwd",		Tcl_PwdCmd},
+    {"read",		Tcl_ReadCmd},
+    {"seek",		Tcl_SeekCmd},
+    {"source",		Tcl_SourceCmd},
+    {"tell",		Tcl_TellCmd},
+    {"time",		Tcl_TimeCmd},
+#endif /* TCL_GENERIC_ONLY */
+    {NULL,		(Tcl_CmdProc *) NULL}
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CreateInterp --
+ *
+ *	Create a new TCL command interpreter.
+ *
+ * Results:
+ *	The return value is a token for the interpreter, which may be
+ *	used in calls to procedures like Tcl_CreateCmd, Tcl_Eval, or
+ *	Tcl_DeleteInterp.
+ *
+ * Side effects:
+ *	The command interpreter is initialized with an empty variable
+ *	table and the built-in commands.  SIGPIPE signals are set to
+ *	be ignored (see comment below for details).
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Interp *
+Tcl_CreateInterp()
+{
+    register Interp *iPtr;
+    register Command *cmdPtr;
+    register CmdInfo *cmdInfoPtr;
+    int i;
+    static int firstInterp = 1;
+
+    iPtr = (Interp *) ckalloc(sizeof(Interp));
+    iPtr->result = iPtr->resultSpace;
+    iPtr->freeProc = 0;
+    iPtr->errorLine = 0;
+    Tcl_InitHashTable(&iPtr->commandTable, TCL_STRING_KEYS);
+    Tcl_InitHashTable(&iPtr->mathFuncTable, TCL_STRING_KEYS);
+    Tcl_InitHashTable(&iPtr->globalTable, TCL_STRING_KEYS);
+    iPtr->numLevels = 0;
+    iPtr->maxNestingDepth = 1000;
+    iPtr->framePtr = NULL;
+    iPtr->varFramePtr = NULL;
+    iPtr->activeTracePtr = NULL;
+    iPtr->returnCode = TCL_OK;
+    iPtr->errorInfo = NULL;
+    iPtr->errorCode = NULL;
+    iPtr->numEvents = 0;
+    iPtr->events = NULL;
+    iPtr->curEvent = 0;
+    iPtr->curEventNum = 0;
+    iPtr->revPtr = NULL;
+    iPtr->historyFirst = NULL;
+    iPtr->revDisables = 1;
+    iPtr->evalFirst = iPtr->evalLast = NULL;
+    iPtr->appendResult = NULL;
+    iPtr->appendAvl = 0;
+    iPtr->appendUsed = 0;
+    for (i = 0; i < NUM_REGEXPS; i++) {
+	iPtr->patterns[i] = NULL;
+	iPtr->patLengths[i] = -1;
+	iPtr->regexps[i] = NULL;
+    }
+    strcpy(iPtr->pdFormat, DEFAULT_PD_FORMAT);
+    iPtr->pdPrec = DEFAULT_PD_PREC;
+    iPtr->cmdCount = 0;
+    iPtr->noEval = 0;
+    iPtr->evalFlags = 0;
+    iPtr->scriptFile = NULL;
+    iPtr->flags = 0;
+    iPtr->tracePtr = NULL;
+    iPtr->deleteCallbackPtr = NULL;
+    iPtr->resultSpace[0] = 0;
+
+    /*
+     * Create the built-in commands.  Do it here, rather than calling
+     * Tcl_CreateCommand, because it's faster (there's no need to
+     * check for a pre-existing command by the same name).
+     */
+
+    for (cmdInfoPtr = builtInCmds; cmdInfoPtr->name != NULL; cmdInfoPtr++) {
+	int new;
+	Tcl_HashEntry *hPtr;
+
+	hPtr = Tcl_CreateHashEntry(&iPtr->commandTable,
+		cmdInfoPtr->name, &new);
+	if (new) {
+	    cmdPtr = (Command *) ckalloc(sizeof(Command));
+	    cmdPtr->proc = cmdInfoPtr->proc;
+	    cmdPtr->clientData = (ClientData) NULL;
+	    cmdPtr->deleteProc = NULL;
+	    cmdPtr->deleteData = (ClientData) NULL;
+	    Tcl_SetHashValue(hPtr, cmdPtr);
+	}
+    }
+
+#ifndef TCL_GENERIC_ONLY
+    TclSetupEnv((Tcl_Interp *) iPtr);
+
+    /*
+     * The code below causes SIGPIPE (broken pipe) errors to
+     * be ignored.  This is needed so that Tcl processes don't
+     * die if they create child processes (e.g. using "exec" or
+     * "open") that terminate prematurely.  The signal handler
+     * is only set up when the first interpreter is created; 
+     * after this the application can override the handler with
+     * a different one of its own, if it wants.
+     */
+
+    if (firstInterp) {
+	(void) signal(SIGPIPE, SIG_IGN);
+	firstInterp = 0;
+    }
+#endif
+
+    Tcl_TraceVar2((Tcl_Interp *) iPtr, "tcl_precision", (char *) NULL,
+	    TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+	    TclPrecTraceProc, (ClientData) NULL);
+    return (Tcl_Interp *) iPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Init --
+ *
+ *	This procedure is typically invoked by Tcl_AppInit procedures
+ *	to perform additional initialization for a Tcl interpreter,
+ *	such as sourcing the "init.tcl" script.
+ *
+ * Results:
+ *	Returns a standard Tcl completion code and sets interp->result
+ *	if there is an error.
+ *
+ * Side effects:
+ *	Depends on what's in the init.tcl script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_Init(interp)
+    Tcl_Interp *interp;		/* Interpreter to initialize. */
+{
+    static char initCmd[] =
+	"if [file exists [info library]/init.tcl] {\n\
+	    source [info library]/init.tcl\n\
+	} else {\n\
+	    set msg \"can't find [info library]/init.tcl; perhaps you \"\n\
+	    append msg \"need to\\ninstall Tcl or set your TCL_LIBRARY \"\n\
+	    append msg \"environment variable?\"\n\
+	    error $msg\n\
+	}";
+
+    return Tcl_Eval(interp, initCmd);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tcl_CallWhenDeleted --
+ *
+ *	Arrange for a procedure to be called before a given
+ *	interpreter is deleted.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	When Tcl_DeleteInterp is invoked to delete interp,
+ *	proc will be invoked.  See the manual entry for
+ *	details.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tcl_CallWhenDeleted(interp, proc, clientData)
+    Tcl_Interp *interp;		/* Interpreter to watch. */
+    Tcl_InterpDeleteProc *proc;	/* Procedure to call when interpreter
+				 * is about to be deleted. */
+    ClientData clientData;	/* One-word value to pass to proc. */
+{
+    DeleteCallback *dcPtr, *prevPtr;
+    Interp *iPtr = (Interp *) interp;
+
+    dcPtr = (DeleteCallback *) ckalloc(sizeof(DeleteCallback));
+    dcPtr->proc = proc;
+    dcPtr->clientData = clientData;
+    dcPtr->nextPtr = NULL;
+    if (iPtr->deleteCallbackPtr == NULL) {
+	iPtr->deleteCallbackPtr = dcPtr;
+    } else {
+	prevPtr = iPtr->deleteCallbackPtr;
+	while (prevPtr->nextPtr != NULL) {
+	    prevPtr = prevPtr->nextPtr;
+	}
+	prevPtr->nextPtr = dcPtr;
+    }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tcl_DontCallWhenDeleted --
+ *
+ *	Cancel the arrangement for a procedure to be called when
+ *	a given interpreter is deleted.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	If proc and clientData were previously registered as a
+ *	callback via Tcl_CallWhenDeleted, they are unregistered.
+ *	If they weren't previously registered then nothing
+ *	happens.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tcl_DontCallWhenDeleted(interp, proc, clientData)
+    Tcl_Interp *interp;		/* Interpreter to watch. */
+    Tcl_InterpDeleteProc *proc;	/* Procedure to call when interpreter
+				 * is about to be deleted. */
+    ClientData clientData;	/* One-word value to pass to proc. */
+{
+    DeleteCallback *prevPtr, *dcPtr;
+    Interp *iPtr = (Interp *) interp;
+
+    for (prevPtr = NULL, dcPtr = iPtr->deleteCallbackPtr;
+	    dcPtr != NULL; prevPtr = dcPtr, dcPtr = dcPtr->nextPtr) {
+	if ((dcPtr->proc != proc) || (dcPtr->clientData != clientData)) {
+	    continue;
+	}
+	if (prevPtr == NULL) {
+	    iPtr->deleteCallbackPtr = dcPtr->nextPtr;
+	} else {
+	    prevPtr->nextPtr = dcPtr->nextPtr;
+	}
+	ckfree((char *) dcPtr);
+	break;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DeleteInterp --
+ *
+ *	Delete an interpreter and free up all of the resources associated
+ *	with it.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The interpreter is destroyed.  The caller should never again
+ *	use the interp token.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_DeleteInterp(interp)
+    Tcl_Interp *interp;		/* Token for command interpreter (returned
+				 * by a previous call to Tcl_CreateInterp). */
+{
+    Interp *iPtr = (Interp *) interp;
+    Tcl_HashEntry *hPtr;
+    Tcl_HashSearch search;
+    register Command *cmdPtr;
+    DeleteCallback *dcPtr;
+    int i;
+
+    /*
+     * If the interpreter is in use, delay the deletion until later.
+     */
+
+    iPtr->flags |= DELETED;
+    if (iPtr->numLevels != 0) {
+	return;
+    }
+
+    /*
+     * Invoke deletion callbacks.
+     */
+
+    while (iPtr->deleteCallbackPtr != NULL) {
+	dcPtr = iPtr->deleteCallbackPtr;
+	iPtr->deleteCallbackPtr = dcPtr->nextPtr;
+	(*dcPtr->proc)(dcPtr->clientData, interp);
+	ckfree((char *) dcPtr);
+    }
+
+    /*
+     * Free up any remaining resources associated with the
+     * interpreter.
+     */
+
+    for (hPtr = Tcl_FirstHashEntry(&iPtr->commandTable, &search);
+	    hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+	cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
+	if (cmdPtr->deleteProc != NULL) { 
+	    (*cmdPtr->deleteProc)(cmdPtr->deleteData);
+	}
+	ckfree((char *) cmdPtr);
+    }
+    Tcl_DeleteHashTable(&iPtr->commandTable);
+    for (hPtr = Tcl_FirstHashEntry(&iPtr->mathFuncTable, &search);
+	    hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+	ckfree((char *) Tcl_GetHashValue(hPtr));
+    }
+    Tcl_DeleteHashTable(&iPtr->mathFuncTable);
+    TclDeleteVars(iPtr, &iPtr->globalTable);
+
+    /*
+     * Free up the result *after* deleting variables, since variable
+     * deletion could have transferred ownership of the result string
+     * to Tcl.
+     */
+
+    Tcl_FreeResult(interp);
+    if (iPtr->errorInfo != NULL) {
+	ckfree(iPtr->errorInfo);
+    }
+    if (iPtr->errorCode != NULL) {
+	ckfree(iPtr->errorCode);
+    }
+    if (iPtr->events != NULL) {
+	int i;
+
+	for (i = 0; i < iPtr->numEvents; i++) {
+	    ckfree(iPtr->events[i].command);
+	}
+	ckfree((char *) iPtr->events);
+    }
+    while (iPtr->revPtr != NULL) {
+	HistoryRev *nextPtr = iPtr->revPtr->nextPtr;
+
+	ckfree((char *) iPtr->revPtr);
+	iPtr->revPtr = nextPtr;
+    }
+    if (iPtr->appendResult != NULL) {
+	ckfree(iPtr->appendResult);
+    }
+    for (i = 0; i < NUM_REGEXPS; i++) {
+	if (iPtr->patterns[i] == NULL) {
+	    break;
+	}
+	ckfree(iPtr->patterns[i]);
+	ckfree((char *) iPtr->regexps[i]);
+    }
+    while (iPtr->tracePtr != NULL) {
+	Trace *nextPtr = iPtr->tracePtr->nextPtr;
+
+	ckfree((char *) iPtr->tracePtr);
+	iPtr->tracePtr = nextPtr;
+    }
+    ckfree((char *) iPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CreateCommand --
+ *
+ *	Define a new command in a command table.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	If a command named cmdName already exists for interp, it is
+ *	deleted.  In the future, when cmdName is seen as the name of
+ *	a command by Tcl_Eval, proc will be called.  When the command
+ *	is deleted from the table, deleteProc will be called.  See the
+ *	manual entry for details on the calling sequence.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_CreateCommand(interp, cmdName, proc, clientData, deleteProc)
+    Tcl_Interp *interp;		/* Token for command interpreter (returned
+				 * by a previous call to Tcl_CreateInterp). */
+    char *cmdName;		/* Name of command. */
+    Tcl_CmdProc *proc;		/* Command procedure to associate with
+				 * cmdName. */
+    ClientData clientData;	/* Arbitrary one-word value to pass to proc. */
+    Tcl_CmdDeleteProc *deleteProc;
+				/* If not NULL, gives a procedure to call when
+				 * this command is deleted. */
+{
+    Interp *iPtr = (Interp *) interp;
+    register Command *cmdPtr;
+    Tcl_HashEntry *hPtr;
+    int new;
+
+    hPtr = Tcl_CreateHashEntry(&iPtr->commandTable, cmdName, &new);
+    if (!new) {
+	/*
+	 * Command already exists:  delete the old one.
+	 */
+
+	cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
+	if (cmdPtr->deleteProc != NULL) {
+	    (*cmdPtr->deleteProc)(cmdPtr->deleteData);
+	}
+    } else {
+	cmdPtr = (Command *) ckalloc(sizeof(Command));
+	Tcl_SetHashValue(hPtr, cmdPtr);
+    }
+    cmdPtr->proc = proc;
+    cmdPtr->clientData = clientData;
+    cmdPtr->deleteProc = deleteProc;
+    cmdPtr->deleteData = clientData;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetCommandInfo --
+ *
+ *	Modifies various information about a Tcl command.
+ *
+ * Results:
+ *	If cmdName exists in interp, then the information at *infoPtr
+ *	is stored with the command in place of the current information
+ *	and 1 is returned.  If the command doesn't exist then 0 is
+ *	returned.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_SetCommandInfo(interp, cmdName, infoPtr)
+    Tcl_Interp *interp;			/* Interpreter in which to look
+					 * for command. */
+    char *cmdName;			/* Name of desired command. */
+    Tcl_CmdInfo *infoPtr;		/* Where to store information about
+					 * command. */
+{
+    Tcl_HashEntry *hPtr;
+    Command *cmdPtr;
+
+    hPtr = Tcl_FindHashEntry(&((Interp *) interp)->commandTable, cmdName);
+    if (hPtr == NULL) {
+	return 0;
+    }
+    cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
+    cmdPtr->proc = infoPtr->proc;
+    cmdPtr->clientData = infoPtr->clientData;
+    cmdPtr->deleteProc = infoPtr->deleteProc;
+    cmdPtr->deleteData = infoPtr->deleteData;
+    return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetCommandInfo --
+ *
+ *	Returns various information about a Tcl command.
+ *
+ * Results:
+ *	If cmdName exists in interp, then *infoPtr is modified to
+ *	hold information about cmdName and 1 is returned.  If the
+ *	command doesn't exist then 0 is returned and *infoPtr isn't
+ *	modified.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetCommandInfo(interp, cmdName, infoPtr)
+    Tcl_Interp *interp;			/* Interpreter in which to look
+					 * for command. */
+    char *cmdName;			/* Name of desired command. */
+    Tcl_CmdInfo *infoPtr;		/* Where to store information about
+					 * command. */
+{
+    Tcl_HashEntry *hPtr;
+    Command *cmdPtr;
+
+    hPtr = Tcl_FindHashEntry(&((Interp *) interp)->commandTable, cmdName);
+    if (hPtr == NULL) {
+	return 0;
+    }
+    cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
+    infoPtr->proc = cmdPtr->proc;
+    infoPtr->clientData = cmdPtr->clientData;
+    infoPtr->deleteProc = cmdPtr->deleteProc;
+    infoPtr->deleteData = cmdPtr->deleteData;
+    return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DeleteCommand --
+ *
+ *	Remove the given command from the given interpreter.
+ *
+ * Results:
+ *	0 is returned if the command was deleted successfully.
+ *	-1 is returned if there didn't exist a command by that
+ *	name.
+ *
+ * Side effects:
+ *	CmdName will no longer be recognized as a valid command for
+ *	interp.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_DeleteCommand(interp, cmdName)
+    Tcl_Interp *interp;		/* Token for command interpreter (returned
+				 * by a previous call to Tcl_CreateInterp). */
+    char *cmdName;		/* Name of command to remove. */
+{
+    Interp *iPtr = (Interp *) interp;
+    Tcl_HashEntry *hPtr;
+    Command *cmdPtr;
+
+    hPtr = Tcl_FindHashEntry(&iPtr->commandTable, cmdName);
+    if (hPtr == NULL) {
+	return -1;
+    }
+    cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
+    if (cmdPtr->deleteProc != NULL) {
+	(*cmdPtr->deleteProc)(cmdPtr->deleteData);
+    }
+    ckfree((char *) cmdPtr);
+    Tcl_DeleteHashEntry(hPtr);
+    return 0;
+}
+
+/*
+ *-----------------------------------------------------------------
+ *
+ * Tcl_Eval --
+ *
+ *	Parse and execute a command in the Tcl language.
+ *
+ * Results:
+ *	The return value is one of the return codes defined in tcl.hd
+ *	(such as TCL_OK), and interp->result contains a string value
+ *	to supplement the return code.  The value of interp->result
+ *	will persist only until the next call to Tcl_Eval:  copy it or
+ *	lose it! *TermPtr is filled in with the character just after
+ *	the last one that was part of the command (usually a NULL
+ *	character or a closing bracket).
+ *
+ * Side effects:
+ *	Almost certainly;  depends on the command.
+ *
+ *-----------------------------------------------------------------
+ */
+
+int
+Tcl_Eval(interp, cmd)
+    Tcl_Interp *interp;		/* Token for command interpreter (returned
+				 * by a previous call to Tcl_CreateInterp). */
+    char *cmd;			/* Pointer to TCL command to interpret. */
+{
+    /*
+     * The storage immediately below is used to generate a copy
+     * of the command, after all argument substitutions.  Pv will
+     * contain the argv values passed to the command procedure.
+#   define NUM_CHARS 1024
+     */
+
+#   define NUM_CHARS 200
+    char copyStorage[NUM_CHARS];
+    ParseValue pv;
+    char *oldBuffer;
+
+    /*
+     * This procedure generates an (argv, argc) array for the command,
+     * It starts out with stack-allocated space but uses dynamically-
+     * allocated storage to increase it if needed.
+     */
+
+#   define NUM_ARGS 10
+    char *(argStorage[NUM_ARGS]);
+    char **argv = argStorage;
+    int argc;
+    int argSize = NUM_ARGS;
+
+    register char *src;			/* Points to current character
+					 * in cmd. */
+    char termChar;			/* Return when this character is found
+					 * (either ']' or '\0').  Zero means
+					 * that newlines terminate commands. */
+    int flags;				/* Interp->evalFlags value when the
+					 * procedure was called. */
+    int result;				/* Return value. */
+    register Interp *iPtr = (Interp *) interp;
+    Tcl_HashEntry *hPtr;
+    Command *cmdPtr;
+    char *termPtr;			/* Contains character just after the
+					 * last one in the command. */
+    char *cmdStart;			/* Points to first non-blank char. in
+					 * command (used in calling trace
+					 * procedures). */
+    char *ellipsis = "";		/* Used in setting errorInfo variable;
+					 * set to "..." to indicate that not
+					 * all of offending command is included
+					 * in errorInfo.  "" means that the
+					 * command is all there. */
+    register Trace *tracePtr;
+
+    /*
+     * Initialize the result to an empty string and clear out any
+     * error information.  This makes sure that we return an empty
+     * result if there are no commands in the command string.
+     */
+
+    Tcl_FreeResult((Tcl_Interp *) iPtr);
+    iPtr->result = iPtr->resultSpace;
+    iPtr->resultSpace[0] = 0;
+    result = TCL_OK;
+
+    /*
+     * Initialize the area in which command copies will be assembled.
+     */
+
+    pv.buffer = copyStorage;
+    pv.end = copyStorage + NUM_CHARS - 1;
+    pv.expandProc = TclExpandParseValue;
+    pv.clientData = (ClientData) NULL;
+
+    src = cmd;
+    flags = iPtr->evalFlags;
+    iPtr->evalFlags = 0;
+    if (flags & TCL_BRACKET_TERM) {
+	termChar = ']';
+    } else {
+	termChar = 0;
+    }
+    termPtr = src;
+    cmdStart = src;
+
+    /*
+     * Check depth of nested calls to Tcl_Eval:  if this gets too large,
+     * it's probably because of an infinite loop somewhere.
+     */
+
+    iPtr->numLevels++;
+    if (iPtr->numLevels > iPtr->maxNestingDepth) {
+	iPtr->numLevels--;
+	iPtr->result =  "too many nested calls to Tcl_Eval (infinite loop?)";
+	iPtr->termPtr = termPtr;
+	return TCL_ERROR;
+    }
+
+    /*
+     * There can be many sub-commands (separated by semi-colons or
+     * newlines) in one command string.  This outer loop iterates over
+     * individual commands.
+     */
+
+    while (*src != termChar) {
+	iPtr->flags &= ~(ERR_IN_PROGRESS | ERROR_CODE_SET);
+
+	/*
+	 * Skim off leading white space and semi-colons, and skip
+	 * comments.
+	 */
+
+	while (1) {
+	    register char c = *src;
+
+	    if ((CHAR_TYPE(c) != TCL_SPACE) && (c != ';') && (c != '\n')) {
+		break;
+	    }
+	    src += 1;
+	}
+	if (*src == '#') {
+	    for (src++; *src != 0; src++) {
+		if ((*src == '\n') && (src[-1] != '\\')) {
+		    src++;
+		    break;
+		}
+	    }
+	    continue;
+	}
+	cmdStart = src;
+
+	/*
+	 * Parse the words of the command, generating the argc and
+	 * argv for the command procedure.  May have to call
+	 * TclParseWords several times, expanding the argv array
+	 * between calls.
+	 */
+
+	pv.next = oldBuffer = pv.buffer;
+	argc = 0;
+	while (1) {
+	    int newArgs, maxArgs;
+	    char **newArgv;
+	    int i;
+
+	    /*
+	     * Note:  the "- 2" below guarantees that we won't use the
+	     * last two argv slots here.  One is for a NULL pointer to
+	     * mark the end of the list, and the other is to leave room
+	     * for inserting the command name "unknown" as the first
+	     * argument (see below).
+	     */
+
+	    maxArgs = argSize - argc - 2;
+	    result = TclParseWords((Tcl_Interp *) iPtr, src, flags,
+		    maxArgs, &termPtr, &newArgs, &argv[argc], &pv);
+	    src = termPtr;
+	    if (result != TCL_OK) {
+		ellipsis = "...";
+		goto done;
+	    }
+
+	    /*
+	     * Careful!  Buffer space may have gotten reallocated while
+	     * parsing words.  If this happened, be sure to update all
+	     * of the older argv pointers to refer to the new space.
+	     */
+
+	    if (oldBuffer != pv.buffer) {
+		int i;
+
+		for (i = 0; i < argc; i++) {
+		    argv[i] = pv.buffer + (argv[i] - oldBuffer);
+		}
+		oldBuffer = pv.buffer;
+	    }
+	    argc += newArgs;
+	    if (newArgs < maxArgs) {
+		argv[argc] = (char *) NULL;
+		break;
+	    }
+
+	    /*
+	     * Args didn't all fit in the current array.  Make it bigger.
+	     */
+
+	    argSize *= 2;
+	    newArgv = (char **)
+		    ckalloc((unsigned) argSize * sizeof(char *));
+	    for (i = 0; i < argc; i++) {
+		newArgv[i] = argv[i];
+	    }
+	    if (argv != argStorage) {
+		ckfree((char *) argv);
+	    }
+	    argv = newArgv;
+	}
+
+	/*
+	 * If this is an empty command (or if we're just parsing
+	 * commands without evaluating them), then just skip to the
+	 * next command.
+	 */
+
+	if ((argc == 0) || iPtr->noEval) {
+	    continue;
+	}
+	argv[argc] = NULL;
+
+	/*
+	 * Save information for the history module, if needed.
+	 */
+
+	if (flags & TCL_RECORD_BOUNDS) {
+	    iPtr->evalFirst = cmdStart;
+	    iPtr->evalLast = src-1;
+	}
+
+	/*
+	 * Find the procedure to execute this command.  If there isn't
+	 * one, then see if there is a command "unknown".  If so,
+	 * invoke it instead, passing it the words of the original
+	 * command as arguments.
+	 */
+
+	hPtr = Tcl_FindHashEntry(&iPtr->commandTable, argv[0]);
+	if (hPtr == NULL) {
+	    int i;
+
+	    hPtr = Tcl_FindHashEntry(&iPtr->commandTable, "unknown");
+	    if (hPtr == NULL) {
+		Tcl_ResetResult(interp);
+		Tcl_AppendResult(interp, "invalid command name: \"",
+			argv[0], "\"", (char *) NULL);
+		result = TCL_ERROR;
+		goto done;
+	    }
+	    for (i = argc; i >= 0; i--) {
+		argv[i+1] = argv[i];
+	    }
+	    argv[0] = "unknown";
+	    argc++;
+	}
+	cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
+
+	/*
+	 * Call trace procedures, if any.
+	 */
+
+	for (tracePtr = iPtr->tracePtr; tracePtr != NULL;
+		tracePtr = tracePtr->nextPtr) {
+	    char saved;
+
+	    if (tracePtr->level < iPtr->numLevels) {
+		continue;
+	    }
+	    saved = *src;
+	    *src = 0;
+	    (*tracePtr->proc)(tracePtr->clientData, interp, iPtr->numLevels,
+		    cmdStart, cmdPtr->proc, cmdPtr->clientData, argc, argv);
+	    *src = saved;
+	}
+
+	/*
+	 * At long last, invoke the command procedure.  Reset the
+	 * result to its default empty value first (it could have
+	 * gotten changed by earlier commands in the same command
+	 * string).
+	 */
+
+	iPtr->cmdCount++;
+	Tcl_FreeResult(iPtr);
+	iPtr->result = iPtr->resultSpace;
+	iPtr->resultSpace[0] = 0;
+	result = (*cmdPtr->proc)(cmdPtr->clientData, interp, argc, argv);
+	if (tcl_AsyncReady) {
+	    result = Tcl_AsyncInvoke(interp, result);
+	}
+	if (result != TCL_OK) {
+	    break;
+	}
+    }
+
+    /*
+     * Free up any extra resources that were allocated.
+     */
+
+    done:
+    if (pv.buffer != copyStorage) {
+	ckfree((char *) pv.buffer);
+    }
+    if (argv != argStorage) {
+	ckfree((char *) argv);
+    }
+    iPtr->numLevels--;
+    if (iPtr->numLevels == 0) {
+	if (result == TCL_RETURN) {
+	    result = TCL_OK;
+	}
+	if ((result != TCL_OK) && (result != TCL_ERROR)) {
+	    Tcl_ResetResult(interp);
+	    if (result == TCL_BREAK) {
+		iPtr->result = "invoked \"break\" outside of a loop";
+	    } else if (result == TCL_CONTINUE) {
+		iPtr->result = "invoked \"continue\" outside of a loop";
+	    } else {
+		iPtr->result = iPtr->resultSpace;
+		sprintf(iPtr->resultSpace, "command returned bad code: %d",
+			result);
+	    }
+	    result = TCL_ERROR;
+	}
+	if (iPtr->flags & DELETED) {
+	    Tcl_DeleteInterp(interp);
+	}
+    }
+
+    /*
+     * If an error occurred, record information about what was being
+     * executed when the error occurred.
+     */
+
+    if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
+	int numChars;
+	register char *p;
+
+	/*
+	 * Compute the line number where the error occurred.
+	 */
+
+	iPtr->errorLine = 1;
+	for (p = cmd; p != cmdStart; p++) {
+	    if (*p == '\n') {
+		iPtr->errorLine++;
+	    }
+	}
+	for ( ; isspace(UCHAR(*p)) || (*p == ';'); p++) {
+	    if (*p == '\n') {
+		iPtr->errorLine++;
+	    }
+	}
+
+	/*
+	 * Figure out how much of the command to print in the error
+	 * message (up to a certain number of characters, or up to
+	 * the first new-line).
+	 */
+
+	numChars = src - cmdStart;
+	if (numChars > (NUM_CHARS-50)) {
+	    numChars = NUM_CHARS-50;
+	    ellipsis = " ...";
+	}
+
+	if (!(iPtr->flags & ERR_IN_PROGRESS)) {
+	    sprintf(copyStorage, "\n    while executing\n\"%.*s%s\"",
+		    numChars, cmdStart, ellipsis);
+	} else {
+	    sprintf(copyStorage, "\n    invoked from within\n\"%.*s%s\"",
+		    numChars, cmdStart, ellipsis);
+	}
+	Tcl_AddErrorInfo(interp, copyStorage);
+	iPtr->flags &= ~ERR_ALREADY_LOGGED;
+    } else {
+	iPtr->flags &= ~ERR_ALREADY_LOGGED;
+    }
+    iPtr->termPtr = termPtr;
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CreateTrace --
+ *
+ *	Arrange for a procedure to be called to trace command execution.
+ *
+ * Results:
+ *	The return value is a token for the trace, which may be passed
+ *	to Tcl_DeleteTrace to eliminate the trace.
+ *
+ * Side effects:
+ *	From now on, proc will be called just before a command procedure
+ *	is called to execute a Tcl command.  Calls to proc will have the
+ *	following form:
+ *
+ *	void
+ *	proc(clientData, interp, level, command, cmdProc, cmdClientData,
+ *		argc, argv)
+ *	    ClientData clientData;
+ *	    Tcl_Interp *interp;
+ *	    int level;
+ *	    char *command;
+ *	    int (*cmdProc)();
+ *	    ClientData cmdClientData;
+ *	    int argc;
+ *	    char **argv;
+ *	{
+ *	}
+ *
+ *	The clientData and interp arguments to proc will be the same
+ *	as the corresponding arguments to this procedure.  Level gives
+ *	the nesting level of command interpretation for this interpreter
+ *	(0 corresponds to top level).  Command gives the ASCII text of
+ *	the raw command, cmdProc and cmdClientData give the procedure that
+ *	will be called to process the command and the ClientData value it
+ *	will receive, and argc and argv give the arguments to the
+ *	command, after any argument parsing and substitution.  Proc
+ *	does not return a value.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Trace
+Tcl_CreateTrace(interp, level, proc, clientData)
+    Tcl_Interp *interp;		/* Interpreter in which to create the trace. */
+    int level;			/* Only call proc for commands at nesting level
+				 * <= level (1 => top level). */
+    Tcl_CmdTraceProc *proc;	/* Procedure to call before executing each
+				 * command. */
+    ClientData clientData;	/* Arbitrary one-word value to pass to proc. */
+{
+    register Trace *tracePtr;
+    register Interp *iPtr = (Interp *) interp;
+
+    tracePtr = (Trace *) ckalloc(sizeof(Trace));
+    tracePtr->level = level;
+    tracePtr->proc = proc;
+    tracePtr->clientData = clientData;
+    tracePtr->nextPtr = iPtr->tracePtr;
+    iPtr->tracePtr = tracePtr;
+
+    return (Tcl_Trace) tracePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DeleteTrace --
+ *
+ *	Remove a trace.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	From now on there will be no more calls to the procedure given
+ *	in trace.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_DeleteTrace(interp, trace)
+    Tcl_Interp *interp;		/* Interpreter that contains trace. */
+    Tcl_Trace trace;		/* Token for trace (returned previously by
+				 * Tcl_CreateTrace). */
+{
+    register Interp *iPtr = (Interp *) interp;
+    register Trace *tracePtr = (Trace *) trace;
+    register Trace *tracePtr2;
+
+    if (iPtr->tracePtr == tracePtr) {
+	iPtr->tracePtr = tracePtr->nextPtr;
+	ckfree((char *) tracePtr);
+    } else {
+	for (tracePtr2 = iPtr->tracePtr; tracePtr2 != NULL;
+		tracePtr2 = tracePtr2->nextPtr) {
+	    if (tracePtr2->nextPtr == tracePtr) {
+		tracePtr2->nextPtr = tracePtr->nextPtr;
+		ckfree((char *) tracePtr);
+		return;
+	    }
+	}
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AddErrorInfo --
+ *
+ *	Add information to a message being accumulated that describes
+ *	the current error.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The contents of message are added to the "errorInfo" variable.
+ *	If Tcl_Eval has been called since the current value of errorInfo
+ *	was set, errorInfo is cleared before adding the new message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_AddErrorInfo(interp, message)
+    Tcl_Interp *interp;		/* Interpreter to which error information
+				 * pertains. */
+    char *message;		/* Message to record. */
+{
+    register Interp *iPtr = (Interp *) interp;
+
+    /*
+     * If an error is already being logged, then the new errorInfo
+     * is the concatenation of the old info and the new message.
+     * If this is the first piece of info for the error, then the
+     * new errorInfo is the concatenation of the message in
+     * interp->result and the new message.
+     */
+
+    if (!(iPtr->flags & ERR_IN_PROGRESS)) {
+	Tcl_SetVar2(interp, "errorInfo", (char *) NULL, interp->result,
+		TCL_GLOBAL_ONLY);
+	iPtr->flags |= ERR_IN_PROGRESS;
+
+	/*
+	 * If the errorCode variable wasn't set by the code that generated
+	 * the error, set it to "NONE".
+	 */
+
+	if (!(iPtr->flags & ERROR_CODE_SET)) {
+	    (void) Tcl_SetVar2(interp, "errorCode", (char *) NULL, "NONE",
+		    TCL_GLOBAL_ONLY);
+	}
+    }
+    Tcl_SetVar2(interp, "errorInfo", (char *) NULL, message,
+	    TCL_GLOBAL_ONLY|TCL_APPEND_VALUE);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_VarEval --
+ *
+ *	Given a variable number of string arguments, concatenate them
+ *	all together and execute the result as a Tcl command.
+ *
+ * Results:
+ *	A standard Tcl return result.  An error message or other
+ *	result may be left in interp->result.
+ *
+ * Side effects:
+ *	Depends on what was done by the command.
+ *
+ *----------------------------------------------------------------------
+ */
+	/* VARARGS2 */ /* ARGSUSED */
+int
+#ifdef USE_STDARG
+Tcl_VarEval(Tcl_Interp *iPtr, ...)
+#else
+
+#ifndef lint
+Tcl_VarEval(va_alist)
+#else
+Tcl_VarEval(iPtr, p, va_alist)
+    Tcl_Interp *iPtr;		/* Interpreter in which to execute command. */
+    char *p;			/* One or more strings to concatenate,
+				 * terminated with a NULL string. */
+#endif
+
+    va_dcl
+#endif
+{
+    va_list argList;
+
+#define FIXED_SIZE 200
+    char fixedSpace[FIXED_SIZE+1];
+    int spaceAvl, spaceUsed, length;
+    char *string, *cmd;
+    Tcl_Interp *interp = iPtr;
+    int result;
+
+    /*
+     * Copy the strings one after the other into a single larger
+     * string.  Use stack-allocated space for small commands, but if
+     * the command gets too large than call ckalloc to create the
+     * space.
+     */
+
+#ifdef USE_STDARG
+    va_start(argList, iPtr);
+#else
+    va_start(argList);
+    (void) va_arg(argList, Tcl_Interp *);
+#endif
+    spaceAvl = FIXED_SIZE;
+    spaceUsed = 0;
+    cmd = fixedSpace;
+    while (1) {
+	string = va_arg(argList, char *);
+	if (string == NULL) {
+	    break;
+	}
+	length = strlen(string);
+	if ((spaceUsed + length) > spaceAvl) {
+	    char *new;
+
+	    spaceAvl = spaceUsed + length;
+	    spaceAvl += spaceAvl/2;
+	    new = ckalloc((unsigned) spaceAvl);
+	    memcpy((VOID *) new, (VOID *) cmd, spaceUsed);
+	    if (cmd != fixedSpace) {
+		ckfree(cmd);
+	    }
+	    cmd = new;
+	}
+	strcpy(cmd + spaceUsed, string);
+	spaceUsed += length;
+    }
+    va_end(argList);
+    cmd[spaceUsed] = '\0';
+
+    result = Tcl_Eval(interp, cmd);
+    if (cmd != fixedSpace) {
+	ckfree(cmd);
+    }
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GlobalEval --
+ *
+ *	Evaluate a command at global level in an interpreter.
+ *
+ * Results:
+ *	A standard Tcl result is returned, and interp->result is
+ *	modified accordingly.
+ *
+ * Side effects:
+ *	The command string is executed in interp, and the execution
+ *	is carried out in the variable context of global level (no
+ *	procedures active), just as if an "uplevel #0" command were
+ *	being executed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GlobalEval(interp, command)
+    Tcl_Interp *interp;		/* Interpreter in which to evaluate command. */
+    char *command;		/* Command to evaluate. */
+{
+    register Interp *iPtr = (Interp *) interp;
+    int result;
+    CallFrame *savedVarFramePtr;
+
+    savedVarFramePtr = iPtr->varFramePtr;
+    iPtr->varFramePtr = NULL;
+    result = Tcl_Eval(interp, command);
+    iPtr->varFramePtr = savedVarFramePtr;
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetRecursionLimit --
+ *
+ *	Set the maximum number of recursive calls that may be active
+ *	for an interpreter at once.
+ *
+ * Results:
+ *	The return value is the old limit on nesting for interp.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_SetRecursionLimit(interp, depth)
+    Tcl_Interp *interp;			/* Interpreter whose nesting limit
+					 * is to be set. */
+    int depth;				/* New value for maximimum depth. */
+{
+    Interp *iPtr = (Interp *) interp;
+    int old;
+
+    old = iPtr->maxNestingDepth;
+    if (depth > 0) {
+	iPtr->maxNestingDepth = depth;
+    }
+    return old;
+}