diff options
author | joye <joye> | 2013-08-27 18:44:24 (GMT) |
---|---|---|
committer | joye <joye> | 2013-08-27 18:44:24 (GMT) |
commit | 48974a09f23839821ca95f228fc0f3f53bb1cefa (patch) | |
tree | 9d5cfa1305ef57b69c9b1dd09dc3ffe536c0777d /src/bltParse.C | |
parent | 05d8c009040abfcb5f62644fbb99c8ff453d4519 (diff) | |
download | blt-48974a09f23839821ca95f228fc0f3f53bb1cefa.zip blt-48974a09f23839821ca95f228fc0f3f53bb1cefa.tar.gz blt-48974a09f23839821ca95f228fc0f3f53bb1cefa.tar.bz2 |
*** empty log message ***
Diffstat (limited to 'src/bltParse.C')
-rw-r--r-- | src/bltParse.C | 546 |
1 files changed, 546 insertions, 0 deletions
diff --git a/src/bltParse.C b/src/bltParse.C new file mode 100644 index 0000000..10703f3 --- /dev/null +++ b/src/bltParse.C @@ -0,0 +1,546 @@ + +/* + * bltParse.c -- + * + * Contains a collection of procedures that are used to parse Tcl + * commands or parts of commands (like quoted strings or nested + * sub-commands). + * + * This file is copied from tclParse.c in the TCL library distribution. + * + * Copyright (c) 1987-1993 The Regents of the University of + * California. + * + * Copyright (c) 1994-1998 Sun Microsystems, Inc. + * + */ + +/* + * Since TCL 8.1.0 these routines have been replaced by ones that + * generate byte-codes. But since these routines are used in vector + * expressions, where no such byte-compilation is necessary, I now + * include them. In fact, the byte-compiled versions would be slower + * since the compiled code typically runs only one time. + */ +#include <bltInt.h> + +#include "bltParse.h" + +/* + * A table used to classify input characters to assist in parsing + * TCL commands. The table should be indexed with a signed character + * using the CHAR_TYPE macro. The character may have a negative + * value. The CHAR_TYPE macro takes a pointer to a signed character + * and a pointer to the last character in the source string. If the + * src pointer is pointing at the terminating null of the string, + * CHAR_TYPE returns TCL_COMMAND_END. + */ + +#define STATIC_STRING_SPACE 150 +#define UCHAR(c) ((unsigned char) (c)) +#define TCL_NORMAL 0x01 +#define TCL_SPACE 0x02 +#define TCL_COMMAND_END 0x04 +#define TCL_QUOTE 0x08 +#define TCL_OPEN_BRACKET 0x10 +#define TCL_OPEN_BRACE 0x20 +#define TCL_CLOSE_BRACE 0x40 +#define TCL_BACKSLASH 0x80 +#define TCL_DOLLAR 0x00 + +/* + * 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). + */ + +static unsigned 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_NORMAL, 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, +}; + +#define CHAR_TYPE(src,last) \ + (((src)==(last))?TCL_COMMAND_END:(tclTypeTable+128)[(int)*(src)]) + +/* + *--------------------------------------------------------------------------- + * + * Blt_ParseNestedCmd -- + * + * 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 *parsePtr, + * null-terminated, with parsePtr->next pointing to the null + * character. + * + * Side effects: + * The storage space at *parsePtr may be expanded. + * + *--------------------------------------------------------------------------- + */ +int +Blt_ParseNestedCmd( + Tcl_Interp *interp, /* Interpreter to use for nested command + * evaluations and error messages. */ + const char *string, /* Character just after opening bracket. */ + int flags, /* Flags to pass to nested Tcl_Eval. */ + const char **termPtr, /* Store address of terminating character + * here. */ + ParseValue *parsePtr) /* 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 = (string + iPtr->termOffset); + 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 = (int)strlen(iPtr->result); + shortfall = length + 1 - (parsePtr->end - parsePtr->next); + if (shortfall > 0) { + (*parsePtr->expandProc) (parsePtr, shortfall); + } + strcpy(parsePtr->next, iPtr->result); + parsePtr->next += length; + + Tcl_FreeResult(interp); + iPtr->result = iPtr->resultSpace; + iPtr->resultSpace[0] = '\0'; + return TCL_OK; +} + +/* + *--------------------------------------------------------------------------- + * + * Blt_ParseBraces -- + * + * 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 *parsePtr, null-terminated with parsePtr->next + * pointing to the terminating null character. + * + * Side effects: + * The storage space at *parsePtr may be expanded. + * + *--------------------------------------------------------------------------- + */ + +int +Blt_ParseBraces( + Tcl_Interp *interp, /* Interpreter to use for nested command + * evaluations and error messages. */ + const char *string, /* Character just after opening bracket. */ + const char **termPtr, /* Store address of terminating character + * here. */ + ParseValue *parsePtr) /* Information about where to place + * result of command. */ +{ + int level; + const char *src; + char *dest, *end; + char c; + const char *lastChar = string + strlen(string); + + src = string; + dest = parsePtr->next; + end = parsePtr->end; + level = 1; + + /* + * Copy the characters one at a time to the result area, stopping + * when the matching close-brace is found. + */ + + for (;;) { + c = *src; + src++; + + if (dest == end) { + parsePtr->next = dest; + (*parsePtr->expandProc) (parsePtr, 20); + dest = parsePtr->next; + end = parsePtr->end; + } + *dest = c; + dest++; + + if (CHAR_TYPE(src - 1, lastChar) == TCL_NORMAL) { + continue; + } else if (c == '{') { + level++; + } else if (c == '}') { + level--; + if (level == 0) { + dest--; /* 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') { + dest[-1] = Tcl_Backslash(src - 1, &count); + src += count - 1; + } else { + Tcl_Backslash(src - 1, &count); + while (count > 1) { + if (dest == end) { + parsePtr->next = dest; + (*parsePtr->expandProc) (parsePtr, 20); + dest = parsePtr->next; + end = parsePtr->end; + } + *dest = *src; + dest++; + src++; + count--; + } + } + } else if (c == '\0') { + Tcl_AppendResult(interp, "missing close-brace", (char *)NULL); + *termPtr = string - 1; + return TCL_ERROR; + } + } + + *dest = '\0'; + parsePtr->next = dest; + *termPtr = src; + return TCL_OK; +} + +/* + *--------------------------------------------------------------------------- + * + * Blt_ExpandParseValue -- + * + * 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 *parsePtr is reallocated to something + * larger, and if parsePtr->clientData is non-zero the old + * buffer is freed. Information is copied from the old + * buffer to the new one. + * + * Side effects: + * None. + * + *--------------------------------------------------------------------------- + */ +void +Blt_ExpandParseValue( + ParseValue *parsePtr, /* 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 size; + char *buffer; + + /* + * Either double the size of the buffer or add enough new space + * to meet the demand, whichever produces a larger new buffer. + */ + size = (parsePtr->end - parsePtr->buffer) + 1; + if (size < needed) { + size += needed; + } else { + size += size; + } + buffer = Blt_AssertMalloc((unsigned int)size); + + /* + * Copy from old buffer to new, free old buffer if needed, and + * mark new buffer as malloc-ed. + */ + memcpy((VOID *) buffer, (VOID *) parsePtr->buffer, + (size_t) (parsePtr->next - parsePtr->buffer)); + parsePtr->next = buffer + (parsePtr->next - parsePtr->buffer); + if (parsePtr->clientData != 0) { + Blt_Free(parsePtr->buffer); + } + parsePtr->buffer = buffer; + parsePtr->end = buffer + size - 1; + parsePtr->clientData = (ClientData)1; +} + +/* + *--------------------------------------------------------------------------- + * + * Blt_ParseQuotes -- + * + * 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 *parsePtr, null-terminated with + * parsePtr->next pointing to the terminating null character. + * + * Side effects: + * The buffer space in parsePtr may be enlarged by calling its + * expandProc. + * + *--------------------------------------------------------------------------- + */ +int +Blt_ParseQuotes( + Tcl_Interp *interp, /* Interpreter to use for nested command + * evaluations and error messages. */ + const 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. */ + const char **termPtr, /* Store address of terminating character + * here. */ + ParseValue *parsePtr) /* Information about where to place + * fully-substituted result of parse. */ +{ + const char *src; + char *dest, c; + const char *lastChar = string + strlen(string); + + src = string; + dest = parsePtr->next; + + for (;;) { + if (dest == parsePtr->end) { + /* + * Target buffer space is about to run out. Make more space. + */ + parsePtr->next = dest; + (*parsePtr->expandProc) (parsePtr, 1); + dest = parsePtr->next; + } + c = *src; + src++; + if (c == termChar) { + *dest = '\0'; + parsePtr->next = dest; + *termPtr = src; + return TCL_OK; + } else if (CHAR_TYPE(src - 1, lastChar) == TCL_NORMAL) { + copy: + *dest = c; + dest++; + continue; + } else if (c == '$') { + int length; + const char *value; + + value = Tcl_ParseVar(interp, src - 1, termPtr); + if (value == NULL) { + return TCL_ERROR; + } + src = *termPtr; + length = strlen(value); + if ((parsePtr->end - dest) <= length) { + parsePtr->next = dest; + (*parsePtr->expandProc) (parsePtr, length); + dest = parsePtr->next; + } + strcpy(dest, value); + dest += length; + continue; + } else if (c == '[') { + int result; + + parsePtr->next = dest; + result = Blt_ParseNestedCmd(interp, src, flags, termPtr, parsePtr); + if (result != TCL_OK) { + return result; + } + src = *termPtr; + dest = parsePtr->next; + continue; + } else if (c == '\\') { + int nRead; + + src--; + *dest = Tcl_Backslash(src, &nRead); + dest++; + src += nRead; + continue; + } else if (c == '\0') { + char buf[10]; + + Tcl_ResetResult(interp); + sprintf_s(buf, 10, "missing %c", termChar); + Tcl_SetStringObj(Tcl_GetObjResult(interp), buf, 9); + *termPtr = string - 1; + return TCL_ERROR; + } else { + goto copy; + } + } +} + |