archie/tcl7.6/generic/tclParse.c

/* 
 * tclParse.c --
 *
 *	This file contains a collection of procedures that are used
 *	to parse Tcl commands or parts of commands (like quoted
 *	strings or nested sub-commands).
 *
 * Copyright (c) 1987-1993 The Regents of the University of California.
 * Copyright (c) 1994-1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tclParse.c 1.51 96/09/06 09:47:29
 */

#include "tclInt.h"
#include "tclPort.h"

/*
 * The following table assigns a type to each character.  Only types
 * meaningful to Tcl parsing are represented here.  The table is
 * designed to be referenced with either signed or unsigned characters,
 * so it has 384 entries.  The first 128 entries correspond to negative
 * character values, the next 256 correspond to positive character
 * values.  The last 128 entries are identical to the first 128.  The
 * table is always indexed with a 128-byte offset (the 128th entry
 * corresponds to a 0 character value).
 */

char tclTypeTable[] = {
    /*
     * Negative character values, from -128 to -1:
     */

    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,

    /*
     * Positive character values, from 0-127:
     */

    TCL_COMMAND_END,   TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_SPACE,         TCL_COMMAND_END,   TCL_SPACE,
    TCL_SPACE,         TCL_SPACE,         TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_SPACE,         TCL_NORMAL,        TCL_QUOTE,         TCL_NORMAL,
    TCL_DOLLAR,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_COMMAND_END,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_OPEN_BRACKET,
    TCL_BACKSLASH,     TCL_COMMAND_END,   TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_OPEN_BRACE,
    TCL_NORMAL,        TCL_CLOSE_BRACE,   TCL_NORMAL,        TCL_NORMAL,

    /*
     * Large unsigned character values, from 128-255:
     */

    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
    TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
};

/*
 * Function prototypes for procedures local to this file:
 */

static char *	QuoteEnd _ANSI_ARGS_((char *string, int term));
static char *	ScriptEnd _ANSI_ARGS_((char *p, int nested));
static char *	VarNameEnd _ANSI_ARGS_((char *string));

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Backslash --
 *
 *	Figure out how to handle a backslash sequence.
 *
 * Results:
 *	The return value is the character that should be substituted
 *	in place of the backslash sequence that starts at src.  If
 *	readPtr isn't NULL then it is filled in with a count of the
 *	number of characters in the backslash sequence.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

char
Tcl_Backslash(src, readPtr)
    char *src;			/* Points to the backslash character of
				 * a backslash sequence. */
    int *readPtr;		/* Fill in with number of characters read
				 * from src, unless NULL. */
{
    register char *p = src+1;
    char result;
    int count;

    count = 2;

    switch (*p) {
	/*
	 * Note: in the conversions below, use absolute values (e.g.,
	 * 0xa) rather than symbolic values (e.g. \n) that get converted
	 * by the compiler.  It's possible that compilers on some
	 * platforms will do the symbolic conversions differently, which
	 * could result in non-portable Tcl scripts.
	 */

	case 'a':
	    result = 0x7;
	    break;
	case 'b':
	    result = 0x8;
	    break;
	case 'f':
	    result = 0xc;
	    break;
	case 'n':
	    result = 0xa;
	    break;
	case 'r':
	    result = 0xd;
	    break;
	case 't':
	    result = 0x9;
	    break;
	case 'v':
	    result = 0xb;
	    break;
	case 'x':
	    if (isxdigit(UCHAR(p[1]))) {
		char *end;

		result = (char) strtoul(p+1, &end, 16);
		count = end - src;
	    } else {
		count = 2;
		result = 'x';
	    }
	    break;
	case '\n':
	    do {
		p++;
	    } while ((*p == ' ') || (*p == '\t'));
	    result = ' ';
	    count = p - src;
	    break;
	case 0:
	    result = '\\';
	    count = 1;
	    break;
	default:
	    if (isdigit(UCHAR(*p))) {
		result = (char)(*p - '0');
		p++;
		if (!isdigit(UCHAR(*p))) {
		    break;
		}
		count = 3;
		result = (char)((result << 3) + (*p - '0'));
		p++;
		if (!isdigit(UCHAR(*p))) {
		    break;
		}
		count = 4;
		result = (char)((result << 3) + (*p - '0'));
		break;
	    }
	    result = *p;
	    count = 2;
	    break;
    }

    if (readPtr != NULL) {
	*readPtr = count;
    }
    return result;
}

/*
 *--------------------------------------------------------------
 *
 * TclParseQuotes --
 *
 *	This procedure parses a double-quoted string such as a
 *	quoted Tcl command argument or a quoted value in a Tcl
 *	expression.  This procedure is also used to parse array
 *	element names within parentheses, or anything else that
 *	needs all the substitutions that happen in quotes.
 *
 * Results:
 *	The return value is a standard Tcl result, which is
 *	TCL_OK unless there was an error while parsing the
 *	quoted string.  If an error occurs then interp->result
 *	contains a standard error message.  *TermPtr is filled
 *	in with the address of the character just after the
 *	last one successfully processed;  this is usually the
 *	character just after the matching close-quote.  The
 *	fully-substituted contents of the quotes are stored in
 *	standard fashion in *pvPtr, null-terminated with
 *	pvPtr->next pointing to the terminating null character.
 *
 * Side effects:
 *	The buffer space in pvPtr may be enlarged by calling its
 *	expandProc.
 *
 *--------------------------------------------------------------
 */

int
TclParseQuotes(interp, string, termChar, flags, termPtr, pvPtr)
    Tcl_Interp *interp;		/* Interpreter to use for nested command
				 * evaluations and error messages. */
    char *string;		/* Character just after opening double-
				 * quote. */
    int termChar;		/* Character that terminates "quoted" string
				 * (usually double-quote, but sometimes
				 * right-paren or something else). */
    int flags;			/* Flags to pass to nested Tcl_Eval calls. */
    char **termPtr;		/* Store address of terminating character
				 * here. */
    ParseValue *pvPtr;		/* Information about where to place
				 * fully-substituted result of parse. */
{
    register char *src, *dst, c;

    src = string;
    dst = pvPtr->next;

    while (1) {
	if (dst == pvPtr->end) {
	    /*
	     * Target buffer space is about to run out.  Make more space.
	     */

	    pvPtr->next = dst;
	    (*pvPtr->expandProc)(pvPtr, 1);
	    dst = pvPtr->next;
	}

	c = *src;
	src++;
	if (c == termChar) {
	    *dst = '\0';
	    pvPtr->next = dst;
	    *termPtr = src;
	    return TCL_OK;
	} else if (CHAR_TYPE(c) == TCL_NORMAL) {
	    copy:
	    *dst = c;
	    dst++;
	    continue;
	} else if (c == '$') {
	    int length;
	    char *value;

	    value = Tcl_ParseVar(interp, src-1, termPtr);
	    if (value == NULL) {
		return TCL_ERROR;
	    }
	    src = *termPtr;
	    length = strlen(value);
	    if ((pvPtr->end - dst) <= length) {
		pvPtr->next = dst;
		(*pvPtr->expandProc)(pvPtr, length);
		dst = pvPtr->next;
	    }
	    strcpy(dst, value);
	    dst += length;
	    continue;
	} else if (c == '[') {
	    int result;

	    pvPtr->next = dst;
	    result = TclParseNestedCmd(interp, src, flags, termPtr, pvPtr);
	    if (result != TCL_OK) {
		return result;
	    }
	    src = *termPtr;
	    dst = pvPtr->next;
	    continue;
	} else if (c == '\\') {
	    int numRead;

	    src--;
	    *dst = Tcl_Backslash(src, &numRead);
	    dst++;
	    src += numRead;
	    continue;
	} else if (c == '\0') {
	    Tcl_ResetResult(interp);
	    sprintf(interp->result, "missing %c", termChar);
	    *termPtr = string-1;
	    return TCL_ERROR;
	} else {
	    goto copy;
	}
    }
}

/*
 *--------------------------------------------------------------
 *
 * TclParseNestedCmd --
 *
 *	This procedure parses a nested Tcl command between
 *	brackets, returning the result of the command.
 *
 * Results:
 *	The return value is a standard Tcl result, which is
 *	TCL_OK unless there was an error while executing the
 *	nested command.  If an error occurs then interp->result
 *	contains a standard error message.  *TermPtr is filled
 *	in with the address of the character just after the
 *	last one processed;  this is usually the character just
 *	after the matching close-bracket, or the null character
 *	at the end of the string if the close-bracket was missing
 *	(a missing close bracket is an error).  The result returned
 *	by the command is stored in standard fashion in *pvPtr,
 *	null-terminated, with pvPtr->next pointing to the null
 *	character.
 *
 * Side effects:
 *	The storage space at *pvPtr may be expanded.
 *
 *--------------------------------------------------------------
 */

int
TclParseNestedCmd(interp, string, flags, termPtr, pvPtr)
    Tcl_Interp *interp;		/* Interpreter to use for nested command
				 * evaluations and error messages. */
    char *string;		/* Character just after opening bracket. */
    int flags;			/* Flags to pass to nested Tcl_Eval. */
    char **termPtr;		/* Store address of terminating character
				 * here. */
    register ParseValue *pvPtr;	/* Information about where to place
				 * result of command. */
{
    int result, length, shortfall;
    Interp *iPtr = (Interp *) interp;

    iPtr->evalFlags = flags | TCL_BRACKET_TERM;
    result = Tcl_Eval(interp, string);
    *termPtr = iPtr->termPtr;
    if (result != TCL_OK) {
	/*
	 * The increment below results in slightly cleaner message in
	 * the errorInfo variable (the close-bracket will appear).
	 */

	if (**termPtr == ']') {
	    *termPtr += 1;
	}
	return result;
    }
    (*termPtr) += 1;
    length = strlen(iPtr->result);
    shortfall = length + 1 - (pvPtr->end - pvPtr->next);
    if (shortfall > 0) {
	(*pvPtr->expandProc)(pvPtr, shortfall);
    }
    strcpy(pvPtr->next, iPtr->result);
    pvPtr->next += length;
    Tcl_FreeResult(iPtr);
    iPtr->result = iPtr->resultSpace;
    iPtr->resultSpace[0] = '\0';
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * TclParseBraces --
 *
 *	This procedure scans the information between matching
 *	curly braces.
 *
 * Results:
 *	The return value is a standard Tcl result, which is
 *	TCL_OK unless there was an error while parsing string.
 *	If an error occurs then interp->result contains a
 *	standard error message.  *TermPtr is filled
 *	in with the address of the character just after the
 *	last one successfully processed;  this is usually the
 *	character just after the matching close-brace.  The
 *	information between curly braces is stored in standard
 *	fashion in *pvPtr, null-terminated with pvPtr->next
 *	pointing to the terminating null character.
 *
 * Side effects:
 *	The storage space at *pvPtr may be expanded.
 *
 *--------------------------------------------------------------
 */

int
TclParseBraces(interp, string, termPtr, pvPtr)
    Tcl_Interp *interp;		/* Interpreter to use for nested command
				 * evaluations and error messages. */
    char *string;		/* Character just after opening bracket. */
    char **termPtr;		/* Store address of terminating character
				 * here. */
    register ParseValue *pvPtr;	/* Information about where to place
				 * result of command. */
{
    int level;
    register char *src, *dst, *end;
    register char c;

    src = string;
    dst = pvPtr->next;
    end = pvPtr->end;
    level = 1;

    /*
     * Copy the characters one at a time to the result area, stopping
     * when the matching close-brace is found.
     */

    while (1) {
	c = *src;
	src++;
	if (dst == end) {
	    pvPtr->next = dst;
	    (*pvPtr->expandProc)(pvPtr, 20);
	    dst = pvPtr->next;
	    end = pvPtr->end;
	}
	*dst = c;
	dst++;
	if (CHAR_TYPE(c) == TCL_NORMAL) {
	    continue;
	} else if (c == '{') {
	    level++;
	} else if (c == '}') {
	    level--;
	    if (level == 0) {
		dst--;			/* Don't copy the last close brace. */
		break;
	    }
	} else if (c == '\\') {
	    int count;

	    /*
	     * Must always squish out backslash-newlines, even when in
	     * braces.  This is needed so that this sequence can appear
	     * anywhere in a command, such as the middle of an expression.
	     */

	    if (*src == '\n') {
		dst[-1] = Tcl_Backslash(src-1, &count);
		src += count - 1;
	    } else {
		(void) Tcl_Backslash(src-1, &count);
		while (count > 1) {
                    if (dst == end) {
                        pvPtr->next = dst;
                        (*pvPtr->expandProc)(pvPtr, 20);
                        dst = pvPtr->next;
                        end = pvPtr->end;
                    }
		    *dst = *src;
		    dst++;
		    src++;
		    count--;
		}
	    }
	} else if (c == '\0') {
	    Tcl_SetResult(interp, "missing close-brace", TCL_STATIC);
	    *termPtr = string-1;
	    return TCL_ERROR;
	}
    }

    *dst = '\0';
    pvPtr->next = dst;
    *termPtr = src;
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * TclParseWords --
 *
 *	This procedure parses one or more words from a command
 *	string and creates argv-style pointers to fully-substituted
 *	copies of those words.
 *
 * Results:
 *	The return value is a standard Tcl result.
 *	
 *	*argcPtr is modified to hold a count of the number of words
 *	successfully parsed, which may be 0.  At most maxWords words
 *	will be parsed.  If 0 <= *argcPtr < maxWords then it
 *	means that a command separator was seen.  If *argcPtr
 *	is maxWords then it means that a command separator was
 *	not seen yet.
 *
 *	*TermPtr is filled in with the address of the character
 *	just after the last one successfully processed in the
 *	last word.  This is either the command terminator (if
 *	*argcPtr < maxWords), the character just after the last
 *	one in a word (if *argcPtr is maxWords), or the vicinity
 *	of an error (if the result is not TCL_OK).
 *	
 *	The pointers at *argv are filled in with pointers to the
 *	fully-substituted words, and the actual contents of the
 *	words are copied to the buffer at pvPtr.
 *
 *	If an error occurrs then an error message is left in
 *	interp->result and the information at *argv, *argcPtr,
 *	and *pvPtr may be incomplete.
 *
 * Side effects:
 *	The buffer space in pvPtr may be enlarged by calling its
 *	expandProc.
 *
 *--------------------------------------------------------------
 */

int
TclParseWords(interp, string, flags, maxWords, termPtr, argcPtr, argv, pvPtr)
    Tcl_Interp *interp;		/* Interpreter to use for nested command
				 * evaluations and error messages. */
    char *string;		/* First character of word. */
    int flags;			/* Flags to control parsing (same values as
				 * passed to Tcl_Eval). */
    int maxWords;		/* Maximum number of words to parse. */
    char **termPtr;		/* Store address of terminating character
				 * here. */
    int *argcPtr;		/* Filled in with actual number of words
				 * parsed. */
    char **argv;		/* Store addresses of individual words here. */
    register ParseValue *pvPtr;	/* Information about where to place
				 * fully-substituted word. */
{
    register char *src, *dst;
    register char c;
    int type, result, argc;
    char *oldBuffer;		/* Used to detect when pvPtr's buffer gets
				 * reallocated, so we can adjust all of the
				 * argv pointers. */

    src = string;
    oldBuffer = pvPtr->buffer;
    dst = pvPtr->next;
    for (argc = 0; argc < maxWords; argc++) {
	argv[argc] = dst;

	/*
	 * Skip leading space.
	 */
    
	skipSpace:
	c = *src;
	type = CHAR_TYPE(c);
	while (type == TCL_SPACE) {
	    src++;
	    c = *src;
	    type = CHAR_TYPE(c);
	}
    
	/*
	 * Handle the normal case (i.e. no leading double-quote or brace).
	 */

	if (type == TCL_NORMAL) {
	    normalArg:
	    while (1) {
		if (dst == pvPtr->end) {
		    /*
		     * Target buffer space is about to run out.  Make
		     * more space.
		     */
	
		    pvPtr->next = dst;
		    (*pvPtr->expandProc)(pvPtr, 1);
		    dst = pvPtr->next;
		}
	
		if (type == TCL_NORMAL) {
		    copy:
		    *dst = c;
		    dst++;
		    src++;
		} else if (type == TCL_SPACE) {
		    goto wordEnd;
		} else if (type == TCL_DOLLAR) {
		    int length;
		    char *value;
	
		    value = Tcl_ParseVar(interp, src, termPtr);
		    if (value == NULL) {
			return TCL_ERROR;
		    }
		    src = *termPtr;
		    length = strlen(value);
		    if ((pvPtr->end - dst) <= length) {
			pvPtr->next = dst;
			(*pvPtr->expandProc)(pvPtr, length);
			dst = pvPtr->next;
		    }
		    strcpy(dst, value);
		    dst += length;
		} else if (type == TCL_COMMAND_END) {
		    if ((c == ']') && !(flags & TCL_BRACKET_TERM)) {
			goto copy;
		    }

		    /*
		     * End of command;  simulate a word-end first, so
		     * that the end-of-command can be processed as the
		     * first thing in a new word.
		     */

		    goto wordEnd;
		} else if (type == TCL_OPEN_BRACKET) {
		    pvPtr->next = dst;
		    result = TclParseNestedCmd(interp, src+1, flags, termPtr,
			    pvPtr);
		    if (result != TCL_OK) {
			return result;
		    }
		    src = *termPtr;
		    dst = pvPtr->next;
		} else if (type == TCL_BACKSLASH) {
		    int numRead;
    
		    *dst = Tcl_Backslash(src, &numRead);

		    /*
		     * The following special check allows a backslash-newline
		     * to be treated as a word-separator, as if the backslash
		     * and newline had been collapsed before command parsing
		     * began.
		     */

		    if (src[1] == '\n') {
			src += numRead;
			goto wordEnd;
		    }
		    src += numRead;
		    dst++;
		} else {
		    goto copy;
		}
		c = *src;
		type = CHAR_TYPE(c);
	    }
	} else {
    
	    /*
	     * Check for the end of the command.
	     */
	
	    if (type == TCL_COMMAND_END) {
		if (flags & TCL_BRACKET_TERM) {
		    if (c == '\0') {
			Tcl_SetResult(interp, "missing close-bracket",
				TCL_STATIC);
			return TCL_ERROR;
		    }
		} else {
		    if (c == ']') {
			goto normalArg;
		    }
		}
		goto done;
	    }
	
	    /*
	     * Now handle the special cases: open braces, double-quotes,
	     * and backslash-newline.
	     */

	    pvPtr->next = dst;
	    if (type == TCL_QUOTE) {
		result = TclParseQuotes(interp, src+1, '"', flags,
			termPtr, pvPtr);
	    } else if (type == TCL_OPEN_BRACE) {
		result = TclParseBraces(interp, src+1, termPtr, pvPtr);
	    } else if ((type == TCL_BACKSLASH) && (src[1] == '\n')) {
		/*
		 * This code is needed so that a backslash-newline at the
		 * very beginning of a word is treated as part of the white
		 * space between words and not as a space within the word.
		 */

		src += 2;
		goto skipSpace;
	    } else {
		goto normalArg;
	    }
	    if (result != TCL_OK) {
		return result;
	    }
	
	    /*
	     * Back from quotes or braces;  make sure that the terminating
	     * character was the end of the word.
	     */
	
	    c = **termPtr;
	    if ((c == '\\') && ((*termPtr)[1] == '\n')) {
		/*
		 * Line is continued on next line;  the backslash-newline
		 * sequence turns into space, which is OK.  No need to do
		 * anything here.
		 */
	    } else {
		type = CHAR_TYPE(c);
		if ((type != TCL_SPACE) && (type != TCL_COMMAND_END)) {
		    if (*src == '"') {
			Tcl_SetResult(interp,
				"extra characters after close-quote",
				TCL_STATIC);
		    } else {
			Tcl_SetResult(interp,
				"extra characters after close-brace",
				TCL_STATIC);
		    }
		    return TCL_ERROR;
		}
	    }
	    src = *termPtr;
	    dst = pvPtr->next;
	}

	/*
	 * We're at the end of a word, so add a null terminator.  Then
	 * see if the buffer was re-allocated during this word.  If so,
	 * update all of the argv pointers.
	 */

	wordEnd:
	*dst = '\0';
	dst++;
	if (oldBuffer != pvPtr->buffer) {
	    int i;

	    for (i = 0; i <= argc; i++) {
		argv[i] = pvPtr->buffer + (argv[i] - oldBuffer);
	    }
	    oldBuffer = pvPtr->buffer;
	}
    }

    done:
    pvPtr->next = dst;
    *termPtr = src;
    *argcPtr = argc;
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * TclExpandParseValue --
 *
 *	This procedure is commonly used as the value of the
 *	expandProc in a ParseValue.  It uses malloc to allocate
 *	more space for the result of a parse.
 *
 * Results:
 *	The buffer space in *pvPtr is reallocated to something
 *	larger, and if pvPtr->clientData is non-zero the old
 *	buffer is freed.  Information is copied from the old
 *	buffer to the new one.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

void
TclExpandParseValue(pvPtr, needed)
    register ParseValue *pvPtr;		/* Information about buffer that
					 * must be expanded.  If the clientData
					 * in the structure is non-zero, it
					 * means that the current buffer is
					 * dynamically allocated. */
    int needed;				/* Minimum amount of additional space
					 * to allocate. */
{
    int newSpace;
    char *new;

    /*
     * Either double the size of the buffer or add enough new space
     * to meet the demand, whichever produces a larger new buffer.
     */

    newSpace = (pvPtr->end - pvPtr->buffer) + 1;
    if (newSpace < needed) {
	newSpace += needed;
    } else {
	newSpace += newSpace;
    }
    new = (char *) ckalloc((unsigned) newSpace);

    /*
     * Copy from old buffer to new, free old buffer if needed, and
     * mark new buffer as malloc-ed.
     */

    memcpy((VOID *) new, (VOID *) pvPtr->buffer,
	    (size_t) (pvPtr->next - pvPtr->buffer));
    pvPtr->next = new + (pvPtr->next - pvPtr->buffer);
    if (pvPtr->clientData != 0) {
	ckfree(pvPtr->buffer);
    }
    pvPtr->buffer = new;
    pvPtr->end = new + newSpace - 1;
    pvPtr->clientData = (ClientData) 1;
}

/*
 *----------------------------------------------------------------------
 *
 * TclWordEnd --
 *
 *	Given a pointer into a Tcl command, find the end of the next
 *	word of the command.
 *
 * Results:
 *	The return value is a pointer to the last character that's part
 *	of the word pointed to by "start".  If the word doesn't end
 *	properly within the string then the return value is the address
 *	of the null character at the end of the string.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

char *
TclWordEnd(start, nested, semiPtr)
    char *start;		/* Beginning of a word of a Tcl command. */
    int nested;			/* Zero means this is a top-level command.
				 * One means this is a nested command (close
				 * bracket is a word terminator). */
    int *semiPtr;		/* Set to 1 if word ends with a command-
				 * terminating semi-colon, zero otherwise.
				 * If NULL then ignored. */
{
    register char *p;
    int count;

    if (semiPtr != NULL) {
	*semiPtr = 0;
    }

    /*
     * Skip leading white space (backslash-newline must be treated like
     * white-space, except that it better not be the last thing in the
     * command).
     */

    for (p = start; ; p++) {
	if (isspace(UCHAR(*p))) {
	    continue;
	}
	if ((p[0] == '\\') && (p[1] == '\n')) {
	    if (p[2] == 0) {
		return p+2;
	    }
	    continue;
	}
	break;
    }

    /*
     * Handle words beginning with a double-quote or a brace.
     */

    if (*p == '"') {
	p = QuoteEnd(p+1, '"');
	if (*p == 0) {
	    return p;
	}
	p++;
    } else if (*p == '{') {
	int braces = 1;
	while (braces != 0) {
	    p++;
	    while (*p == '\\') {
		(void) Tcl_Backslash(p, &count);
		p += count;
	    }
	    if (*p == '}') {
		braces--;
	    } else if (*p == '{') {
		braces++;
	    } else if (*p == 0) {
		return p;
	    }
	}
	p++;
    }

    /*
     * Handle words that don't start with a brace or double-quote.
     * This code is also invoked if the word starts with a brace or
     * double-quote and there is garbage after the closing brace or
     * quote.  This is an error as far as Tcl_Eval is concerned, but
     * for here the garbage is treated as part of the word.
     */

    while (1) {
	if (*p == '[') {
	    p = ScriptEnd(p+1, 1);
	    if (*p == 0) {
		return p;
	    }
	    p++;
	} else if (*p == '\\') {
	    if (p[1] == '\n') {
		/*
		 * Backslash-newline:  it maps to a space character
		 * that is a word separator, so the word ends just before
		 * the backslash.
		 */

		return p-1;
	    }
	    (void) Tcl_Backslash(p, &count);
	    p += count;
	} else if (*p == '$') {
	    p = VarNameEnd(p);
	    if (*p == 0) {
		return p;
	    }
	    p++;
	} else if (*p == ';') {
	    /*
	     * Include the semi-colon in the word that is returned.
	     */

	    if (semiPtr != NULL) {
		*semiPtr = 1;
	    }
	    return p;
	} else if (isspace(UCHAR(*p))) {
	    return p-1;
	} else if ((*p == ']') && nested) {
	    return p-1;
	} else if (*p == 0) {
	    if (nested) {
		/*
		 * Nested commands can't end because of the end of the
		 * string.
		 */
		return p;
	    }
	    return p-1;
	} else {
	    p++;
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * QuoteEnd --
 *
 *	Given a pointer to a string that obeys the parsing conventions
 *	for quoted things in Tcl, find the end of that quoted thing.
 *	The actual thing may be a quoted argument or a parenthesized
 *	index name.
 *
 * Results:
 *	The return value is a pointer to the last character that is
 *	part of the quoted string (i.e the character that's equal to
 *	term).  If the quoted string doesn't terminate properly then
 *	the return value is a pointer to the null character at the
 *	end of the string.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static char *
QuoteEnd(string, term)
    char *string;		/* Pointer to character just after opening
				 * "quote". */
    int term;			/* This character will terminate the
				 * quoted string (e.g. '"' or ')'). */
{
    register char *p = string;
    int count;

    while (*p != term) {
	if (*p == '\\') {
	    (void) Tcl_Backslash(p, &count);
	    p += count;
	} else if (*p == '[') {
	    for (p++; *p != ']'; p++) {
		p = TclWordEnd(p, 1, (int *) NULL);
		if (*p == 0) {
		    return p;
		}
	    }
	    p++;
	} else if (*p == '$') {
	    p = VarNameEnd(p);
	    if (*p == 0) {
		return p;
	    }
	    p++;
	} else if (*p == 0) {
	    return p;
	} else {
	    p++;
	}
    }
    return p-1;
}

/*
 *----------------------------------------------------------------------
 *
 * VarNameEnd --
 *
 *	Given a pointer to a variable reference using $-notation, find
 *	the end of the variable name spec.
 *
 * Results:
 *	The return value is a pointer to the last character that
 *	is part of the variable name.  If the variable name doesn't
 *	terminate properly then the return value is a pointer to the
 *	null character at the end of the string.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static char *
VarNameEnd(string)
    char *string;		/* Pointer to dollar-sign character. */
{
    register char *p = string+1;

    if (*p == '{') {
	for (p++; (*p != '}') && (*p != 0); p++) {
	    /* Empty loop body. */
	}
	return p;
    }
    while (isalnum(UCHAR(*p)) || (*p == '_')) {
	p++;
    }
    if ((*p == '(') && (p != string+1)) {
	return QuoteEnd(p+1, ')');
    }
    return p-1;
}


/*
 *----------------------------------------------------------------------
 *
 * ScriptEnd --
 *
 *	Given a pointer to the beginning of a Tcl script, find the end of
 *	the script.
 *
 * Results:
 *	The return value is a pointer to the last character that's part
 *	of the script pointed to by "p".  If the command doesn't end
 *	properly within the string then the return value is the address
 *	of the null character at the end of the string.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static char *
ScriptEnd(p, nested)
    char *p;			/* Script to check. */
    int nested;			/* Zero means this is a top-level command.
				 * One means this is a nested command (the
				 * last character of the script must be
				 * an unquoted ]). */
{
    int commentOK = 1;
    int length;

    while (1) {
	while (isspace(UCHAR(*p))) {
	    if (*p == '\n') {
		commentOK = 1;
	    }
	    p++;
	}
	if ((*p == '#') && commentOK) {
	    do {
		if (*p == '\\') {
		    /*
		     * If the script ends with backslash-newline, then
		     * this command isn't complete.
		     */

		    if ((p[1] == '\n') && (p[2] == 0)) {
			return p+2;
		    }
		    Tcl_Backslash(p, &length);
		    p += length;
		} else {
		    p++;
		}
	    } while ((*p != 0) && (*p != '\n'));
	    continue;
	}
	p = TclWordEnd(p, nested, &commentOK);
	if (*p == 0) {
	    return p;
	}
	p++;
	if (nested) {
	    if (*p == ']') {
		return p;
	    }
	} else {
	    if (*p == 0) {
		return p-1;
	    }
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ParseVar --
 *
 *	Given a string starting with a $ sign, parse off a variable
 *	name and return its value.
 *
 * Results:
 *	The return value is the contents of the variable given by
 *	the leading characters of string.  If termPtr isn't NULL,
 *	*termPtr gets filled in with the address of the character
 *	just after the last one in the variable specifier.  If the
 *	variable doesn't exist, then the return value is NULL and
 *	an error message will be left in interp->result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

char *
Tcl_ParseVar(interp, string, termPtr)
    Tcl_Interp *interp;			/* Context for looking up variable. */
    register char *string;		/* String containing variable name.
					 * First character must be "$". */
    char **termPtr;			/* If non-NULL, points to word to fill
					 * in with character just after last
					 * one in the variable specifier. */

{
    char *name1, *name1End, c, *result;
    register char *name2;
#define NUM_CHARS 200
    char copyStorage[NUM_CHARS];
    ParseValue pv;

    /*
     * There are three cases:
     * 1. The $ sign is followed by an open curly brace.  Then the variable
     *    name is everything up to the next close curly brace, and the
     *    variable is a scalar variable.
     * 2. The $ sign is not followed by an open curly brace.  Then the
     *    variable name is everything up to the next character that isn't
     *    a letter, digit, or underscore.  If the following character is an
     *    open parenthesis, then the information between parentheses is
     *    the array element name, which can include any of the substitutions
     *    permissible between quotes.
     * 3. The $ sign is followed by something that isn't a letter, digit,
     *    or underscore:  in this case, there is no variable name, and "$"
     *    is returned.
     */

    name2 = NULL;
    string++;
    if (*string == '{') {
	string++;
	name1 = string;
	while (*string != '}') {
	    if (*string == 0) {
		Tcl_SetResult(interp, "missing close-brace for variable name",
			TCL_STATIC);
		if (termPtr != 0) {
		    *termPtr = string;
		}
		return NULL;
	    }
	    string++;
	}
	name1End = string;
	string++;
    } else {
	name1 = string;
	while (isalnum(UCHAR(*string)) || (*string == '_')) {
	    string++;
	}
	if (string == name1) {
	    if (termPtr != 0) {
		*termPtr = string;
	    }
	    return "$";
	}
	name1End = string;
	if (*string == '(') {
	    char *end;

	    /*
	     * Perform substitutions on the array element name, just as
	     * is done for quotes.
	     */

	    pv.buffer = pv.next = copyStorage;
	    pv.end = copyStorage + NUM_CHARS - 1;
	    pv.expandProc = TclExpandParseValue;
	    pv.clientData = (ClientData) NULL;
	    if (TclParseQuotes(interp, string+1, ')', 0, &end, &pv)
		    != TCL_OK) {
		char msg[200];
		int length;

		length = string-name1;
		if (length > 100) {
		    length = 100;
		}
		sprintf(msg, "\n    (parsing index for array \"%.*s\")",
			length, name1);
		Tcl_AddErrorInfo(interp, msg);
		result = NULL;
		name2 = pv.buffer;
		if (termPtr != 0) {
		    *termPtr = end;
		}
		goto done;
	    }
	    Tcl_ResetResult(interp);
	    string = end;
	    name2 = pv.buffer;
	}
    }
    if (termPtr != 0) {
	*termPtr = string;
    }

    if (((Interp *) interp)->noEval) {
	return "";
    }
    c = *name1End;
    *name1End = 0;
    result = Tcl_GetVar2(interp, name1, name2, TCL_LEAVE_ERR_MSG);
    *name1End = c;

    done:
    if ((name2 != NULL) && (pv.buffer != copyStorage)) {
	ckfree(pv.buffer);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CommandComplete --
 *
 *	Given a partial or complete Tcl command, this procedure
 *	determines whether the command is complete in the sense
 *	of having matched braces and quotes and brackets.
 *
 * Results:
 *	1 is returned if the command is complete, 0 otherwise.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_CommandComplete(cmd)
    char *cmd;			/* Command to check. */
{
    char *p;

    if (*cmd == 0) {
	return 1;
    }
    p = ScriptEnd(cmd, 0);
    return (*p != 0);
}