aboutsummaryrefslogtreecommitdiff
path: root/contrib/tcl/generic/tclParse.c
diff options
context:
space:
mode:
Diffstat (limited to 'contrib/tcl/generic/tclParse.c')
-rw-r--r--contrib/tcl/generic/tclParse.c1386
1 files changed, 1386 insertions, 0 deletions
diff --git a/contrib/tcl/generic/tclParse.c b/contrib/tcl/generic/tclParse.c
new file mode 100644
index 000000000000..656e218600b1
--- /dev/null
+++ b/contrib/tcl/generic/tclParse.c
@@ -0,0 +1,1386 @@
+/*
+ * 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.50 96/03/02 14:46:55
+ */
+
+#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) {
+ case 'a':
+ result = 0x7; /* Don't say '\a' here, since some compilers */
+ break; /* don't support it. */
+ case 'b':
+ result = '\b';
+ break;
+ case 'f':
+ result = '\f';
+ break;
+ case 'n':
+ result = '\n';
+ break;
+ case 'r':
+ result = '\r';
+ break;
+ case 't':
+ result = '\t';
+ break;
+ case 'v':
+ result = '\v';
+ 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);
+}
generated by cgit v1.2.3 (git 2.25.1) at 2025-04-13 20:57:40 +0000