|
/* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tcl_base/tclparse.c,v 1.1.1.1 2001/06/13 04:44:26 dtashley Exp $ */ |
|
|
|
|
|
/* |
|
|
* tclParse.c -- |
|
|
* |
|
|
* This file contains procedures that parse Tcl scripts. They |
|
|
* do so in a general-purpose fashion that can be used for many |
|
|
* different purposes, including compilation, direct execution, |
|
|
* code analysis, etc. This file also includes a few additional |
|
|
* procedures such as Tcl_EvalObjv, Tcl_Eval, and Tcl_EvalEx, which |
|
|
* allow scripts to be evaluated directly, without compiling. |
|
|
* |
|
|
* Copyright (c) 1997 Sun Microsystems, Inc. |
|
|
* Copyright (c) 1998 by Scriptics Corporation. |
|
|
* |
|
|
* See the file "license.terms" for information on usage and redistribution |
|
|
* of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
|
|
* |
|
|
* RCS: @(#) $Id: tclparse.c,v 1.1.1.1 2001/06/13 04:44:26 dtashley Exp $ |
|
|
*/ |
|
|
|
|
|
#include "tclInt.h" |
|
|
#include "tclPort.h" |
|
|
|
|
|
/* |
|
|
* The following table provides parsing information about each possible |
|
|
* 8-bit character. 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 character value of 0). |
|
|
* |
|
|
* The macro CHAR_TYPE is used to index into the table and return |
|
|
* information about its character argument. The following return |
|
|
* values are defined. |
|
|
* |
|
|
* TYPE_NORMAL - All characters that don't have special significance |
|
|
* to the Tcl parser. |
|
|
* TYPE_SPACE - The character is a whitespace character other |
|
|
* than newline. |
|
|
* TYPE_COMMAND_END - Character is newline or semicolon. |
|
|
* TYPE_SUBS - Character begins a substitution or has other |
|
|
* special meaning in ParseTokens: backslash, dollar |
|
|
* sign, open bracket, or null. |
|
|
* TYPE_QUOTE - Character is a double quote. |
|
|
* TYPE_CLOSE_PAREN - Character is a right parenthesis. |
|
|
* TYPE_CLOSE_BRACK - Character is a right square bracket. |
|
|
* TYPE_BRACE - Character is a curly brace (either left or right). |
|
|
*/ |
|
|
|
|
|
#define TYPE_NORMAL 0 |
|
|
#define TYPE_SPACE 0x1 |
|
|
#define TYPE_COMMAND_END 0x2 |
|
|
#define TYPE_SUBS 0x4 |
|
|
#define TYPE_QUOTE 0x8 |
|
|
#define TYPE_CLOSE_PAREN 0x10 |
|
|
#define TYPE_CLOSE_BRACK 0x20 |
|
|
#define TYPE_BRACE 0x40 |
|
|
|
|
|
#define CHAR_TYPE(c) (typeTable+128)[(int)(c)] |
|
|
|
|
|
char typeTable[] = { |
|
|
/* |
|
|
* Negative character values, from -128 to -1: |
|
|
*/ |
|
|
|
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
|
|
|
/* |
|
|
* Positive character values, from 0-127: |
|
|
*/ |
|
|
|
|
|
TYPE_SUBS, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_SPACE, TYPE_COMMAND_END, TYPE_SPACE, |
|
|
TYPE_SPACE, TYPE_SPACE, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_SPACE, TYPE_NORMAL, TYPE_QUOTE, TYPE_NORMAL, |
|
|
TYPE_SUBS, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_CLOSE_PAREN, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_COMMAND_END, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_SUBS, |
|
|
TYPE_SUBS, TYPE_CLOSE_BRACK, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_BRACE, |
|
|
TYPE_NORMAL, TYPE_BRACE, TYPE_NORMAL, TYPE_NORMAL, |
|
|
|
|
|
/* |
|
|
* Large unsigned character values, from 128-255: |
|
|
*/ |
|
|
|
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
|
|
}; |
|
|
|
|
|
/* |
|
|
* Prototypes for local procedures defined in this file: |
|
|
*/ |
|
|
|
|
|
static int CommandComplete _ANSI_ARGS_((char *script, |
|
|
int length)); |
|
|
static int ParseTokens _ANSI_ARGS_((char *src, int mask, |
|
|
Tcl_Parse *parsePtr)); |
|
|
static int EvalObjv _ANSI_ARGS_((Tcl_Interp *interp, int objc, |
|
|
Tcl_Obj *CONST objv[], char *command, int length, |
|
|
int flags)); |
|
|
|
|
|
/* |
|
|
*---------------------------------------------------------------------- |
|
|
* |
|
|
* Tcl_ParseCommand -- |
|
|
* |
|
|
* Given a string, this procedure parses the first Tcl command |
|
|
* in the string and returns information about the structure of |
|
|
* the command. |
|
|
* |
|
|
* Results: |
|
|
* The return value is TCL_OK if the command was parsed |
|
|
* successfully and TCL_ERROR otherwise. If an error occurs |
|
|
* and interp isn't NULL then an error message is left in |
|
|
* its result. On a successful return, parsePtr is filled in |
|
|
* with information about the command that was parsed. |
|
|
* |
|
|
* Side effects: |
|
|
* If there is insufficient space in parsePtr to hold all the |
|
|
* information about the command, then additional space is |
|
|
* malloc-ed. If the procedure returns TCL_OK then the caller must |
|
|
* eventually invoke Tcl_FreeParse to release any additional space |
|
|
* that was allocated. |
|
|
* |
|
|
*---------------------------------------------------------------------- |
|
|
*/ |
|
|
|
|
|
int |
|
|
Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr) |
|
|
Tcl_Interp *interp; /* Interpreter to use for error reporting; |
|
|
* if NULL, then no error message is |
|
|
* provided. */ |
|
|
char *string; /* First character of string containing |
|
|
* one or more Tcl commands. The string |
|
|
* must be in writable memory and must |
|
|
* have one additional byte of space at |
|
|
* string[length] where we can |
|
|
* temporarily store a 0 sentinel |
|
|
* character. */ |
|
|
int numBytes; /* Total number of bytes in string. If < 0, |
|
|
* the script consists of all bytes up to |
|
|
* the first null character. */ |
|
|
int nested; /* Non-zero means this is a nested command: |
|
|
* close bracket should be considered |
|
|
* a command terminator. If zero, then close |
|
|
* bracket has no special meaning. */ |
|
|
register Tcl_Parse *parsePtr; |
|
|
/* Structure to fill in with information |
|
|
* about the parsed command; any previous |
|
|
* information in the structure is |
|
|
* ignored. */ |
|
|
{ |
|
|
register char *src; /* Points to current character |
|
|
* in the command. */ |
|
|
int type; /* Result returned by CHAR_TYPE(*src). */ |
|
|
Tcl_Token *tokenPtr; /* Pointer to token being filled in. */ |
|
|
int wordIndex; /* Index of word token for current word. */ |
|
|
char utfBytes[TCL_UTF_MAX]; /* Holds result of backslash substitution. */ |
|
|
int terminators; /* CHAR_TYPE bits that indicate the end |
|
|
* of a command. */ |
|
|
char *termPtr; /* Set by Tcl_ParseBraces/QuotedString to |
|
|
* point to char after terminating one. */ |
|
|
int length, savedChar; |
|
|
|
|
|
|
|
|
if (numBytes < 0) { |
|
|
numBytes = (string? strlen(string) : 0); |
|
|
} |
|
|
parsePtr->commentStart = NULL; |
|
|
parsePtr->commentSize = 0; |
|
|
parsePtr->commandStart = NULL; |
|
|
parsePtr->commandSize = 0; |
|
|
parsePtr->numWords = 0; |
|
|
parsePtr->tokenPtr = parsePtr->staticTokens; |
|
|
parsePtr->numTokens = 0; |
|
|
parsePtr->tokensAvailable = NUM_STATIC_TOKENS; |
|
|
parsePtr->string = string; |
|
|
parsePtr->end = string + numBytes; |
|
|
parsePtr->term = parsePtr->end; |
|
|
parsePtr->interp = interp; |
|
|
parsePtr->incomplete = 0; |
|
|
parsePtr->errorType = TCL_PARSE_SUCCESS; |
|
|
if (nested != 0) { |
|
|
terminators = TYPE_COMMAND_END | TYPE_CLOSE_BRACK; |
|
|
} else { |
|
|
terminators = TYPE_COMMAND_END; |
|
|
} |
|
|
|
|
|
/* |
|
|
* Temporarily overwrite the character just after the end of the |
|
|
* string with a 0 byte. This acts as a sentinel and reduces the |
|
|
* number of places where we have to check for the end of the |
|
|
* input string. The original value of the byte is restored at |
|
|
* the end of the parse. |
|
|
*/ |
|
|
|
|
|
savedChar = string[numBytes]; |
|
|
if (savedChar != 0) { |
|
|
string[numBytes] = 0; |
|
|
} |
|
|
|
|
|
/* |
|
|
* Parse any leading space and comments before the first word of the |
|
|
* command. |
|
|
*/ |
|
|
|
|
|
src = string; |
|
|
while (1) { |
|
|
while ((CHAR_TYPE(*src) == TYPE_SPACE) || (*src == '\n')) { |
|
|
src++; |
|
|
} |
|
|
if ((*src == '\\') && (src[1] == '\n')) { |
|
|
/* |
|
|
* Skip backslash-newline sequence: it should be treated |
|
|
* just like white space. |
|
|
*/ |
|
|
|
|
|
if ((src + 2) == parsePtr->end) { |
|
|
parsePtr->incomplete = 1; |
|
|
} |
|
|
src += 2; |
|
|
continue; |
|
|
} |
|
|
if (*src != '#') { |
|
|
break; |
|
|
} |
|
|
if (parsePtr->commentStart == NULL) { |
|
|
parsePtr->commentStart = src; |
|
|
} |
|
|
while (1) { |
|
|
if (src == parsePtr->end) { |
|
|
if (nested) { |
|
|
parsePtr->incomplete = nested; |
|
|
} |
|
|
parsePtr->commentSize = src - parsePtr->commentStart; |
|
|
break; |
|
|
} else if (*src == '\\') { |
|
|
if ((src[1] == '\n') && ((src + 2) == parsePtr->end)) { |
|
|
parsePtr->incomplete = 1; |
|
|
} |
|
|
Tcl_UtfBackslash(src, &length, utfBytes); |
|
|
src += length; |
|
|
} else if (*src == '\n') { |
|
|
src++; |
|
|
parsePtr->commentSize = src - parsePtr->commentStart; |
|
|
break; |
|
|
} else { |
|
|
src++; |
|
|
} |
|
|
} |
|
|
} |
|
|
|
|
|
/* |
|
|
* The following loop parses the words of the command, one word |
|
|
* in each iteration through the loop. |
|
|
*/ |
|
|
|
|
|
parsePtr->commandStart = src; |
|
|
while (1) { |
|
|
/* |
|
|
* Create the token for the word. |
|
|
*/ |
|
|
|
|
|
if (parsePtr->numTokens == parsePtr->tokensAvailable) { |
|
|
TclExpandTokenArray(parsePtr); |
|
|
} |
|
|
wordIndex = parsePtr->numTokens; |
|
|
tokenPtr = &parsePtr->tokenPtr[wordIndex]; |
|
|
tokenPtr->type = TCL_TOKEN_WORD; |
|
|
|
|
|
/* |
|
|
* Skip white space before the word. Also skip a backslash-newline |
|
|
* sequence: it should be treated just like white space. |
|
|
*/ |
|
|
|
|
|
while (1) { |
|
|
type = CHAR_TYPE(*src); |
|
|
if (type == TYPE_SPACE) { |
|
|
src++; |
|
|
continue; |
|
|
} else if ((*src == '\\') && (src[1] == '\n')) { |
|
|
if ((src + 2) == parsePtr->end) { |
|
|
parsePtr->incomplete = 1; |
|
|
} |
|
|
Tcl_UtfBackslash(src, &length, utfBytes); |
|
|
src += length; |
|
|
continue; |
|
|
} |
|
|
break; |
|
|
} |
|
|
if ((type & terminators) != 0) { |
|
|
parsePtr->term = src; |
|
|
src++; |
|
|
break; |
|
|
} |
|
|
if (src == parsePtr->end) { |
|
|
break; |
|
|
} |
|
|
tokenPtr->start = src; |
|
|
parsePtr->numTokens++; |
|
|
parsePtr->numWords++; |
|
|
|
|
|
/* |
|
|
* At this point the word can have one of three forms: something |
|
|
* enclosed in quotes, something enclosed in braces, or an |
|
|
* unquoted word (anything else). |
|
|
*/ |
|
|
|
|
|
if (*src == '"') { |
|
|
if (Tcl_ParseQuotedString(interp, src, (parsePtr->end - src), |
|
|
parsePtr, 1, &termPtr) != TCL_OK) { |
|
|
goto error; |
|
|
} |
|
|
src = termPtr; |
|
|
} else if (*src == '{') { |
|
|
if (Tcl_ParseBraces(interp, src, (parsePtr->end - src), |
|
|
parsePtr, 1, &termPtr) != TCL_OK) { |
|
|
goto error; |
|
|
} |
|
|
src = termPtr; |
|
|
} else { |
|
|
/* |
|
|
* This is an unquoted word. Call ParseTokens and let it do |
|
|
* all of the work. |
|
|
*/ |
|
|
|
|
|
if (ParseTokens(src, TYPE_SPACE|terminators, |
|
|
parsePtr) != TCL_OK) { |
|
|
goto error; |
|
|
} |
|
|
src = parsePtr->term; |
|
|
} |
|
|
|
|
|
/* |
|
|
* Finish filling in the token for the word and check for the |
|
|
* special case of a word consisting of a single range of |
|
|
* literal text. |
|
|
*/ |
|
|
|
|
|
tokenPtr = &parsePtr->tokenPtr[wordIndex]; |
|
|
tokenPtr->size = src - tokenPtr->start; |
|
|
tokenPtr->numComponents = parsePtr->numTokens - (wordIndex + 1); |
|
|
if ((tokenPtr->numComponents == 1) |
|
|
&& (tokenPtr[1].type == TCL_TOKEN_TEXT)) { |
|
|
tokenPtr->type = TCL_TOKEN_SIMPLE_WORD; |
|
|
} |
|
|
|
|
|
/* |
|
|
* Do two additional checks: (a) make sure we're really at the |
|
|
* end of a word (there might have been garbage left after a |
|
|
* quoted or braced word), and (b) check for the end of the |
|
|
* command. |
|
|
*/ |
|
|
|
|
|
type = CHAR_TYPE(*src); |
|
|
if (type == TYPE_SPACE) { |
|
|
src++; |
|
|
continue; |
|
|
} else { |
|
|
/* |
|
|
* Backslash-newline (and any following white space) must be |
|
|
* treated as if it were a space character. |
|
|
*/ |
|
|
|
|
|
if ((*src == '\\') && (src[1] == '\n')) { |
|
|
if ((src + 2) == parsePtr->end) { |
|
|
parsePtr->incomplete = 1; |
|
|
} |
|
|
Tcl_UtfBackslash(src, &length, utfBytes); |
|
|
src += length; |
|
|
continue; |
|
|
} |
|
|
} |
|
|
|
|
|
if ((type & terminators) != 0) { |
|
|
parsePtr->term = src; |
|
|
src++; |
|
|
break; |
|
|
} |
|
|
if (src == parsePtr->end) { |
|
|
break; |
|
|
} |
|
|
if (src[-1] == '"') { |
|
|
if (interp != NULL) { |
|
|
Tcl_SetResult(interp, "extra characters after close-quote", |
|
|
TCL_STATIC); |
|
|
} |
|
|
parsePtr->errorType = TCL_PARSE_QUOTE_EXTRA; |
|
|
} else { |
|
|
if (interp != NULL) { |
|
|
Tcl_SetResult(interp, "extra characters after close-brace", |
|
|
TCL_STATIC); |
|
|
} |
|
|
parsePtr->errorType = TCL_PARSE_BRACE_EXTRA; |
|
|
} |
|
|
parsePtr->term = src; |
|
|
goto error; |
|
|
} |
|
|
|
|
|
|
|
|
parsePtr->commandSize = src - parsePtr->commandStart; |
|
|
if (savedChar != 0) { |
|
|
string[numBytes] = (char) savedChar; |
|
|
} |
|
|
return TCL_OK; |
|
|
|
|
|
error: |
|
|
if (savedChar != 0) { |
|
|
string[numBytes] = (char) savedChar; |
|
|
} |
|
|
Tcl_FreeParse(parsePtr); |
|
|
if (parsePtr->commandStart == NULL) { |
|
|
parsePtr->commandStart = string; |
|
|
} |
|
|
parsePtr->commandSize = parsePtr->term - parsePtr->commandStart; |
|
|
return TCL_ERROR; |
|
|
} |
|
|
|
|
|
/* |
|
|
*---------------------------------------------------------------------- |
|
|
* |
|
|
* ParseTokens -- |
|
|
* |
|
|
* This procedure forms the heart of the Tcl parser. It parses one |
|
|
* or more tokens from a string, up to a termination point |
|
|
* specified by the caller. This procedure is used to parse |
|
|
* unquoted command words (those not in quotes or braces), words in |
|
|
* quotes, and array indices for variables. |
|
|
* |
|
|
* Results: |
|
|
* Tokens are added to parsePtr and parsePtr->term is filled in |
|
|
* with the address of the character that terminated the parse (the |
|
|
* first one whose CHAR_TYPE matched mask or the character at |
|
|
* parsePtr->end). The return value is TCL_OK if the parse |
|
|
* completed successfully and TCL_ERROR otherwise. If a parse |
|
|
* error occurs and parsePtr->interp isn't NULL, then an error |
|
|
* message is left in the interpreter's result. |
|
|
* |
|
|
* Side effects: |
|
|
* None. |
|
|
* |
|
|
*---------------------------------------------------------------------- |
|
|
*/ |
|
|
|
|
|
static int |
|
|
ParseTokens(src, mask, parsePtr) |
|
|
register char *src; /* First character to parse. */ |
|
|
int mask; /* Specifies when to stop parsing. The |
|
|
* parse stops at the first unquoted |
|
|
* character whose CHAR_TYPE contains |
|
|
* any of the bits in mask. */ |
|
|
Tcl_Parse *parsePtr; /* Information about parse in progress. |
|
|
* Updated with additional tokens and |
|
|
* termination information. */ |
|
|
{ |
|
|
int type, originalTokens, varToken; |
|
|
char utfBytes[TCL_UTF_MAX]; |
|
|
Tcl_Token *tokenPtr; |
|
|
Tcl_Parse nested; |
|
|
|
|
|
/* |
|
|
* Each iteration through the following loop adds one token of |
|
|
* type TCL_TOKEN_TEXT, TCL_TOKEN_BS, TCL_TOKEN_COMMAND, or |
|
|
* TCL_TOKEN_VARIABLE to parsePtr. For TCL_TOKEN_VARIABLE tokens, |
|
|
* additional tokens are added for the parsed variable name. |
|
|
*/ |
|
|
|
|
|
originalTokens = parsePtr->numTokens; |
|
|
while (1) { |
|
|
if (parsePtr->numTokens == parsePtr->tokensAvailable) { |
|
|
TclExpandTokenArray(parsePtr); |
|
|
} |
|
|
tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens]; |
|
|
tokenPtr->start = src; |
|
|
tokenPtr->numComponents = 0; |
|
|
|
|
|
type = CHAR_TYPE(*src); |
|
|
if (type & mask) { |
|
|
break; |
|
|
} |
|
|
|
|
|
if ((type & TYPE_SUBS) == 0) { |
|
|
/* |
|
|
* This is a simple range of characters. Scan to find the end |
|
|
* of the range. |
|
|
*/ |
|
|
|
|
|
while (1) { |
|
|
src++; |
|
|
if (CHAR_TYPE(*src) & (mask | TYPE_SUBS)) { |
|
|
break; |
|
|
} |
|
|
} |
|
|
tokenPtr->type = TCL_TOKEN_TEXT; |
|
|
tokenPtr->size = src - tokenPtr->start; |
|
|
parsePtr->numTokens++; |
|
|
} else if (*src == '$') { |
|
|
/* |
|
|
* This is a variable reference. Call Tcl_ParseVarName to do |
|
|
* all the dirty work of parsing the name. |
|
|
*/ |
|
|
|
|
|
varToken = parsePtr->numTokens; |
|
|
if (Tcl_ParseVarName(parsePtr->interp, src, parsePtr->end - src, |
|
|
parsePtr, 1) != TCL_OK) { |
|
|
return TCL_ERROR; |
|
|
} |
|
|
src += parsePtr->tokenPtr[varToken].size; |
|
|
} else if (*src == '[') { |
|
|
/* |
|
|
* Command substitution. Call Tcl_ParseCommand recursively |
|
|
* (and repeatedly) to parse the nested command(s), then |
|
|
* throw away the parse information. |
|
|
*/ |
|
|
|
|
|
src++; |
|
|
while (1) { |
|
|
if (Tcl_ParseCommand(parsePtr->interp, src, |
|
|
parsePtr->end - src, 1, &nested) != TCL_OK) { |
|
|
parsePtr->errorType = nested.errorType; |
|
|
parsePtr->term = nested.term; |
|
|
parsePtr->incomplete = nested.incomplete; |
|
|
return TCL_ERROR; |
|
|
} |
|
|
src = nested.commandStart + nested.commandSize; |
|
|
if (nested.tokenPtr != nested.staticTokens) { |
|
|
ckfree((char *) nested.tokenPtr); |
|
|
} |
|
|
if ((*nested.term == ']') && !nested.incomplete) { |
|
|
break; |
|
|
} |
|
|
if (src == parsePtr->end) { |
|
|
if (parsePtr->interp != NULL) { |
|
|
Tcl_SetResult(parsePtr->interp, |
|
|
"missing close-bracket", TCL_STATIC); |
|
|
} |
|
|
parsePtr->errorType = TCL_PARSE_MISSING_BRACKET; |
|
|
parsePtr->term = tokenPtr->start; |
|
|
parsePtr->incomplete = 1; |
|
|
return TCL_ERROR; |
|
|
} |
|
|
} |
|
|
tokenPtr->type = TCL_TOKEN_COMMAND; |
|
|
tokenPtr->size = src - tokenPtr->start; |
|
|
parsePtr->numTokens++; |
|
|
} else if (*src == '\\') { |
|
|
/* |
|
|
* Backslash substitution. |
|
|
*/ |
|
|
|
|
|
if (src[1] == '\n') { |
|
|
if ((src + 2) == parsePtr->end) { |
|
|
parsePtr->incomplete = 1; |
|
|
} |
|
|
|
|
|
/* |
|
|
* Note: backslash-newline is special in that it is |
|
|
* treated the same as a space character would be. This |
|
|
* means that it could terminate the token. |
|
|
*/ |
|
|
|
|
|
if (mask & TYPE_SPACE) { |
|
|
break; |
|
|
} |
|
|
} |
|
|
tokenPtr->type = TCL_TOKEN_BS; |
|
|
Tcl_UtfBackslash(src, &tokenPtr->size, utfBytes); |
|
|
parsePtr->numTokens++; |
|
|
src += tokenPtr->size; |
|
|
} else if (*src == 0) { |
|
|
/* |
|
|
* We encountered a null character. If it is the null |
|
|
* character at the end of the string, then return. |
|
|
* Otherwise generate a text token for the single |
|
|
* character. |
|
|
*/ |
|
|
|
|
|
if (src == parsePtr->end) { |
|
|
break; |
|
|
} |
|
|
tokenPtr->type = TCL_TOKEN_TEXT; |
|
|
tokenPtr->size = 1; |
|
|
parsePtr->numTokens++; |
|
|
src++; |
|
|
} else { |
|
|
panic("ParseTokens encountered unknown character"); |
|
|
} |
|
|
} |
|
|
if (parsePtr->numTokens == originalTokens) { |
|
|
/* |
|
|
* There was nothing in this range of text. Add an empty token |
|
|
* for the empty range, so that there is always at least one |
|
|
* token added. |
|
|
*/ |
|
|
|
|
|
tokenPtr->type = TCL_TOKEN_TEXT; |
|
|
tokenPtr->size = 0; |
|
|
parsePtr->numTokens++; |
|
|
} |
|
|
parsePtr->term = src; |
|
|
return TCL_OK; |
|
|
} |
|
|
|
|
|
/* |
|
|
*---------------------------------------------------------------------- |
|
|
* |
|
|
* Tcl_FreeParse -- |
|
|
* |
|
|
* This procedure is invoked to free any dynamic storage that may |
|
|
* have been allocated by a previous call to Tcl_ParseCommand. |
|
|
* |
|
|
* Results: |
|
|
* None. |
|
|
* |
|
|
* Side effects: |
|
|
* If there is any dynamically allocated memory in *parsePtr, |
|
|
* it is freed. |
|
|
* |
|
|
*---------------------------------------------------------------------- |
|
|
*/ |
|
|
|
|
|
void |
|
|
Tcl_FreeParse(parsePtr) |
|
|
Tcl_Parse *parsePtr; /* Structure that was filled in by a |
|
|
* previous call to Tcl_ParseCommand. */ |
|
|
{ |
|
|
if (parsePtr->tokenPtr != parsePtr->staticTokens) { |
|
|
ckfree((char *) parsePtr->tokenPtr); |
|
|
parsePtr->tokenPtr = parsePtr->staticTokens; |
|
|
} |
|
|
} |
|
|
|
|
|
/* |
|
|
*---------------------------------------------------------------------- |
|
|
* |
|
|
* TclExpandTokenArray -- |
|
|
* |
|
|
* This procedure is invoked when the current space for tokens in |
|
|
* a Tcl_Parse structure fills up; it allocates memory to grow the |
|
|
* token array |
|
|
* |
|
|
* Results: |
|
|
* None. |
|
|
* |
|
|
* Side effects: |
|
|
* Memory is allocated for a new larger token array; the memory |
|
|
* for the old array is freed, if it had been dynamically allocated. |
|
|
* |
|
|
*---------------------------------------------------------------------- |
|
|
*/ |
|
|
|
|
|
void |
|
|
TclExpandTokenArray(parsePtr) |
|
|
Tcl_Parse *parsePtr; /* Parse structure whose token space |
|
|
* has overflowed. */ |
|
|
{ |
|
|
int newCount; |
|
|
Tcl_Token *newPtr; |
|
|
|
|
|
newCount = parsePtr->tokensAvailable*2; |
|
|
newPtr = (Tcl_Token *) ckalloc((unsigned) (newCount * sizeof(Tcl_Token))); |
|
|
memcpy((VOID *) newPtr, (VOID *) parsePtr->tokenPtr, |
|
|
(size_t) (parsePtr->tokensAvailable * sizeof(Tcl_Token))); |
|
|
if (parsePtr->tokenPtr != parsePtr->staticTokens) { |
|
|
ckfree((char *) parsePtr->tokenPtr); |
|
|
} |
|
|
parsePtr->tokenPtr = newPtr; |
|
|
parsePtr->tokensAvailable = newCount; |
|
|
} |
|
|
|
|
|
/* |
|
|
*---------------------------------------------------------------------- |
|
|
* |
|
|
* EvalObjv -- |
|
|
* |
|
|
* This procedure evaluates a Tcl command that has already been |
|
|
* parsed into words, with one Tcl_Obj holding each word. |
|
|
* |
|
|
* Results: |
|
|
* The return value is a standard Tcl completion code such as |
|
|
* TCL_OK or TCL_ERROR. A result or error message is left in |
|
|
* interp's result. If an error occurs, this procedure does |
|
|
* NOT add any information to the errorInfo variable. |
|
|
* |
|
|
* Side effects: |
|
|
* Depends on the command. |
|
|
* |
|
|
*---------------------------------------------------------------------- |
|
|
*/ |
|
|
|
|
|
static int |
|
|
EvalObjv(interp, objc, objv, command, length, flags) |
|
|
Tcl_Interp *interp; /* Interpreter in which to evaluate the |
|
|
* command. Also used for error |
|
|
* reporting. */ |
|
|
int objc; /* Number of words in command. */ |
|
|
Tcl_Obj *CONST objv[]; /* An array of pointers to objects that are |
|
|
* the words that make up the command. */ |
|
|
char *command; /* Points to the beginning of the string |
|
|
* representation of the command; this |
|
|
* is used for traces. If the string |
|
|
* representation of the command is |
|
|
* unknown, an empty string should be |
|
|
* supplied. */ |
|
|
int length; /* Number of bytes in command; if -1, all |
|
|
* characters up to the first null byte are |
|
|
* used. */ |
|
|
int flags; /* Collection of OR-ed bits that control |
|
|
* the evaluation of the script. Only |
|
|
* TCL_EVAL_GLOBAL is currently |
|
|
* supported. */ |
|
|
|
|
|
{ |
|
|
Command *cmdPtr; |
|
|
Interp *iPtr = (Interp *) interp; |
|
|
Tcl_Obj **newObjv; |
|
|
int i, code; |
|
|
Trace *tracePtr, *nextPtr; |
|
|
char **argv, *commandCopy; |
|
|
CallFrame *savedVarFramePtr; /* Saves old copy of iPtr->varFramePtr |
|
|
* in case TCL_EVAL_GLOBAL was set. */ |
|
|
|
|
|
Tcl_ResetResult(interp); |
|
|
if (objc == 0) { |
|
|
return TCL_OK; |
|
|
} |
|
|
|
|
|
/* |
|
|
* If the interpreter was deleted, return an error. |
|
|
*/ |
|
|
|
|
|
if (iPtr->flags & DELETED) { |
|
|
Tcl_AppendToObj(Tcl_GetObjResult(interp), |
|
|
"attempt to call eval in deleted interpreter", -1); |
|
|
Tcl_SetErrorCode(interp, "CORE", "IDELETE", |
|
|
"attempt to call eval in deleted interpreter", |
|
|
(char *) NULL); |
|
|
return TCL_ERROR; |
|
|
} |
|
|
|
|
|
/* |
|
|
* Check depth of nested calls to Tcl_Eval: if this gets too large, |
|
|
* it's probably because of an infinite loop somewhere. |
|
|
*/ |
|
|
|
|
|
if (iPtr->numLevels >= iPtr->maxNestingDepth) { |
|
|
iPtr->result = "too many nested calls to Tcl_Eval (infinite loop?)"; |
|
|
return TCL_ERROR; |
|
|
} |
|
|
iPtr->numLevels++; |
|
|
|
|
|
/* |
|
|
* On the Mac, we will never reach the default recursion limit before |
|
|
* blowing the stack. So we need to do a check here. |
|
|
*/ |
|
|
|
|
|
if (TclpCheckStackSpace() == 0) { |
|
|
/*NOTREACHED*/ |
|
|
iPtr->numLevels--; |
|
|
iPtr->result = "too many nested calls to Tcl_Eval (infinite loop?)"; |
|
|
return TCL_ERROR; |
|
|
} |
|
|
|
|
|
/* |
|
|
* Find the procedure to execute this command. If there isn't one, |
|
|
* then see if there is a command "unknown". If so, create a new |
|
|
* word array with "unknown" as the first word and the original |
|
|
* command words as arguments. Then call ourselves recursively |
|
|
* to execute it. |
|
|
*/ |
|
|
|
|
|
cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[0]); |
|
|
if (cmdPtr == NULL) { |
|
|
newObjv = (Tcl_Obj **) ckalloc((unsigned) |
|
|
((objc + 1) * sizeof (Tcl_Obj *))); |
|
|
for (i = objc-1; i >= 0; i--) { |
|
|
newObjv[i+1] = objv[i]; |
|
|
} |
|
|
newObjv[0] = Tcl_NewStringObj("unknown", -1); |
|
|
Tcl_IncrRefCount(newObjv[0]); |
|
|
cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, newObjv[0]); |
|
|
if (cmdPtr == NULL) { |
|
|
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), |
|
|
"invalid command name \"", Tcl_GetString(objv[0]), "\"", |
|
|
(char *) NULL); |
|
|
code = TCL_ERROR; |
|
|
} else { |
|
|
code = EvalObjv(interp, objc+1, newObjv, command, length, 0); |
|
|
} |
|
|
Tcl_DecrRefCount(newObjv[0]); |
|
|
ckfree((char *) newObjv); |
|
|
goto done; |
|
|
} |
|
|
|
|
|
/* |
|
|
* Call trace procedures if needed. |
|
|
*/ |
|
|
|
|
|
argv = NULL; |
|
|
commandCopy = command; |
|
|
|
|
|
for (tracePtr = iPtr->tracePtr; tracePtr != NULL; tracePtr = nextPtr) { |
|
|
nextPtr = tracePtr->nextPtr; |
|
|
if (iPtr->numLevels > tracePtr->level) { |
|
|
continue; |
|
|
} |
|
|
|
|
|
/* |
|
|
* This is a bit messy because we have to emulate the old trace |
|
|
* interface, which uses strings for everything. |
|
|
*/ |
|
|
|
|
|
if (argv == NULL) { |
|
|
argv = (char **) ckalloc((unsigned) (objc + 1) * sizeof(char *)); |
|
|
for (i = 0; i < objc; i++) { |
|
|
argv[i] = Tcl_GetString(objv[i]); |
|
|
} |
|
|
argv[objc] = 0; |
|
|
|
|
|
if (length < 0) { |
|
|
length = strlen(command); |
|
|
} else if ((size_t)length < strlen(command)) { |
|
|
commandCopy = (char *) ckalloc((unsigned) (length + 1)); |
|
|
strncpy(commandCopy, command, (size_t) length); |
|
|
commandCopy[length] = 0; |
|
|
} |
|
|
} |
|
|
(*tracePtr->proc)(tracePtr->clientData, interp, iPtr->numLevels, |
|
|
commandCopy, cmdPtr->proc, cmdPtr->clientData, |
|
|
objc, argv); |
|
|
} |
|
|
if (argv != NULL) { |
|
|
ckfree((char *) argv); |
|
|
} |
|
|
if (commandCopy != command) { |
|
|
ckfree((char *) commandCopy); |
|
|
} |
|
|
|
|
|
/* |
|
|
* Finally, invoke the command's Tcl_ObjCmdProc. |
|
|
*/ |
|
|
|
|
|
iPtr->cmdCount++; |
|
|
savedVarFramePtr = iPtr->varFramePtr; |
|
|
if (flags & TCL_EVAL_GLOBAL) { |
|
|
iPtr->varFramePtr = NULL; |
|
|
} |
|
|
code = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, objc, objv); |
|
|
iPtr->varFramePtr = savedVarFramePtr; |
|
|
if (Tcl_AsyncReady()) { |
|
|
code = Tcl_AsyncInvoke(interp, code); |
|
|
} |
|
|
|
|
|
/* |
|
|
* If the interpreter has a non-empty string result, the result |
|
|
* object is either empty or stale because some procedure set |
|
|
* interp->result directly. If so, move the string result to the |
|
|
* result object, then reset the string result. |
|
|
*/ |
|
|
|
|
|
if (*(iPtr->result) != 0) { |
|
|
(void) Tcl_GetObjResult(interp); |
|
|
} |
|
|
|
|
|
done: |
|
|
iPtr->numLevels--; |
|
|
return code; |
|
|
} |
|
|
|
|
|
/* |
|
|
*---------------------------------------------------------------------- |
|
|
* |
|
|
* Tcl_EvalObjv -- |
|
|
* |
|
|
* This procedure evaluates a Tcl command that has already been |
|
|
* parsed into words, with one Tcl_Obj holding each word. |
|
|
* |
|
|
* Results: |
|
|
* The return value is a standard Tcl completion code such as |
|
|
* TCL_OK or TCL_ERROR. A result or error message is left in |
|
|
* interp's result. |
|
|
* |
|
|
* Side effects: |
|
|
* Depends on the command. |
|
|
* |
|
|
*---------------------------------------------------------------------- |
|
|
*/ |
|
|
|
|
|
int |
|
|
Tcl_EvalObjv(interp, objc, objv, flags) |
|
|
Tcl_Interp *interp; /* Interpreter in which to evaluate the |
|
|
* command. Also used for error |
|
|
* reporting. */ |
|
|
int objc; /* Number of words in command. */ |
|
|
Tcl_Obj *CONST objv[]; /* An array of pointers to objects that are |
|
|
* the words that make up the command. */ |
|
|
int flags; /* Collection of OR-ed bits that control |
|
|
* the evaluation of the script. Only |
|
|
* TCL_EVAL_GLOBAL is currently |
|
|
* supported. */ |
|
|
{ |
|
|
Interp *iPtr = (Interp *)interp; |
|
|
Trace *tracePtr; |
|
|
Tcl_DString cmdBuf; |
|
|
char *cmdString = ""; |
|
|
int cmdLen = 0; |
|
|
int code = TCL_OK; |
|
|
|
|
|
for (tracePtr = iPtr->tracePtr; tracePtr; tracePtr = tracePtr->nextPtr) { |
|
|
/* |
|
|
* EvalObjv will increment numLevels so use "<" rather than "<=" |
|
|
*/ |
|
|
if (iPtr->numLevels < tracePtr->level) { |
|
|
int i; |
|
|
/* |
|
|
* The command will be needed for an execution trace or stack trace |
|
|
* generate a command string. |
|
|
*/ |
|
|
cmdtraced: |
|
|
Tcl_DStringInit(&cmdBuf); |
|
|
for (i = 0; i < objc; i++) { |
|
|
Tcl_DStringAppendElement(&cmdBuf, Tcl_GetString(objv[i])); |
|
|
} |
|
|
cmdString = Tcl_DStringValue(&cmdBuf); |
|
|
cmdLen = Tcl_DStringLength(&cmdBuf); |
|
|
break; |
|
|
} |
|
|
} |
|
|
|
|
|
/* |
|
|
* Execute the command if we have not done so already |
|
|
*/ |
|
|
switch (code) { |
|
|
case TCL_OK: |
|
|
code = EvalObjv(interp, objc, objv, cmdString, cmdLen, flags); |
|
|
if (code == TCL_ERROR && cmdLen == 0) |
|
|
goto cmdtraced; |
|
|
break; |
|
|
case TCL_ERROR: |
|
|
Tcl_LogCommandInfo(interp, cmdString, cmdString, cmdLen); |
|
|
break; |
|
|
default: |
|
|
/*NOTREACHED*/ |
|
|
break; |
|
|
} |
|
|
|
|
|
if (cmdLen != 0) { |
|
|
Tcl_DStringFree(&cmdBuf); |
|
|
} |
|
|
return code; |
|
|
} |
|
|
|
|
|
/* |
|
|
*---------------------------------------------------------------------- |
|
|
* |
|
|
* Tcl_LogCommandInfo -- |
|
|
* |
|
|
* This procedure is invoked after an error occurs in an interpreter. |
|
|
* It adds information to the "errorInfo" variable to describe the |
|
|
* command that was being executed when the error occurred. |
|
|
* |
|
|
* Results: |
|
|
* None. |
|
|
* |
|
|
* Side effects: |
|
|
* Information about the command is added to errorInfo and the |
|
|
* line number stored internally in the interpreter is set. If this |
|
|
* is the first call to this procedure or Tcl_AddObjErrorInfo since |
|
|
* an error occurred, then old information in errorInfo is |
|
|
* deleted. |
|
|
* |
|
|
*---------------------------------------------------------------------- |
|
|
*/ |
|
|
|
|
|
void |
|
|
Tcl_LogCommandInfo(interp, script, command, length) |
|
|
Tcl_Interp *interp; /* Interpreter in which to log information. */ |
|
|
char *script; /* First character in script containing |
|
|
* command (must be <= command). */ |
|
|
char *command; /* First character in command that |
|
|
* generated the error. */ |
|
|
int length; /* Number of bytes in command (-1 means |
|
|
* use all bytes up to first null byte). */ |
|
|
{ |
|
|
char buffer[200]; |
|
|
register char *p; |
|
|
char *ellipsis = ""; |
|
|
Interp *iPtr = (Interp *) interp; |
|
|
|
|
|
if (iPtr->flags & ERR_ALREADY_LOGGED) { |
|
|
/* |
|
|
* Someone else has already logged error information for this |
|
|
* command; we shouldn't add anything more. |
|
|
*/ |
|
|
|
|
|
return; |
|
|
} |
|
|
|
|
|
/* |
|
|
* Compute the line number where the error occurred. |
|
|
*/ |
|
|
|
|
|
iPtr->errorLine = 1; |
|
|
for (p = script; p != command; p++) { |
|
|
if (*p == '\n') { |
|
|
iPtr->errorLine++; |
|
|
} |
|
|
} |
|
|
|
|
|
/* |
|
|
* Create an error message to add to errorInfo, including up to a |
|
|
* maximum number of characters of the command. |
|
|
*/ |
|
|
|
|
|
if (length < 0) { |
|
|
length = strlen(command); |
|
|
} |
|
|
if (length > 150) { |
|
|
length = 150; |
|
|
ellipsis = "..."; |
|
|
} |
|
|
if (!(iPtr->flags & ERR_IN_PROGRESS)) { |
|
|
sprintf(buffer, "\n while executing\n\"%.*s%s\"", |
|
|
length, command, ellipsis); |
|
|
} else { |
|
|
sprintf(buffer, "\n invoked from within\n\"%.*s%s\"", |
|
|
length, command, ellipsis); |
|
|
} |
|
|
Tcl_AddObjErrorInfo(interp, buffer, -1); |
|
|
iPtr->flags &= ~ERR_ALREADY_LOGGED; |
|
|
} |
|
|
|
|
|
/* |
|
|
*---------------------------------------------------------------------- |
|
|
* |
|
|
* Tcl_EvalTokens -- |
|
|
* |
|
|
* Given an array of tokens parsed from a Tcl command (e.g., the |
|
|
* tokens that make up a word or the index for an array variable) |
|
|
* this procedure evaluates the tokens and concatenates their |
|
|
* values to form a single result value. |
|
|
* |
|
|
* Results: |
|
|
* The return value is a pointer to a newly allocated Tcl_Obj |
|
|
* containing the value of the array of tokens. The reference |
|
|
* count of the returned object has been incremented. If an error |
|
|
* occurs in evaluating the tokens then a NULL value is returned |
|
|
* and an error message is left in interp's result. |
|
|
* |
|
|
* Side effects: |
|
|
* A new object is allocated to hold the result. |
|
|
* |
|
|
*---------------------------------------------------------------------- |
|
|
*/ |
|
|
|
|
|
Tcl_Obj * |
|
|
Tcl_EvalTokens(interp, tokenPtr, count) |
|
|
Tcl_Interp *interp; /* Interpreter in which to lookup |
|
|
* variables, execute nested commands, |
|
|
* and report errors. */ |
|
|
Tcl_Token *tokenPtr; /* Pointer to first in an array of tokens |
|
|
* to evaluate and concatenate. */ |
|
|
int count; /* Number of tokens to consider at tokenPtr. |
|
|
* Must be at least 1. */ |
|
|
{ |
|
|
Tcl_Obj *resultPtr, *indexPtr, *valuePtr, *newPtr; |
|
|
char buffer[TCL_UTF_MAX]; |
|
|
#ifdef TCL_MEM_DEBUG |
|
|
# define MAX_VAR_CHARS 5 |
|
|
#else |
|
|
# define MAX_VAR_CHARS 30 |
|
|
#endif |
|
|
char nameBuffer[MAX_VAR_CHARS+1]; |
|
|
char *varName, *index; |
|
|
char *p = NULL; /* Initialized to avoid compiler warning. */ |
|
|
int length, code; |
|
|
|
|
|
/* |
|
|
* The only tricky thing about this procedure is that it attempts to |
|
|
* avoid object creation and string copying whenever possible. For |
|
|
* example, if the value is just a nested command, then use the |
|
|
* command's result object directly. |
|
|
*/ |
|
|
|
|
|
resultPtr = NULL; |
|
|
for ( ; count > 0; count--, tokenPtr++) { |
|
|
valuePtr = NULL; |
|
|
|
|
|
/* |
|
|
* The switch statement below computes the next value to be |
|
|
* concat to the result, as either a range of text or an |
|
|
* object. |
|
|
*/ |
|
|
|
|
|
switch (tokenPtr->type) { |
|
|
case TCL_TOKEN_TEXT: |
|
|
p = tokenPtr->start; |
|
|
length = tokenPtr->size; |
|
|
break; |
|
|
|
|
|
case TCL_TOKEN_BS: |
|
|
length = Tcl_UtfBackslash(tokenPtr->start, (int *) NULL, |
|
|
buffer); |
|
|
p = buffer; |
|
|
break; |
|
|
|
|
|
case TCL_TOKEN_COMMAND: |
|
|
code = Tcl_EvalEx(interp, tokenPtr->start+1, tokenPtr->size-2, |
|
|
0); |
|
|
if (code != TCL_OK) { |
|
|
goto error; |
|
|
} |
|
|
valuePtr = Tcl_GetObjResult(interp); |
|
|
break; |
|
|
|
|
|
case TCL_TOKEN_VARIABLE: |
|
|
if (tokenPtr->numComponents == 1) { |
|
|
indexPtr = NULL; |
|
|
} else { |
|
|
indexPtr = Tcl_EvalTokens(interp, tokenPtr+2, |
|
|
tokenPtr->numComponents - 1); |
|
|
if (indexPtr == NULL) { |
|
|
goto error; |
|
|
} |
|
|
} |
|
|
|
|
|
/* |
|
|
* We have to make a copy of the variable name in order |
|
|
* to have a null-terminated string. We can't make a |
|
|
* temporary modification to the script to null-terminate |
|
|
* the name, because a trace callback might potentially |
|
|
* reuse the script and be affected by the null character. |
|
|
*/ |
|
|
|
|
|
if (tokenPtr[1].size <= MAX_VAR_CHARS) { |
|
|
varName = nameBuffer; |
|
|
} else { |
|
|
varName = ckalloc((unsigned) (tokenPtr[1].size + 1)); |
|
|
} |
|
|
strncpy(varName, tokenPtr[1].start, (size_t) tokenPtr[1].size); |
|
|
varName[tokenPtr[1].size] = 0; |
|
|
if (indexPtr != NULL) { |
|
|
index = TclGetString(indexPtr); |
|
|
} else { |
|
|
index = NULL; |
|
|
} |
|
|
valuePtr = Tcl_GetVar2Ex(interp, varName, index, |
|
|
TCL_LEAVE_ERR_MSG); |
|
|
if (varName != nameBuffer) { |
|
|
ckfree(varName); |
|
|
} |
|
|
if (indexPtr != NULL) { |
|
|
Tcl_DecrRefCount(indexPtr); |
|
|
} |
|
|
if (valuePtr == NULL) { |
|
|
goto error; |
|
|
} |
|
|
count -= tokenPtr->numComponents; |
|
|
tokenPtr += tokenPtr->numComponents; |
|
|
break; |
|
|
|
|
|
default: |
|
|
panic("unexpected token type in Tcl_EvalTokens"); |
|
|
} |
|
|
|
|
|
/* |
|
|
* If valuePtr isn't NULL, the next piece of text comes from that |
|
|
* object; otherwise, take length bytes starting at p. |
|
|
*/ |
|
|
|
|
|
if (resultPtr == NULL) { |
|
|
if (valuePtr != NULL) { |
|
|
resultPtr = valuePtr; |
|
|
} else { |
|
|
resultPtr = Tcl_NewStringObj(p, length); |
|
|
} |
|
|
Tcl_IncrRefCount(resultPtr); |
|
|
} else { |
|
|
if (Tcl_IsShared(resultPtr)) { |
|
|
newPtr = Tcl_DuplicateObj(resultPtr); |
|
|
Tcl_DecrRefCount(resultPtr); |
|
|
resultPtr = newPtr; |
|
|
Tcl_IncrRefCount(resultPtr); |
|
|
} |
|
|
if (valuePtr != NULL) { |
|
|
p = Tcl_GetStringFromObj(valuePtr, &length); |
|
|
} |
|
|
Tcl_AppendToObj(resultPtr, p, length); |
|
|
} |
|
|
} |
|
|
return resultPtr; |
|
|
|
|
|
error: |
|
|
if (resultPtr != NULL) { |
|
|
Tcl_DecrRefCount(resultPtr); |
|
|
} |
|
|
return NULL; |
|
|
} |
|
|
|
|
|
/* |
|
|
*---------------------------------------------------------------------- |
|
|
* |
|
|
* Tcl_EvalEx -- |
|
|
* |
|
|
* This procedure evaluates a Tcl script without using the compiler |
|
|
* or byte-code interpreter. It just parses the script, creates |
|
|
* values for each word of each command, then calls EvalObjv |
|
|
* to execute each command. |
|
|
* |
|
|
* Results: |
|
|
* The return value is a standard Tcl completion code such as |
|
|
* TCL_OK or TCL_ERROR. A result or error message is left in |
|
|
* interp's result. |
|
|
* |
|
|
* Side effects: |
|
|
* Depends on the script. |
|
|
* |
|
|
*---------------------------------------------------------------------- |
|
|
*/ |
|
|
|
|
|
int |
|
|
Tcl_EvalEx(interp, script, numBytes, flags) |
|
|
Tcl_Interp *interp; /* Interpreter in which to evaluate the |
|
|
* script. Also used for error reporting. */ |
|
|
char *script; /* First character of script to evaluate. */ |
|
|
int numBytes; /* Number of bytes in script. If < 0, the |
|
|
* script consists of all bytes up to the |
|
|
* first null character. */ |
|
|
int flags; /* Collection of OR-ed bits that control |
|
|
* the evaluation of the script. Only |
|
|
* TCL_EVAL_GLOBAL is currently |
|
|
* supported. */ |
|
|
{ |
|
|
Interp *iPtr = (Interp *) interp; |
|
|
char *p, *next; |
|
|
Tcl_Parse parse; |
|
|
#define NUM_STATIC_OBJS 20 |
|
|
Tcl_Obj *staticObjArray[NUM_STATIC_OBJS], **objv; |
|
|
Tcl_Token *tokenPtr; |
|
|
int i, code, commandLength, bytesLeft, nested; |
|
|
CallFrame *savedVarFramePtr; /* Saves old copy of iPtr->varFramePtr |
|
|
* in case TCL_EVAL_GLOBAL was set. */ |
|
|
|
|
|
/* |
|
|
* The variables below keep track of how much state has been |
|
|
* allocated while evaluating the script, so that it can be freed |
|
|
* properly if an error occurs. |
|
|
*/ |
|
|
|
|
|
int gotParse = 0, objectsUsed = 0; |
|
|
|
|
|
if (numBytes < 0) { |
|
|
numBytes = strlen(script); |
|
|
} |
|
|
Tcl_ResetResult(interp); |
|
|
|
|
|
savedVarFramePtr = iPtr->varFramePtr; |
|
|
if (flags & TCL_EVAL_GLOBAL) { |
|
|
iPtr->varFramePtr = NULL; |
|
|
} |
|
|
|
|
|
/* |
|
|
* Each iteration through the following loop parses the next |
|
|
* command from the script and then executes it. |
|
|
*/ |
|
|
|
|
|
objv = staticObjArray; |
|
|
p = script; |
|
|
bytesLeft = numBytes; |
|
|
if (iPtr->evalFlags & TCL_BRACKET_TERM) { |
|
|
nested = 1; |
|
|
} else { |
|
|
nested = 0; |
|
|
} |
|
|
iPtr->evalFlags = 0; |
|
|
do { |
|
|
if (Tcl_ParseCommand(interp, p, bytesLeft, nested, &parse) |
|
|
!= TCL_OK) { |
|
|
code = TCL_ERROR; |
|
|
goto error; |
|
|
} |
|
|
gotParse = 1; |
|
|
if (parse.numWords > 0) { |
|
|
/* |
|
|
* Generate an array of objects for the words of the command. |
|
|
*/ |
|
|
|
|
|
if (parse.numWords <= NUM_STATIC_OBJS) { |
|
|
objv = staticObjArray; |
|
|
} else { |
|
|
objv = (Tcl_Obj **) ckalloc((unsigned) |
|
|
(parse.numWords * sizeof (Tcl_Obj *))); |
|
|
} |
|
|
for (objectsUsed = 0, tokenPtr = parse.tokenPtr; |
|
|
objectsUsed < parse.numWords; |
|
|
objectsUsed++, tokenPtr += (tokenPtr->numComponents + 1)) { |
|
|
objv[objectsUsed] = Tcl_EvalTokens(interp, tokenPtr+1, |
|
|
tokenPtr->numComponents); |
|
|
if (objv[objectsUsed] == NULL) { |
|
|
code = TCL_ERROR; |
|
|
goto error; |
|
|
} |
|
|
} |
|
|
|
|
|
/* |
|
|
* Execute the command and free the objects for its words. |
|
|
*/ |
|
|
|
|
|
code = EvalObjv(interp, objectsUsed, objv, p, bytesLeft, 0); |
|
|
if (code != TCL_OK) { |
|
|
goto error; |
|
|
} |
|
|
for (i = 0; i < objectsUsed; i++) { |
|
|
Tcl_DecrRefCount(objv[i]); |
|
|
} |
|
|
objectsUsed = 0; |
|
|
if (objv != staticObjArray) { |
|
|
ckfree((char *) objv); |
|
|
objv = staticObjArray; |
|
|
} |
|
|
} |
|
|
|
|
|
/* |
|
|
* Advance to the next command in the script. |
|
|
*/ |
|
|
|
|
|
next = parse.commandStart + parse.commandSize; |
|
|
bytesLeft -= next - p; |
|
|
p = next; |
|
|
Tcl_FreeParse(&parse); |
|
|
gotParse = 0; |
|
|
if ((nested != 0) && (p > script) && (p[-1] == ']')) { |
|
|
/* |
|
|
* We get here in the special case where the TCL_BRACKET_TERM |
|
|
* flag was set in the interpreter and we reached a close |
|
|
* bracket in the script. Return immediately. |
|
|
*/ |
|
|
|
|
|
iPtr->termOffset = (p - 1) - script; |
|
|
iPtr->varFramePtr = savedVarFramePtr; |
|
|
return TCL_OK; |
|
|
} |
|
|
} while (bytesLeft > 0); |
|
|
iPtr->termOffset = p - script; |
|
|
iPtr->varFramePtr = savedVarFramePtr; |
|
|
return TCL_OK; |
|
|
|
|
|
error: |
|
|
/* |
|
|
* Generate various pieces of error information, such as the line |
|
|
* number where the error occurred and information to add to the |
|
|
* errorInfo variable. Then free resources that had been allocated |
|
|
* to the command. |
|
|
*/ |
|
|
|
|
|
if ((code == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) { |
|
|
commandLength = parse.commandSize; |
|
|
if ((parse.commandStart + commandLength) != (script + numBytes)) { |
|
|
/* |
|
|
* The command where the error occurred didn't end at the end |
|
|
* of the script (i.e. it ended at a terminator character such |
|
|
* as ";". Reduce the length by one so that the error message |
|
|
* doesn't include the terminator character. |
|
|
*/ |
|
|
|
|
|
commandLength -= 1; |
|
|
} |
|
|
Tcl_LogCommandInfo(interp, script, parse.commandStart, commandLength); |
|
|
} |
|
|
|
|
|
for (i = 0; i < objectsUsed; i++) { |
|
|
Tcl_DecrRefCount(objv[i]); |
|
|
} |
|
|
if (gotParse) { |
|
|
p = parse.commandStart + parse.commandSize; |
|
|
Tcl_FreeParse(&parse); |
|
|
if ((nested != 0) && (p > script) && (p[-1] == ']')) { |
|
|
/* |
|
|
* We get here in the special case where the TCL_BRACKET_TERM |
|
|
* flag was set in the interpreter and we reached a close |
|
|
* bracket in the script. Return immediately. |
|
|
*/ |
|
|
|
|
|
iPtr->termOffset = (p - 1) - script; |
|
|
} else { |
|
|
iPtr->termOffset = p - script; |
|
|
} |
|
|
} |
|
|
if (objv != staticObjArray) { |
|
|
ckfree((char *) objv); |
|
|
} |
|
|
iPtr->varFramePtr = savedVarFramePtr; |
|
|
return code; |
|
|
} |
|
|
|
|
|
/* |
|
|
*---------------------------------------------------------------------- |
|
|
* |
|
|
* Tcl_Eval -- |
|
|
* |
|
|
* Execute a Tcl command in a string. This procedure executes the |
|
|
* script directly, rather than compiling it to bytecodes. Before |
|
|
* the arrival of the bytecode compiler in Tcl 8.0 Tcl_Eval was |
|
|
* the main procedure used for executing Tcl commands, but nowadays |
|
|
* it isn't used much. |
|
|
* |
|
|
* Results: |
|
|
* The return value is one of the return codes defined in tcl.h |
|
|
* (such as TCL_OK), and interp's result contains a value |
|
|
* to supplement the return code. The value of the result |
|
|
* will persist only until the next call to Tcl_Eval or Tcl_EvalObj: |
|
|
* you must copy it or lose it! |
|
|
* |
|
|
* Side effects: |
|
|
* Can be almost arbitrary, depending on the commands in the script. |
|
|
* |
|
|
*---------------------------------------------------------------------- |
|
|
*/ |
|
|
|
|
|
int |
|
|
Tcl_Eval(interp, string) |
|
|
Tcl_Interp *interp; /* Token for command interpreter (returned |
|
|
* by previous call to Tcl_CreateInterp). */ |
|
|
char *string; /* Pointer to TCL command to execute. */ |
|
|
{ |
|
|
int code; |
|
|
|
|
|
code = Tcl_EvalEx(interp, string, -1, 0); |
|
|
|
|
|
/* |
|
|
* For backwards compatibility with old C code that predates the |
|
|
* object system in Tcl 8.0, we have to mirror the object result |
|
|
* back into the string result (some callers may expect it there). |
|
|
*/ |
|
|
|
|
|
Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)), |
|
|
TCL_VOLATILE); |
|
|
return code; |
|
|
} |
|
|
|
|
|
/* |
|
|
*---------------------------------------------------------------------- |
|
|
* |
|
|
* Tcl_EvalObj, Tcl_GlobalEvalObj -- |
|
|
* |
|
|
* These functions are deprecated but we keep them around for backwards |
|
|
* compatibility reasons. |
|
|
* |
|
|
* Results: |
|
|
* See the functions they call. |
|
|
* |
|
|
* Side effects: |
|
|
* See the functions they call. |
|
|
* |
|
|
*---------------------------------------------------------------------- |
|
|
*/ |
|
|
|
|
|
#undef Tcl_EvalObj |
|
|
int |
|
|
Tcl_EvalObj(interp, objPtr) |
|
|
Tcl_Interp * interp; |
|
|
Tcl_Obj * objPtr; |
|
|
{ |
|
|
return Tcl_EvalObjEx(interp, objPtr, 0); |
|
|
} |
|
|
|
|
|
#undef Tcl_GlobalEvalObj |
|
|
int |
|
|
Tcl_GlobalEvalObj(interp, objPtr) |
|
|
Tcl_Interp * interp; |
|
|
Tcl_Obj * objPtr; |
|
|
{ |
|
|
return Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL); |
|
|
} |
|
|
|
|
|
/* |
|
|
*---------------------------------------------------------------------- |
|
|
* |
|
|
* Tcl_ParseVarName -- |
|
|
* |
|
|
* Given a string starting with a $ sign, parse off a variable |
|
|
* name and return information about the parse. |
|
|
* |
|
|
* Results: |
|
|
* The return value is TCL_OK if the command was parsed |
|
|
* successfully and TCL_ERROR otherwise. If an error occurs and |
|
|
* interp isn't NULL then an error message is left in its result. |
|
|
* On a successful return, tokenPtr and numTokens fields of |
|
|
* parsePtr are filled in with information about the variable name |
|
|
* that was parsed. The "size" field of the first new token gives |
|
|
* the total number of bytes in the variable name. Other fields in |
|
|
* parsePtr are undefined. |
|
|
* |
|
|
* Side effects: |
|
|
* If there is insufficient space in parsePtr to hold all the |
|
|
* information about the command, then additional space is |
|
|
* malloc-ed. If the procedure returns TCL_OK then the caller must |
|
|
* eventually invoke Tcl_FreeParse to release any additional space |
|
|
* that was allocated. |
|
|
* |
|
|
*---------------------------------------------------------------------- |
|
|
*/ |
|
|
|
|
|
int |
|
|
Tcl_ParseVarName(interp, string, numBytes, parsePtr, append) |
|
|
Tcl_Interp *interp; /* Interpreter to use for error reporting; |
|
|
* if NULL, then no error message is |
|
|
* provided. */ |
|
|
char *string; /* String containing variable name. First |
|
|
* character must be "$". */ |
|
|
int numBytes; /* Total number of bytes in string. If < 0, |
|
|
* the string consists of all bytes up to the |
|
|
* first null character. */ |
|
|
Tcl_Parse *parsePtr; /* Structure to fill in with information |
|
|
* about the variable name. */ |
|
|
int append; /* Non-zero means append tokens to existing |
|
|
* information in parsePtr; zero means ignore |
|
|
* existing tokens in parsePtr and reinitialize |
|
|
* it. */ |
|
|
{ |
|
|
Tcl_Token *tokenPtr; |
|
|
char *end, *src; |
|
|
unsigned char c; |
|
|
int varIndex, offset; |
|
|
Tcl_UniChar ch; |
|
|
unsigned array; |
|
|
|
|
|
if (numBytes >= 0) { |
|
|
end = string + numBytes; |
|
|
} else { |
|
|
end = string + strlen(string); |
|
|
} |
|
|
|
|
|
if (!append) { |
|
|
parsePtr->numWords = 0; |
|
|
parsePtr->tokenPtr = parsePtr->staticTokens; |
|
|
parsePtr->numTokens = 0; |
|
|
parsePtr->tokensAvailable = NUM_STATIC_TOKENS; |
|
|
parsePtr->string = string; |
|
|
parsePtr->end = end; |
|
|
parsePtr->interp = interp; |
|
|
parsePtr->errorType = TCL_PARSE_SUCCESS; |
|
|
parsePtr->incomplete = 0; |
|
|
} |
|
|
|
|
|
/* |
|
|
* Generate one token for the variable, an additional token for the |
|
|
* name, plus any number of additional tokens for the index, if |
|
|
* there is one. |
|
|
*/ |
|
|
|
|
|
src = string; |
|
|
if ((parsePtr->numTokens + 2) > parsePtr->tokensAvailable) { |
|
|
TclExpandTokenArray(parsePtr); |
|
|
} |
|
|
tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens]; |
|
|
tokenPtr->type = TCL_TOKEN_VARIABLE; |
|
|
tokenPtr->start = src; |
|
|
varIndex = parsePtr->numTokens; |
|
|
parsePtr->numTokens++; |
|
|
tokenPtr++; |
|
|
src++; |
|
|
if (src >= end) { |
|
|
goto justADollarSign; |
|
|
} |
|
|
tokenPtr->type = TCL_TOKEN_TEXT; |
|
|
tokenPtr->start = src; |
|
|
tokenPtr->numComponents = 0; |
|
|
|
|
|
/* |
|
|
* The name of the variable can have three forms: |
|
|
* 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. |
|
|
* :: sequences are also considered part of the variable |
|
|
* name, in order to support namespaces. If the following |
|
|
* character is an open parenthesis, then the information |
|
|
* between parentheses is the array element name. |
|
|
* 3. The $ sign is followed by something that isn't a letter, |
|
|
* digit, or underscore: in this case, there is no variable |
|
|
* name and the token is just "$". |
|
|
*/ |
|
|
|
|
|
if (*src == '{') { |
|
|
src++; |
|
|
tokenPtr->type = TCL_TOKEN_TEXT; |
|
|
tokenPtr->start = src; |
|
|
tokenPtr->numComponents = 0; |
|
|
while (1) { |
|
|
if (src == end) { |
|
|
if (interp != NULL) { |
|
|
Tcl_SetResult(interp, |
|
|
"missing close-brace for variable name", |
|
|
TCL_STATIC); |
|
|
} |
|
|
parsePtr->errorType = TCL_PARSE_MISSING_VAR_BRACE; |
|
|
parsePtr->term = tokenPtr->start-1; |
|
|
parsePtr->incomplete = 1; |
|
|
goto error; |
|
|
} |
|
|
if (*src == '}') { |
|
|
break; |
|
|
} |
|
|
src++; |
|
|
} |
|
|
tokenPtr->size = src - tokenPtr->start; |
|
|
tokenPtr[-1].size = src - tokenPtr[-1].start; |
|
|
parsePtr->numTokens++; |
|
|
src++; |
|
|
} else { |
|
|
tokenPtr->type = TCL_TOKEN_TEXT; |
|
|
tokenPtr->start = src; |
|
|
tokenPtr->numComponents = 0; |
|
|
while (src != end) { |
|
|
offset = Tcl_UtfToUniChar(src, &ch); |
|
|
c = UCHAR(ch); |
|
|
if (isalnum(c) || (c == '_')) { /* INTL: ISO only, UCHAR. */ |
|
|
src += offset; |
|
|
continue; |
|
|
} |
|
|
if ((c == ':') && (((src+1) != end) && (src[1] == ':'))) { |
|
|
src += 2; |
|
|
while ((src != end) && (*src == ':')) { |
|
|
src += 1; |
|
|
} |
|
|
continue; |
|
|
} |
|
|
break; |
|
|
} |
|
|
|
|
|
/* |
|
|
* Support for empty array names here. |
|
|
*/ |
|
|
array = ((src != end) && (*src == '(')); |
|
|
tokenPtr->size = src - tokenPtr->start; |
|
|
if (tokenPtr->size == 0 && !array) { |
|
|
goto justADollarSign; |
|
|
} |
|
|
parsePtr->numTokens++; |
|
|
if (array) { |
|
|
/* |
|
|
* This is a reference to an array element. Call |
|
|
* ParseTokens recursively to parse the element name, |
|
|
* since it could contain any number of substitutions. |
|
|
*/ |
|
|
|
|
|
if (ParseTokens(src+1, TYPE_CLOSE_PAREN, parsePtr) |
|
|
!= TCL_OK) { |
|
|
goto error; |
|
|
} |
|
|
if ((parsePtr->term == end) || (*parsePtr->term != ')')) { |
|
|
if (parsePtr->interp != NULL) { |
|
|
Tcl_SetResult(parsePtr->interp, "missing )", |
|
|
TCL_STATIC); |
|
|
} |
|
|
parsePtr->errorType = TCL_PARSE_MISSING_PAREN; |
|
|
parsePtr->term = src; |
|
|
parsePtr->incomplete = 1; |
|
|
goto error; |
|
|
} |
|
|
src = parsePtr->term + 1; |
|
|
} |
|
|
} |
|
|
tokenPtr = &parsePtr->tokenPtr[varIndex]; |
|
|
tokenPtr->size = src - tokenPtr->start; |
|
|
tokenPtr->numComponents = parsePtr->numTokens - (varIndex + 1); |
|
|
return TCL_OK; |
|
|
|
|
|
/* |
|
|
* The dollar sign isn't followed by a variable name. |
|
|
* replace the TCL_TOKEN_VARIABLE token with a |
|
|
* TCL_TOKEN_TEXT token for the dollar sign. |
|
|
*/ |
|
|
|
|
|
justADollarSign: |
|
|
tokenPtr = &parsePtr->tokenPtr[varIndex]; |
|
|
tokenPtr->type = TCL_TOKEN_TEXT; |
|
|
tokenPtr->size = 1; |
|
|
tokenPtr->numComponents = 0; |
|
|
return TCL_OK; |
|
|
|
|
|
error: |
|
|
Tcl_FreeParse(parsePtr); |
|
|
return TCL_ERROR; |
|
|
} |
|
|
|
|
|
/* |
|
|
*---------------------------------------------------------------------- |
|
|
* |
|
|
* 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's 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. */ |
|
|
|
|
|
{ |
|
|
Tcl_Parse parse; |
|
|
register Tcl_Obj *objPtr; |
|
|
|
|
|
if (Tcl_ParseVarName(interp, string, -1, &parse, 0) != TCL_OK) { |
|
|
return NULL; |
|
|
} |
|
|
|
|
|
if (termPtr != NULL) { |
|
|
*termPtr = string + parse.tokenPtr->size; |
|
|
} |
|
|
if (parse.numTokens == 1) { |
|
|
/* |
|
|
* There isn't a variable name after all: the $ is just a $. |
|
|
*/ |
|
|
|
|
|
return "$"; |
|
|
} |
|
|
|
|
|
objPtr = Tcl_EvalTokens(interp, parse.tokenPtr, parse.numTokens); |
|
|
if (objPtr == NULL) { |
|
|
return NULL; |
|
|
} |
|
|
|
|
|
/* |
|
|
* At this point we should have an object containing the value of |
|
|
* a variable. Just return the string from that object. |
|
|
*/ |
|
|
|
|
|
#ifdef TCL_COMPILE_DEBUG |
|
|
if (objPtr->refCount < 2) { |
|
|
panic("Tcl_ParseVar got temporary object from Tcl_EvalTokens"); |
|
|
} |
|
|
#endif /*TCL_COMPILE_DEBUG*/ |
|
|
TclDecrRefCount(objPtr); |
|
|
return TclGetString(objPtr); |
|
|
} |
|
|
|
|
|
/* |
|
|
*---------------------------------------------------------------------- |
|
|
* |
|
|
* Tcl_ParseBraces -- |
|
|
* |
|
|
* Given a string in braces such as a Tcl command argument or a string |
|
|
* value in a Tcl expression, this procedure parses the string and |
|
|
* returns information about the parse. |
|
|
* |
|
|
* Results: |
|
|
* The return value is TCL_OK if the string was parsed successfully and |
|
|
* TCL_ERROR otherwise. If an error occurs and interp isn't NULL then |
|
|
* an error message is left in its result. On a successful return, |
|
|
* tokenPtr and numTokens fields of parsePtr are filled in with |
|
|
* information about the string that was parsed. Other fields in |
|
|
* parsePtr are undefined. termPtr is set to point to the character |
|
|
* just after the last one in the braced string. |
|
|
* |
|
|
* Side effects: |
|
|
* If there is insufficient space in parsePtr to hold all the |
|
|
* information about the command, then additional space is |
|
|
* malloc-ed. If the procedure returns TCL_OK then the caller must |
|
|
* eventually invoke Tcl_FreeParse to release any additional space |
|
|
* that was allocated. |
|
|
* |
|
|
*---------------------------------------------------------------------- |
|
|
*/ |
|
|
|
|
|
int |
|
|
Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr) |
|
|
Tcl_Interp *interp; /* Interpreter to use for error reporting; |
|
|
* if NULL, then no error message is |
|
|
* provided. */ |
|
|
char *string; /* String containing the string in braces. |
|
|
* The first character must be '{'. */ |
|
|
int numBytes; /* Total number of bytes in string. If < 0, |
|
|
* the string consists of all bytes up to |
|
|
* the first null character. */ |
|
|
register Tcl_Parse *parsePtr; |
|
|
/* Structure to fill in with information |
|
|
* about the string. */ |
|
|
int append; /* Non-zero means append tokens to existing |
|
|
* information in parsePtr; zero means |
|
|
* ignore existing tokens in parsePtr and |
|
|
* reinitialize it. */ |
|
|
char **termPtr; /* If non-NULL, points to word in which to |
|
|
* store a pointer to the character just |
|
|
* after the terminating '}' if the parse |
|
|
* was successful. */ |
|
|
|
|
|
{ |
|
|
char utfBytes[TCL_UTF_MAX]; /* For result of backslash substitution. */ |
|
|
Tcl_Token *tokenPtr; |
|
|
register char *src, *end; |
|
|
int startIndex, level, length; |
|
|
|
|
|
if ((numBytes >= 0) || (string == NULL)) { |
|
|
end = string + numBytes; |
|
|
} else { |
|
|
end = string + strlen(string); |
|
|
} |
|
|
|
|
|
if (!append) { |
|
|
parsePtr->numWords = 0; |
|
|
parsePtr->tokenPtr = parsePtr->staticTokens; |
|
|
parsePtr->numTokens = 0; |
|
|
parsePtr->tokensAvailable = NUM_STATIC_TOKENS; |
|
|
parsePtr->string = string; |
|
|
parsePtr->end = end; |
|
|
parsePtr->interp = interp; |
|
|
parsePtr->errorType = TCL_PARSE_SUCCESS; |
|
|
} |
|
|
|
|
|
src = string+1; |
|
|
startIndex = parsePtr->numTokens; |
|
|
|
|
|
if (parsePtr->numTokens == parsePtr->tokensAvailable) { |
|
|
TclExpandTokenArray(parsePtr); |
|
|
} |
|
|
tokenPtr = &parsePtr->tokenPtr[startIndex]; |
|
|
tokenPtr->type = TCL_TOKEN_TEXT; |
|
|
tokenPtr->start = src; |
|
|
tokenPtr->numComponents = 0; |
|
|
level = 1; |
|
|
while (1) { |
|
|
while (CHAR_TYPE(*src) == TYPE_NORMAL) { |
|
|
src++; |
|
|
} |
|
|
if (*src == '}') { |
|
|
level--; |
|
|
if (level == 0) { |
|
|
break; |
|
|
} |
|
|
src++; |
|
|
} else if (*src == '{') { |
|
|
level++; |
|
|
src++; |
|
|
} else if (*src == '\\') { |
|
|
Tcl_UtfBackslash(src, &length, utfBytes); |
|
|
if (src[1] == '\n') { |
|
|
/* |
|
|
* A backslash-newline sequence must be collapsed, even |
|
|
* inside braces, so we have to split the word into |
|
|
* multiple tokens so that the backslash-newline can be |
|
|
* represented explicitly. |
|
|
*/ |
|
|
|
|
|
if ((src + 2) == end) { |
|
|
parsePtr->incomplete = 1; |
|
|
} |
|
|
tokenPtr->size = (src - tokenPtr->start); |
|
|
if (tokenPtr->size != 0) { |
|
|
parsePtr->numTokens++; |
|
|
} |
|
|
if ((parsePtr->numTokens+1) >= parsePtr->tokensAvailable) { |
|
|
TclExpandTokenArray(parsePtr); |
|
|
} |
|
|
tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens]; |
|
|
tokenPtr->type = TCL_TOKEN_BS; |
|
|
tokenPtr->start = src; |
|
|
tokenPtr->size = length; |
|
|
tokenPtr->numComponents = 0; |
|
|
parsePtr->numTokens++; |
|
|
|
|
|
src += length; |
|
|
tokenPtr++; |
|
|
tokenPtr->type = TCL_TOKEN_TEXT; |
|
|
tokenPtr->start = src; |
|
|
tokenPtr->numComponents = 0; |
|
|
} else { |
|
|
src += length; |
|
|
} |
|
|
} else if (src == end) { |
|
|
int openBrace; |
|
|
|
|
|
if (interp != NULL) { |
|
|
Tcl_SetResult(interp, "missing close-brace", TCL_STATIC); |
|
|
} |
|
|
/* |
|
|
* Search the source string for a possible open |
|
|
* brace within the context of a comment. Since we |
|
|
* aren't performing a full Tcl parse, just look for |
|
|
* an open brace preceeded by a '<whitspace>#' on |
|
|
* the same line. |
|
|
*/ |
|
|
openBrace = 0; |
|
|
while (src > string ) { |
|
|
switch (*src) { |
|
|
case '{': |
|
|
openBrace = 1; |
|
|
break; |
|
|
case '\n': |
|
|
openBrace = 0; |
|
|
break; |
|
|
case '#': |
|
|
if ((openBrace == 1) && (isspace(UCHAR(src[-1])))) { |
|
|
if (interp != NULL) { |
|
|
Tcl_AppendResult(interp, |
|
|
": possible unbalanced brace in comment", |
|
|
(char *) NULL); |
|
|
} |
|
|
openBrace = -1; |
|
|
break; |
|
|
} |
|
|
break; |
|
|
} |
|
|
if (openBrace == -1) { |
|
|
break; |
|
|
} |
|
|
src--; |
|
|
} |
|
|
parsePtr->errorType = TCL_PARSE_MISSING_BRACE; |
|
|
parsePtr->term = string; |
|
|
parsePtr->incomplete = 1; |
|
|
goto error; |
|
|
} else { |
|
|
src++; |
|
|
} |
|
|
} |
|
|
|
|
|
/* |
|
|
* Decide if we need to finish emitting a partially-finished token. |
|
|
* There are 3 cases: |
|
|
* {abc \newline xyz} or {xyz} - finish emitting "xyz" token |
|
|
* {abc \newline} - don't emit token after \newline |
|
|
* {} - finish emitting zero-sized token |
|
|
* The last case ensures that there is a token (even if empty) that |
|
|
* describes the braced string. |
|
|
*/ |
|
|
|
|
|
if ((src != tokenPtr->start) |
|
|
|| (parsePtr->numTokens == startIndex)) { |
|
|
tokenPtr->size = (src - tokenPtr->start); |
|
|
parsePtr->numTokens++; |
|
|
} |
|
|
if (termPtr != NULL) { |
|
|
*termPtr = src+1; |
|
|
} |
|
|
return TCL_OK; |
|
|
|
|
|
error: |
|
|
Tcl_FreeParse(parsePtr); |
|
|
return TCL_ERROR; |
|
|
} |
|
|
|
|
|
/* |
|
|
*---------------------------------------------------------------------- |
|
|
* |
|
|
* Tcl_ParseQuotedString -- |
|
|
* |
|
|
* Given a double-quoted string such as a quoted Tcl command argument |
|
|
* or a quoted value in a Tcl expression, this procedure parses the |
|
|
* string and returns information about the parse. |
|
|
* |
|
|
* Results: |
|
|
* The return value is TCL_OK if the string was parsed successfully and |
|
|
* TCL_ERROR otherwise. If an error occurs and interp isn't NULL then |
|
|
* an error message is left in its result. On a successful return, |
|
|
* tokenPtr and numTokens fields of parsePtr are filled in with |
|
|
* information about the string that was parsed. Other fields in |
|
|
* parsePtr are undefined. termPtr is set to point to the character |
|
|
* just after the quoted string's terminating close-quote. |
|
|
* |
|
|
* Side effects: |
|
|
* If there is insufficient space in parsePtr to hold all the |
|
|
* information about the command, then additional space is |
|
|
* malloc-ed. If the procedure returns TCL_OK then the caller must |
|
|
* eventually invoke Tcl_FreeParse to release any additional space |
|
|
* that was allocated. |
|
|
* |
|
|
*---------------------------------------------------------------------- |
|
|
*/ |
|
|
|
|
|
int |
|
|
Tcl_ParseQuotedString(interp, string, numBytes, parsePtr, append, termPtr) |
|
|
Tcl_Interp *interp; /* Interpreter to use for error reporting; |
|
|
* if NULL, then no error message is |
|
|
* provided. */ |
|
|
char *string; /* String containing the quoted string. |
|
|
* The first character must be '"'. */ |
|
|
int numBytes; /* Total number of bytes in string. If < 0, |
|
|
* the string consists of all bytes up to |
|
|
* the first null character. */ |
|
|
register Tcl_Parse *parsePtr; |
|
|
/* Structure to fill in with information |
|
|
* about the string. */ |
|
|
int append; /* Non-zero means append tokens to existing |
|
|
* information in parsePtr; zero means |
|
|
* ignore existing tokens in parsePtr and |
|
|
* reinitialize it. */ |
|
|
char **termPtr; /* If non-NULL, points to word in which to |
|
|
* store a pointer to the character just |
|
|
* after the quoted string's terminating |
|
|
* close-quote if the parse succeeds. */ |
|
|
{ |
|
|
char *end; |
|
|
|
|
|
if ((numBytes >= 0) || (string == NULL)) { |
|
|
end = string + numBytes; |
|
|
} else { |
|
|
end = string + strlen(string); |
|
|
} |
|
|
|
|
|
if (!append) { |
|
|
parsePtr->numWords = 0; |
|
|
parsePtr->tokenPtr = parsePtr->staticTokens; |
|
|
parsePtr->numTokens = 0; |
|
|
parsePtr->tokensAvailable = NUM_STATIC_TOKENS; |
|
|
parsePtr->string = string; |
|
|
parsePtr->end = end; |
|
|
parsePtr->interp = interp; |
|
|
parsePtr->errorType = TCL_PARSE_SUCCESS; |
|
|
} |
|
|
|
|
|
if (ParseTokens(string+1, TYPE_QUOTE, parsePtr) != TCL_OK) { |
|
|
goto error; |
|
|
} |
|
|
if (*parsePtr->term != '"') { |
|
|
if (interp != NULL) { |
|
|
Tcl_SetResult(parsePtr->interp, "missing \"", TCL_STATIC); |
|
|
} |
|
|
parsePtr->errorType = TCL_PARSE_MISSING_QUOTE; |
|
|
parsePtr->term = string; |
|
|
parsePtr->incomplete = 1; |
|
|
goto error; |
|
|
} |
|
|
if (termPtr != NULL) { |
|
|
*termPtr = (parsePtr->term + 1); |
|
|
} |
|
|
return TCL_OK; |
|
|
|
|
|
error: |
|
|
Tcl_FreeParse(parsePtr); |
|
|
return TCL_ERROR; |
|
|
} |
|
|
|
|
|
/* |
|
|
*---------------------------------------------------------------------- |
|
|
* |
|
|
* CommandComplete -- |
|
|
* |
|
|
* This procedure is shared by TclCommandComplete and |
|
|
* Tcl_ObjCommandcoComplete; it does all the real work of seeing |
|
|
* whether a script is complete |
|
|
* |
|
|
* Results: |
|
|
* 1 is returned if the script is complete, 0 if there are open |
|
|
* delimiters such as " or (. 1 is also returned if there is a |
|
|
* parse error in the script other than unmatched delimiters. |
|
|
* |
|
|
* Side effects: |
|
|
* None. |
|
|
* |
|
|
*---------------------------------------------------------------------- |
|
|
*/ |
|
|
|
|
|
static int |
|
|
CommandComplete(script, length) |
|
|
char *script; /* Script to check. */ |
|
|
int length; /* Number of bytes in script. */ |
|
|
{ |
|
|
Tcl_Parse parse; |
|
|
char *p, *end; |
|
|
int result; |
|
|
|
|
|
p = script; |
|
|
end = p + length; |
|
|
while (Tcl_ParseCommand((Tcl_Interp *) NULL, p, end - p, 0, &parse) |
|
|
== TCL_OK) { |
|
|
p = parse.commandStart + parse.commandSize; |
|
|
if (*p == 0) { |
|
|
break; |
|
|
} |
|
|
Tcl_FreeParse(&parse); |
|
|
} |
|
|
if (parse.incomplete) { |
|
|
result = 0; |
|
|
} else { |
|
|
result = 1; |
|
|
} |
|
|
Tcl_FreeParse(&parse); |
|
|
return result; |
|
|
} |
|
|
|
|
|
/* |
|
|
*---------------------------------------------------------------------- |
|
|
* |
|
|
* Tcl_CommandComplete -- |
|
|
* |
|
|
* Given a partial or complete Tcl script, this procedure |
|
|
* determines whether the script is complete in the sense |
|
|
* of having matched braces and quotes and brackets. |
|
|
* |
|
|
* Results: |
|
|
* 1 is returned if the script is complete, 0 otherwise. |
|
|
* 1 is also returned if there is a parse error in the script |
|
|
* other than unmatched delimiters. |
|
|
* |
|
|
* Side effects: |
|
|
* None. |
|
|
* |
|
|
*---------------------------------------------------------------------- |
|
|
*/ |
|
|
|
|
|
int |
|
|
Tcl_CommandComplete(script) |
|
|
char *script; /* Script to check. */ |
|
|
{ |
|
|
return CommandComplete(script, (int) strlen(script)); |
|
|
} |
|
|
|
|
|
/* |
|
|
*---------------------------------------------------------------------- |
|
|
* |
|
|
* TclObjCommandComplete -- |
|
|
* |
|
|
* Given a partial or complete Tcl command in a Tcl object, 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 |
|
|
TclObjCommandComplete(objPtr) |
|
|
Tcl_Obj *objPtr; /* Points to object holding script |
|
|
* to check. */ |
|
|
{ |
|
|
char *script; |
|
|
int length; |
|
|
|
|
|
script = Tcl_GetStringFromObj(objPtr, &length); |
|
|
return CommandComplete(script, length); |
|
|
} |
|
|
|
|
|
/* |
|
|
*---------------------------------------------------------------------- |
|
|
* |
|
|
* TclIsLocalScalar -- |
|
|
* |
|
|
* Check to see if a given string is a legal scalar variable |
|
|
* name with no namespace qualifiers or substitutions. |
|
|
* |
|
|
* Results: |
|
|
* Returns 1 if the variable is a local scalar. |
|
|
* |
|
|
* Side effects: |
|
|
* None. |
|
|
* |
|
|
*---------------------------------------------------------------------- |
|
|
*/ |
|
|
|
|
|
int |
|
|
TclIsLocalScalar(src, len) |
|
|
CONST char *src; |
|
|
int len; |
|
|
{ |
|
|
CONST char *p; |
|
|
CONST char *lastChar = src + (len - 1); |
|
|
|
|
|
for (p = src; p <= lastChar; p++) { |
|
|
if ((CHAR_TYPE(*p) != TYPE_NORMAL) && |
|
|
(CHAR_TYPE(*p) != TYPE_COMMAND_END)) { |
|
|
/* |
|
|
* TCL_COMMAND_END is returned for the last character |
|
|
* of the string. By this point we know it isn't |
|
|
* an array or namespace reference. |
|
|
*/ |
|
|
|
|
|
return 0; |
|
|
} |
|
|
if (*p == '(') { |
|
|
if (*lastChar == ')') { /* we have an array element */ |
|
|
return 0; |
|
|
} |
|
|
} else if (*p == ':') { |
|
|
if ((p != lastChar) && *(p+1) == ':') { /* qualified name */ |
|
|
return 0; |
|
|
} |
|
|
} |
|
|
} |
|
|
|
|
|
return 1; |
|
|
} |
|
|
|
|
|
|
|
|
/* $History: tclparse.c $ |
|
|
* |
|
|
* ***************** Version 1 ***************** |
|
|
* User: Dtashley Date: 1/02/01 Time: 1:37a |
|
|
* Created in $/IjuScripter, IjuConsole/Source/Tcl Base |
|
|
* Initial check-in. |
|
|
*/ |
|
|
|
|
|
/* End of TCLPARSE.C */ |
|
| 1 |
|
/* $Header$ */ |
| 2 |
|
/* |
| 3 |
|
* tclParse.c -- |
| 4 |
|
* |
| 5 |
|
* This file contains procedures that parse Tcl scripts. They |
| 6 |
|
* do so in a general-purpose fashion that can be used for many |
| 7 |
|
* different purposes, including compilation, direct execution, |
| 8 |
|
* code analysis, etc. This file also includes a few additional |
| 9 |
|
* procedures such as Tcl_EvalObjv, Tcl_Eval, and Tcl_EvalEx, which |
| 10 |
|
* allow scripts to be evaluated directly, without compiling. |
| 11 |
|
* |
| 12 |
|
* Copyright (c) 1997 Sun Microsystems, Inc. |
| 13 |
|
* Copyright (c) 1998 by Scriptics Corporation. |
| 14 |
|
* |
| 15 |
|
* See the file "license.terms" for information on usage and redistribution |
| 16 |
|
* of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
| 17 |
|
* |
| 18 |
|
* RCS: @(#) $Id: tclparse.c,v 1.1.1.1 2001/06/13 04:44:26 dtashley Exp $ |
| 19 |
|
*/ |
| 20 |
|
|
| 21 |
|
#include "tclInt.h" |
| 22 |
|
#include "tclPort.h" |
| 23 |
|
|
| 24 |
|
/* |
| 25 |
|
* The following table provides parsing information about each possible |
| 26 |
|
* 8-bit character. The table is designed to be referenced with either |
| 27 |
|
* signed or unsigned characters, so it has 384 entries. The first 128 |
| 28 |
|
* entries correspond to negative character values, the next 256 correspond |
| 29 |
|
* to positive character values. The last 128 entries are identical to the |
| 30 |
|
* first 128. The table is always indexed with a 128-byte offset (the 128th |
| 31 |
|
* entry corresponds to a character value of 0). |
| 32 |
|
* |
| 33 |
|
* The macro CHAR_TYPE is used to index into the table and return |
| 34 |
|
* information about its character argument. The following return |
| 35 |
|
* values are defined. |
| 36 |
|
* |
| 37 |
|
* TYPE_NORMAL - All characters that don't have special significance |
| 38 |
|
* to the Tcl parser. |
| 39 |
|
* TYPE_SPACE - The character is a whitespace character other |
| 40 |
|
* than newline. |
| 41 |
|
* TYPE_COMMAND_END - Character is newline or semicolon. |
| 42 |
|
* TYPE_SUBS - Character begins a substitution or has other |
| 43 |
|
* special meaning in ParseTokens: backslash, dollar |
| 44 |
|
* sign, open bracket, or null. |
| 45 |
|
* TYPE_QUOTE - Character is a double quote. |
| 46 |
|
* TYPE_CLOSE_PAREN - Character is a right parenthesis. |
| 47 |
|
* TYPE_CLOSE_BRACK - Character is a right square bracket. |
| 48 |
|
* TYPE_BRACE - Character is a curly brace (either left or right). |
| 49 |
|
*/ |
| 50 |
|
|
| 51 |
|
#define TYPE_NORMAL 0 |
| 52 |
|
#define TYPE_SPACE 0x1 |
| 53 |
|
#define TYPE_COMMAND_END 0x2 |
| 54 |
|
#define TYPE_SUBS 0x4 |
| 55 |
|
#define TYPE_QUOTE 0x8 |
| 56 |
|
#define TYPE_CLOSE_PAREN 0x10 |
| 57 |
|
#define TYPE_CLOSE_BRACK 0x20 |
| 58 |
|
#define TYPE_BRACE 0x40 |
| 59 |
|
|
| 60 |
|
#define CHAR_TYPE(c) (typeTable+128)[(int)(c)] |
| 61 |
|
|
| 62 |
|
char typeTable[] = { |
| 63 |
|
/* |
| 64 |
|
* Negative character values, from -128 to -1: |
| 65 |
|
*/ |
| 66 |
|
|
| 67 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 68 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 69 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 70 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 71 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 72 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 73 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 74 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 75 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 76 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 77 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 78 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 79 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 80 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 81 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 82 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 83 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 84 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 85 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 86 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 87 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 88 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 89 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 90 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 91 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 92 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 93 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 94 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 95 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 96 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 97 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 98 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 99 |
|
|
| 100 |
|
/* |
| 101 |
|
* Positive character values, from 0-127: |
| 102 |
|
*/ |
| 103 |
|
|
| 104 |
|
TYPE_SUBS, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 105 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 106 |
|
TYPE_NORMAL, TYPE_SPACE, TYPE_COMMAND_END, TYPE_SPACE, |
| 107 |
|
TYPE_SPACE, TYPE_SPACE, TYPE_NORMAL, TYPE_NORMAL, |
| 108 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 109 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 110 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 111 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 112 |
|
TYPE_SPACE, TYPE_NORMAL, TYPE_QUOTE, TYPE_NORMAL, |
| 113 |
|
TYPE_SUBS, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 114 |
|
TYPE_NORMAL, TYPE_CLOSE_PAREN, TYPE_NORMAL, TYPE_NORMAL, |
| 115 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 116 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 117 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 118 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_COMMAND_END, |
| 119 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 120 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 121 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 122 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 123 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 124 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 125 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 126 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_SUBS, |
| 127 |
|
TYPE_SUBS, TYPE_CLOSE_BRACK, TYPE_NORMAL, TYPE_NORMAL, |
| 128 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 129 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 130 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 131 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 132 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 133 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 134 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_BRACE, |
| 135 |
|
TYPE_NORMAL, TYPE_BRACE, TYPE_NORMAL, TYPE_NORMAL, |
| 136 |
|
|
| 137 |
|
/* |
| 138 |
|
* Large unsigned character values, from 128-255: |
| 139 |
|
*/ |
| 140 |
|
|
| 141 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 142 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 143 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 144 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 145 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 146 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 147 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 148 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 149 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 150 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 151 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 152 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 153 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 154 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 155 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 156 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 157 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 158 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 159 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 160 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 161 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 162 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 163 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 164 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 165 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 166 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 167 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 168 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 169 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 170 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 171 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 172 |
|
TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, |
| 173 |
|
}; |
| 174 |
|
|
| 175 |
|
/* |
| 176 |
|
* Prototypes for local procedures defined in this file: |
| 177 |
|
*/ |
| 178 |
|
|
| 179 |
|
static int CommandComplete _ANSI_ARGS_((char *script, |
| 180 |
|
int length)); |
| 181 |
|
static int ParseTokens _ANSI_ARGS_((char *src, int mask, |
| 182 |
|
Tcl_Parse *parsePtr)); |
| 183 |
|
static int EvalObjv _ANSI_ARGS_((Tcl_Interp *interp, int objc, |
| 184 |
|
Tcl_Obj *CONST objv[], char *command, int length, |
| 185 |
|
int flags)); |
| 186 |
|
|
| 187 |
|
/* |
| 188 |
|
*---------------------------------------------------------------------- |
| 189 |
|
* |
| 190 |
|
* Tcl_ParseCommand -- |
| 191 |
|
* |
| 192 |
|
* Given a string, this procedure parses the first Tcl command |
| 193 |
|
* in the string and returns information about the structure of |
| 194 |
|
* the command. |
| 195 |
|
* |
| 196 |
|
* Results: |
| 197 |
|
* The return value is TCL_OK if the command was parsed |
| 198 |
|
* successfully and TCL_ERROR otherwise. If an error occurs |
| 199 |
|
* and interp isn't NULL then an error message is left in |
| 200 |
|
* its result. On a successful return, parsePtr is filled in |
| 201 |
|
* with information about the command that was parsed. |
| 202 |
|
* |
| 203 |
|
* Side effects: |
| 204 |
|
* If there is insufficient space in parsePtr to hold all the |
| 205 |
|
* information about the command, then additional space is |
| 206 |
|
* malloc-ed. If the procedure returns TCL_OK then the caller must |
| 207 |
|
* eventually invoke Tcl_FreeParse to release any additional space |
| 208 |
|
* that was allocated. |
| 209 |
|
* |
| 210 |
|
*---------------------------------------------------------------------- |
| 211 |
|
*/ |
| 212 |
|
|
| 213 |
|
int |
| 214 |
|
Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr) |
| 215 |
|
Tcl_Interp *interp; /* Interpreter to use for error reporting; |
| 216 |
|
* if NULL, then no error message is |
| 217 |
|
* provided. */ |
| 218 |
|
char *string; /* First character of string containing |
| 219 |
|
* one or more Tcl commands. The string |
| 220 |
|
* must be in writable memory and must |
| 221 |
|
* have one additional byte of space at |
| 222 |
|
* string[length] where we can |
| 223 |
|
* temporarily store a 0 sentinel |
| 224 |
|
* character. */ |
| 225 |
|
int numBytes; /* Total number of bytes in string. If < 0, |
| 226 |
|
* the script consists of all bytes up to |
| 227 |
|
* the first null character. */ |
| 228 |
|
int nested; /* Non-zero means this is a nested command: |
| 229 |
|
* close bracket should be considered |
| 230 |
|
* a command terminator. If zero, then close |
| 231 |
|
* bracket has no special meaning. */ |
| 232 |
|
register Tcl_Parse *parsePtr; |
| 233 |
|
/* Structure to fill in with information |
| 234 |
|
* about the parsed command; any previous |
| 235 |
|
* information in the structure is |
| 236 |
|
* ignored. */ |
| 237 |
|
{ |
| 238 |
|
register char *src; /* Points to current character |
| 239 |
|
* in the command. */ |
| 240 |
|
int type; /* Result returned by CHAR_TYPE(*src). */ |
| 241 |
|
Tcl_Token *tokenPtr; /* Pointer to token being filled in. */ |
| 242 |
|
int wordIndex; /* Index of word token for current word. */ |
| 243 |
|
char utfBytes[TCL_UTF_MAX]; /* Holds result of backslash substitution. */ |
| 244 |
|
int terminators; /* CHAR_TYPE bits that indicate the end |
| 245 |
|
* of a command. */ |
| 246 |
|
char *termPtr; /* Set by Tcl_ParseBraces/QuotedString to |
| 247 |
|
* point to char after terminating one. */ |
| 248 |
|
int length, savedChar; |
| 249 |
|
|
| 250 |
|
|
| 251 |
|
if (numBytes < 0) { |
| 252 |
|
numBytes = (string? strlen(string) : 0); |
| 253 |
|
} |
| 254 |
|
parsePtr->commentStart = NULL; |
| 255 |
|
parsePtr->commentSize = 0; |
| 256 |
|
parsePtr->commandStart = NULL; |
| 257 |
|
parsePtr->commandSize = 0; |
| 258 |
|
parsePtr->numWords = 0; |
| 259 |
|
parsePtr->tokenPtr = parsePtr->staticTokens; |
| 260 |
|
parsePtr->numTokens = 0; |
| 261 |
|
parsePtr->tokensAvailable = NUM_STATIC_TOKENS; |
| 262 |
|
parsePtr->string = string; |
| 263 |
|
parsePtr->end = string + numBytes; |
| 264 |
|
parsePtr->term = parsePtr->end; |
| 265 |
|
parsePtr->interp = interp; |
| 266 |
|
parsePtr->incomplete = 0; |
| 267 |
|
parsePtr->errorType = TCL_PARSE_SUCCESS; |
| 268 |
|
if (nested != 0) { |
| 269 |
|
terminators = TYPE_COMMAND_END | TYPE_CLOSE_BRACK; |
| 270 |
|
} else { |
| 271 |
|
terminators = TYPE_COMMAND_END; |
| 272 |
|
} |
| 273 |
|
|
| 274 |
|
/* |
| 275 |
|
* Temporarily overwrite the character just after the end of the |
| 276 |
|
* string with a 0 byte. This acts as a sentinel and reduces the |
| 277 |
|
* number of places where we have to check for the end of the |
| 278 |
|
* input string. The original value of the byte is restored at |
| 279 |
|
* the end of the parse. |
| 280 |
|
*/ |
| 281 |
|
|
| 282 |
|
savedChar = string[numBytes]; |
| 283 |
|
if (savedChar != 0) { |
| 284 |
|
string[numBytes] = 0; |
| 285 |
|
} |
| 286 |
|
|
| 287 |
|
/* |
| 288 |
|
* Parse any leading space and comments before the first word of the |
| 289 |
|
* command. |
| 290 |
|
*/ |
| 291 |
|
|
| 292 |
|
src = string; |
| 293 |
|
while (1) { |
| 294 |
|
while ((CHAR_TYPE(*src) == TYPE_SPACE) || (*src == '\n')) { |
| 295 |
|
src++; |
| 296 |
|
} |
| 297 |
|
if ((*src == '\\') && (src[1] == '\n')) { |
| 298 |
|
/* |
| 299 |
|
* Skip backslash-newline sequence: it should be treated |
| 300 |
|
* just like white space. |
| 301 |
|
*/ |
| 302 |
|
|
| 303 |
|
if ((src + 2) == parsePtr->end) { |
| 304 |
|
parsePtr->incomplete = 1; |
| 305 |
|
} |
| 306 |
|
src += 2; |
| 307 |
|
continue; |
| 308 |
|
} |
| 309 |
|
if (*src != '#') { |
| 310 |
|
break; |
| 311 |
|
} |
| 312 |
|
if (parsePtr->commentStart == NULL) { |
| 313 |
|
parsePtr->commentStart = src; |
| 314 |
|
} |
| 315 |
|
while (1) { |
| 316 |
|
if (src == parsePtr->end) { |
| 317 |
|
if (nested) { |
| 318 |
|
parsePtr->incomplete = nested; |
| 319 |
|
} |
| 320 |
|
parsePtr->commentSize = src - parsePtr->commentStart; |
| 321 |
|
break; |
| 322 |
|
} else if (*src == '\\') { |
| 323 |
|
if ((src[1] == '\n') && ((src + 2) == parsePtr->end)) { |
| 324 |
|
parsePtr->incomplete = 1; |
| 325 |
|
} |
| 326 |
|
Tcl_UtfBackslash(src, &length, utfBytes); |
| 327 |
|
src += length; |
| 328 |
|
} else if (*src == '\n') { |
| 329 |
|
src++; |
| 330 |
|
parsePtr->commentSize = src - parsePtr->commentStart; |
| 331 |
|
break; |
| 332 |
|
} else { |
| 333 |
|
src++; |
| 334 |
|
} |
| 335 |
|
} |
| 336 |
|
} |
| 337 |
|
|
| 338 |
|
/* |
| 339 |
|
* The following loop parses the words of the command, one word |
| 340 |
|
* in each iteration through the loop. |
| 341 |
|
*/ |
| 342 |
|
|
| 343 |
|
parsePtr->commandStart = src; |
| 344 |
|
while (1) { |
| 345 |
|
/* |
| 346 |
|
* Create the token for the word. |
| 347 |
|
*/ |
| 348 |
|
|
| 349 |
|
if (parsePtr->numTokens == parsePtr->tokensAvailable) { |
| 350 |
|
TclExpandTokenArray(parsePtr); |
| 351 |
|
} |
| 352 |
|
wordIndex = parsePtr->numTokens; |
| 353 |
|
tokenPtr = &parsePtr->tokenPtr[wordIndex]; |
| 354 |
|
tokenPtr->type = TCL_TOKEN_WORD; |
| 355 |
|
|
| 356 |
|
/* |
| 357 |
|
* Skip white space before the word. Also skip a backslash-newline |
| 358 |
|
* sequence: it should be treated just like white space. |
| 359 |
|
*/ |
| 360 |
|
|
| 361 |
|
while (1) { |
| 362 |
|
type = CHAR_TYPE(*src); |
| 363 |
|
if (type == TYPE_SPACE) { |
| 364 |
|
src++; |
| 365 |
|
continue; |
| 366 |
|
} else if ((*src == '\\') && (src[1] == '\n')) { |
| 367 |
|
if ((src + 2) == parsePtr->end) { |
| 368 |
|
parsePtr->incomplete = 1; |
| 369 |
|
} |
| 370 |
|
Tcl_UtfBackslash(src, &length, utfBytes); |
| 371 |
|
src += length; |
| 372 |
|
continue; |
| 373 |
|
} |
| 374 |
|
break; |
| 375 |
|
} |
| 376 |
|
if ((type & terminators) != 0) { |
| 377 |
|
parsePtr->term = src; |
| 378 |
|
src++; |
| 379 |
|
break; |
| 380 |
|
} |
| 381 |
|
if (src == parsePtr->end) { |
| 382 |
|
break; |
| 383 |
|
} |
| 384 |
|
tokenPtr->start = src; |
| 385 |
|
parsePtr->numTokens++; |
| 386 |
|
parsePtr->numWords++; |
| 387 |
|
|
| 388 |
|
/* |
| 389 |
|
* At this point the word can have one of three forms: something |
| 390 |
|
* enclosed in quotes, something enclosed in braces, or an |
| 391 |
|
* unquoted word (anything else). |
| 392 |
|
*/ |
| 393 |
|
|
| 394 |
|
if (*src == '"') { |
| 395 |
|
if (Tcl_ParseQuotedString(interp, src, (parsePtr->end - src), |
| 396 |
|
parsePtr, 1, &termPtr) != TCL_OK) { |
| 397 |
|
goto error; |
| 398 |
|
} |
| 399 |
|
src = termPtr; |
| 400 |
|
} else if (*src == '{') { |
| 401 |
|
if (Tcl_ParseBraces(interp, src, (parsePtr->end - src), |
| 402 |
|
parsePtr, 1, &termPtr) != TCL_OK) { |
| 403 |
|
goto error; |
| 404 |
|
} |
| 405 |
|
src = termPtr; |
| 406 |
|
} else { |
| 407 |
|
/* |
| 408 |
|
* This is an unquoted word. Call ParseTokens and let it do |
| 409 |
|
* all of the work. |
| 410 |
|
*/ |
| 411 |
|
|
| 412 |
|
if (ParseTokens(src, TYPE_SPACE|terminators, |
| 413 |
|
parsePtr) != TCL_OK) { |
| 414 |
|
goto error; |
| 415 |
|
} |
| 416 |
|
src = parsePtr->term; |
| 417 |
|
} |
| 418 |
|
|
| 419 |
|
/* |
| 420 |
|
* Finish filling in the token for the word and check for the |
| 421 |
|
* special case of a word consisting of a single range of |
| 422 |
|
* literal text. |
| 423 |
|
*/ |
| 424 |
|
|
| 425 |
|
tokenPtr = &parsePtr->tokenPtr[wordIndex]; |
| 426 |
|
tokenPtr->size = src - tokenPtr->start; |
| 427 |
|
tokenPtr->numComponents = parsePtr->numTokens - (wordIndex + 1); |
| 428 |
|
if ((tokenPtr->numComponents == 1) |
| 429 |
|
&& (tokenPtr[1].type == TCL_TOKEN_TEXT)) { |
| 430 |
|
tokenPtr->type = TCL_TOKEN_SIMPLE_WORD; |
| 431 |
|
} |
| 432 |
|
|
| 433 |
|
/* |
| 434 |
|
* Do two additional checks: (a) make sure we're really at the |
| 435 |
|
* end of a word (there might have been garbage left after a |
| 436 |
|
* quoted or braced word), and (b) check for the end of the |
| 437 |
|
* command. |
| 438 |
|
*/ |
| 439 |
|
|
| 440 |
|
type = CHAR_TYPE(*src); |
| 441 |
|
if (type == TYPE_SPACE) { |
| 442 |
|
src++; |
| 443 |
|
continue; |
| 444 |
|
} else { |
| 445 |
|
/* |
| 446 |
|
* Backslash-newline (and any following white space) must be |
| 447 |
|
* treated as if it were a space character. |
| 448 |
|
*/ |
| 449 |
|
|
| 450 |
|
if ((*src == '\\') && (src[1] == '\n')) { |
| 451 |
|
if ((src + 2) == parsePtr->end) { |
| 452 |
|
parsePtr->incomplete = 1; |
| 453 |
|
} |
| 454 |
|
Tcl_UtfBackslash(src, &length, utfBytes); |
| 455 |
|
src += length; |
| 456 |
|
continue; |
| 457 |
|
} |
| 458 |
|
} |
| 459 |
|
|
| 460 |
|
if ((type & terminators) != 0) { |
| 461 |
|
parsePtr->term = src; |
| 462 |
|
src++; |
| 463 |
|
break; |
| 464 |
|
} |
| 465 |
|
if (src == parsePtr->end) { |
| 466 |
|
break; |
| 467 |
|
} |
| 468 |
|
if (src[-1] == '"') { |
| 469 |
|
if (interp != NULL) { |
| 470 |
|
Tcl_SetResult(interp, "extra characters after close-quote", |
| 471 |
|
TCL_STATIC); |
| 472 |
|
} |
| 473 |
|
parsePtr->errorType = TCL_PARSE_QUOTE_EXTRA; |
| 474 |
|
} else { |
| 475 |
|
if (interp != NULL) { |
| 476 |
|
Tcl_SetResult(interp, "extra characters after close-brace", |
| 477 |
|
TCL_STATIC); |
| 478 |
|
} |
| 479 |
|
parsePtr->errorType = TCL_PARSE_BRACE_EXTRA; |
| 480 |
|
} |
| 481 |
|
parsePtr->term = src; |
| 482 |
|
goto error; |
| 483 |
|
} |
| 484 |
|
|
| 485 |
|
|
| 486 |
|
parsePtr->commandSize = src - parsePtr->commandStart; |
| 487 |
|
if (savedChar != 0) { |
| 488 |
|
string[numBytes] = (char) savedChar; |
| 489 |
|
} |
| 490 |
|
return TCL_OK; |
| 491 |
|
|
| 492 |
|
error: |
| 493 |
|
if (savedChar != 0) { |
| 494 |
|
string[numBytes] = (char) savedChar; |
| 495 |
|
} |
| 496 |
|
Tcl_FreeParse(parsePtr); |
| 497 |
|
if (parsePtr->commandStart == NULL) { |
| 498 |
|
parsePtr->commandStart = string; |
| 499 |
|
} |
| 500 |
|
parsePtr->commandSize = parsePtr->term - parsePtr->commandStart; |
| 501 |
|
return TCL_ERROR; |
| 502 |
|
} |
| 503 |
|
|
| 504 |
|
/* |
| 505 |
|
*---------------------------------------------------------------------- |
| 506 |
|
* |
| 507 |
|
* ParseTokens -- |
| 508 |
|
* |
| 509 |
|
* This procedure forms the heart of the Tcl parser. It parses one |
| 510 |
|
* or more tokens from a string, up to a termination point |
| 511 |
|
* specified by the caller. This procedure is used to parse |
| 512 |
|
* unquoted command words (those not in quotes or braces), words in |
| 513 |
|
* quotes, and array indices for variables. |
| 514 |
|
* |
| 515 |
|
* Results: |
| 516 |
|
* Tokens are added to parsePtr and parsePtr->term is filled in |
| 517 |
|
* with the address of the character that terminated the parse (the |
| 518 |
|
* first one whose CHAR_TYPE matched mask or the character at |
| 519 |
|
* parsePtr->end). The return value is TCL_OK if the parse |
| 520 |
|
* completed successfully and TCL_ERROR otherwise. If a parse |
| 521 |
|
* error occurs and parsePtr->interp isn't NULL, then an error |
| 522 |
|
* message is left in the interpreter's result. |
| 523 |
|
* |
| 524 |
|
* Side effects: |
| 525 |
|
* None. |
| 526 |
|
* |
| 527 |
|
*---------------------------------------------------------------------- |
| 528 |
|
*/ |
| 529 |
|
|
| 530 |
|
static int |
| 531 |
|
ParseTokens(src, mask, parsePtr) |
| 532 |
|
register char *src; /* First character to parse. */ |
| 533 |
|
int mask; /* Specifies when to stop parsing. The |
| 534 |
|
* parse stops at the first unquoted |
| 535 |
|
* character whose CHAR_TYPE contains |
| 536 |
|
* any of the bits in mask. */ |
| 537 |
|
Tcl_Parse *parsePtr; /* Information about parse in progress. |
| 538 |
|
* Updated with additional tokens and |
| 539 |
|
* termination information. */ |
| 540 |
|
{ |
| 541 |
|
int type, originalTokens, varToken; |
| 542 |
|
char utfBytes[TCL_UTF_MAX]; |
| 543 |
|
Tcl_Token *tokenPtr; |
| 544 |
|
Tcl_Parse nested; |
| 545 |
|
|
| 546 |
|
/* |
| 547 |
|
* Each iteration through the following loop adds one token of |
| 548 |
|
* type TCL_TOKEN_TEXT, TCL_TOKEN_BS, TCL_TOKEN_COMMAND, or |
| 549 |
|
* TCL_TOKEN_VARIABLE to parsePtr. For TCL_TOKEN_VARIABLE tokens, |
| 550 |
|
* additional tokens are added for the parsed variable name. |
| 551 |
|
*/ |
| 552 |
|
|
| 553 |
|
originalTokens = parsePtr->numTokens; |
| 554 |
|
while (1) { |
| 555 |
|
if (parsePtr->numTokens == parsePtr->tokensAvailable) { |
| 556 |
|
TclExpandTokenArray(parsePtr); |
| 557 |
|
} |
| 558 |
|
tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens]; |
| 559 |
|
tokenPtr->start = src; |
| 560 |
|
tokenPtr->numComponents = 0; |
| 561 |
|
|
| 562 |
|
type = CHAR_TYPE(*src); |
| 563 |
|
if (type & mask) { |
| 564 |
|
break; |
| 565 |
|
} |
| 566 |
|
|
| 567 |
|
if ((type & TYPE_SUBS) == 0) { |
| 568 |
|
/* |
| 569 |
|
* This is a simple range of characters. Scan to find the end |
| 570 |
|
* of the range. |
| 571 |
|
*/ |
| 572 |
|
|
| 573 |
|
while (1) { |
| 574 |
|
src++; |
| 575 |
|
if (CHAR_TYPE(*src) & (mask | TYPE_SUBS)) { |
| 576 |
|
break; |
| 577 |
|
} |
| 578 |
|
} |
| 579 |
|
tokenPtr->type = TCL_TOKEN_TEXT; |
| 580 |
|
tokenPtr->size = src - tokenPtr->start; |
| 581 |
|
parsePtr->numTokens++; |
| 582 |
|
} else if (*src == '$') { |
| 583 |
|
/* |
| 584 |
|
* This is a variable reference. Call Tcl_ParseVarName to do |
| 585 |
|
* all the dirty work of parsing the name. |
| 586 |
|
*/ |
| 587 |
|
|
| 588 |
|
varToken = parsePtr->numTokens; |
| 589 |
|
if (Tcl_ParseVarName(parsePtr->interp, src, parsePtr->end - src, |
| 590 |
|
parsePtr, 1) != TCL_OK) { |
| 591 |
|
return TCL_ERROR; |
| 592 |
|
} |
| 593 |
|
src += parsePtr->tokenPtr[varToken].size; |
| 594 |
|
} else if (*src == '[') { |
| 595 |
|
/* |
| 596 |
|
* Command substitution. Call Tcl_ParseCommand recursively |
| 597 |
|
* (and repeatedly) to parse the nested command(s), then |
| 598 |
|
* throw away the parse information. |
| 599 |
|
*/ |
| 600 |
|
|
| 601 |
|
src++; |
| 602 |
|
while (1) { |
| 603 |
|
if (Tcl_ParseCommand(parsePtr->interp, src, |
| 604 |
|
parsePtr->end - src, 1, &nested) != TCL_OK) { |
| 605 |
|
parsePtr->errorType = nested.errorType; |
| 606 |
|
parsePtr->term = nested.term; |
| 607 |
|
parsePtr->incomplete = nested.incomplete; |
| 608 |
|
return TCL_ERROR; |
| 609 |
|
} |
| 610 |
|
src = nested.commandStart + nested.commandSize; |
| 611 |
|
if (nested.tokenPtr != nested.staticTokens) { |
| 612 |
|
ckfree((char *) nested.tokenPtr); |
| 613 |
|
} |
| 614 |
|
if ((*nested.term == ']') && !nested.incomplete) { |
| 615 |
|
break; |
| 616 |
|
} |
| 617 |
|
if (src == parsePtr->end) { |
| 618 |
|
if (parsePtr->interp != NULL) { |
| 619 |
|
Tcl_SetResult(parsePtr->interp, |
| 620 |
|
"missing close-bracket", TCL_STATIC); |
| 621 |
|
} |
| 622 |
|
parsePtr->errorType = TCL_PARSE_MISSING_BRACKET; |
| 623 |
|
parsePtr->term = tokenPtr->start; |
| 624 |
|
parsePtr->incomplete = 1; |
| 625 |
|
return TCL_ERROR; |
| 626 |
|
} |
| 627 |
|
} |
| 628 |
|
tokenPtr->type = TCL_TOKEN_COMMAND; |
| 629 |
|
tokenPtr->size = src - tokenPtr->start; |
| 630 |
|
parsePtr->numTokens++; |
| 631 |
|
} else if (*src == '\\') { |
| 632 |
|
/* |
| 633 |
|
* Backslash substitution. |
| 634 |
|
*/ |
| 635 |
|
|
| 636 |
|
if (src[1] == '\n') { |
| 637 |
|
if ((src + 2) == parsePtr->end) { |
| 638 |
|
parsePtr->incomplete = 1; |
| 639 |
|
} |
| 640 |
|
|
| 641 |
|
/* |
| 642 |
|
* Note: backslash-newline is special in that it is |
| 643 |
|
* treated the same as a space character would be. This |
| 644 |
|
* means that it could terminate the token. |
| 645 |
|
*/ |
| 646 |
|
|
| 647 |
|
if (mask & TYPE_SPACE) { |
| 648 |
|
break; |
| 649 |
|
} |
| 650 |
|
} |
| 651 |
|
tokenPtr->type = TCL_TOKEN_BS; |
| 652 |
|
Tcl_UtfBackslash(src, &tokenPtr->size, utfBytes); |
| 653 |
|
parsePtr->numTokens++; |
| 654 |
|
src += tokenPtr->size; |
| 655 |
|
} else if (*src == 0) { |
| 656 |
|
/* |
| 657 |
|
* We encountered a null character. If it is the null |
| 658 |
|
* character at the end of the string, then return. |
| 659 |
|
* Otherwise generate a text token for the single |
| 660 |
|
* character. |
| 661 |
|
*/ |
| 662 |
|
|
| 663 |
|
if (src == parsePtr->end) { |
| 664 |
|
break; |
| 665 |
|
} |
| 666 |
|
tokenPtr->type = TCL_TOKEN_TEXT; |
| 667 |
|
tokenPtr->size = 1; |
| 668 |
|
parsePtr->numTokens++; |
| 669 |
|
src++; |
| 670 |
|
} else { |
| 671 |
|
panic("ParseTokens encountered unknown character"); |
| 672 |
|
} |
| 673 |
|
} |
| 674 |
|
if (parsePtr->numTokens == originalTokens) { |
| 675 |
|
/* |
| 676 |
|
* There was nothing in this range of text. Add an empty token |
| 677 |
|
* for the empty range, so that there is always at least one |
| 678 |
|
* token added. |
| 679 |
|
*/ |
| 680 |
|
|
| 681 |
|
tokenPtr->type = TCL_TOKEN_TEXT; |
| 682 |
|
tokenPtr->size = 0; |
| 683 |
|
parsePtr->numTokens++; |
| 684 |
|
} |
| 685 |
|
parsePtr->term = src; |
| 686 |
|
return TCL_OK; |
| 687 |
|
} |
| 688 |
|
|
| 689 |
|
/* |
| 690 |
|
*---------------------------------------------------------------------- |
| 691 |
|
* |
| 692 |
|
* Tcl_FreeParse -- |
| 693 |
|
* |
| 694 |
|
* This procedure is invoked to free any dynamic storage that may |
| 695 |
|
* have been allocated by a previous call to Tcl_ParseCommand. |
| 696 |
|
* |
| 697 |
|
* Results: |
| 698 |
|
* None. |
| 699 |
|
* |
| 700 |
|
* Side effects: |
| 701 |
|
* If there is any dynamically allocated memory in *parsePtr, |
| 702 |
|
* it is freed. |
| 703 |
|
* |
| 704 |
|
*---------------------------------------------------------------------- |
| 705 |
|
*/ |
| 706 |
|
|
| 707 |
|
void |
| 708 |
|
Tcl_FreeParse(parsePtr) |
| 709 |
|
Tcl_Parse *parsePtr; /* Structure that was filled in by a |
| 710 |
|
* previous call to Tcl_ParseCommand. */ |
| 711 |
|
{ |
| 712 |
|
if (parsePtr->tokenPtr != parsePtr->staticTokens) { |
| 713 |
|
ckfree((char *) parsePtr->tokenPtr); |
| 714 |
|
parsePtr->tokenPtr = parsePtr->staticTokens; |
| 715 |
|
} |
| 716 |
|
} |
| 717 |
|
|
| 718 |
|
/* |
| 719 |
|
*---------------------------------------------------------------------- |
| 720 |
|
* |
| 721 |
|
* TclExpandTokenArray -- |
| 722 |
|
* |
| 723 |
|
* This procedure is invoked when the current space for tokens in |
| 724 |
|
* a Tcl_Parse structure fills up; it allocates memory to grow the |
| 725 |
|
* token array |
| 726 |
|
* |
| 727 |
|
* Results: |
| 728 |
|
* None. |
| 729 |
|
* |
| 730 |
|
* Side effects: |
| 731 |
|
* Memory is allocated for a new larger token array; the memory |
| 732 |
|
* for the old array is freed, if it had been dynamically allocated. |
| 733 |
|
* |
| 734 |
|
*---------------------------------------------------------------------- |
| 735 |
|
*/ |
| 736 |
|
|
| 737 |
|
void |
| 738 |
|
TclExpandTokenArray(parsePtr) |
| 739 |
|
Tcl_Parse *parsePtr; /* Parse structure whose token space |
| 740 |
|
* has overflowed. */ |
| 741 |
|
{ |
| 742 |
|
int newCount; |
| 743 |
|
Tcl_Token *newPtr; |
| 744 |
|
|
| 745 |
|
newCount = parsePtr->tokensAvailable*2; |
| 746 |
|
newPtr = (Tcl_Token *) ckalloc((unsigned) (newCount * sizeof(Tcl_Token))); |
| 747 |
|
memcpy((VOID *) newPtr, (VOID *) parsePtr->tokenPtr, |
| 748 |
|
(size_t) (parsePtr->tokensAvailable * sizeof(Tcl_Token))); |
| 749 |
|
if (parsePtr->tokenPtr != parsePtr->staticTokens) { |
| 750 |
|
ckfree((char *) parsePtr->tokenPtr); |
| 751 |
|
} |
| 752 |
|
parsePtr->tokenPtr = newPtr; |
| 753 |
|
parsePtr->tokensAvailable = newCount; |
| 754 |
|
} |
| 755 |
|
|
| 756 |
|
/* |
| 757 |
|
*---------------------------------------------------------------------- |
| 758 |
|
* |
| 759 |
|
* EvalObjv -- |
| 760 |
|
* |
| 761 |
|
* This procedure evaluates a Tcl command that has already been |
| 762 |
|
* parsed into words, with one Tcl_Obj holding each word. |
| 763 |
|
* |
| 764 |
|
* Results: |
| 765 |
|
* The return value is a standard Tcl completion code such as |
| 766 |
|
* TCL_OK or TCL_ERROR. A result or error message is left in |
| 767 |
|
* interp's result. If an error occurs, this procedure does |
| 768 |
|
* NOT add any information to the errorInfo variable. |
| 769 |
|
* |
| 770 |
|
* Side effects: |
| 771 |
|
* Depends on the command. |
| 772 |
|
* |
| 773 |
|
*---------------------------------------------------------------------- |
| 774 |
|
*/ |
| 775 |
|
|
| 776 |
|
static int |
| 777 |
|
EvalObjv(interp, objc, objv, command, length, flags) |
| 778 |
|
Tcl_Interp *interp; /* Interpreter in which to evaluate the |
| 779 |
|
* command. Also used for error |
| 780 |
|
* reporting. */ |
| 781 |
|
int objc; /* Number of words in command. */ |
| 782 |
|
Tcl_Obj *CONST objv[]; /* An array of pointers to objects that are |
| 783 |
|
* the words that make up the command. */ |
| 784 |
|
char *command; /* Points to the beginning of the string |
| 785 |
|
* representation of the command; this |
| 786 |
|
* is used for traces. If the string |
| 787 |
|
* representation of the command is |
| 788 |
|
* unknown, an empty string should be |
| 789 |
|
* supplied. */ |
| 790 |
|
int length; /* Number of bytes in command; if -1, all |
| 791 |
|
* characters up to the first null byte are |
| 792 |
|
* used. */ |
| 793 |
|
int flags; /* Collection of OR-ed bits that control |
| 794 |
|
* the evaluation of the script. Only |
| 795 |
|
* TCL_EVAL_GLOBAL is currently |
| 796 |
|
* supported. */ |
| 797 |
|
|
| 798 |
|
{ |
| 799 |
|
Command *cmdPtr; |
| 800 |
|
Interp *iPtr = (Interp *) interp; |
| 801 |
|
Tcl_Obj **newObjv; |
| 802 |
|
int i, code; |
| 803 |
|
Trace *tracePtr, *nextPtr; |
| 804 |
|
char **argv, *commandCopy; |
| 805 |
|
CallFrame *savedVarFramePtr; /* Saves old copy of iPtr->varFramePtr |
| 806 |
|
* in case TCL_EVAL_GLOBAL was set. */ |
| 807 |
|
|
| 808 |
|
Tcl_ResetResult(interp); |
| 809 |
|
if (objc == 0) { |
| 810 |
|
return TCL_OK; |
| 811 |
|
} |
| 812 |
|
|
| 813 |
|
/* |
| 814 |
|
* If the interpreter was deleted, return an error. |
| 815 |
|
*/ |
| 816 |
|
|
| 817 |
|
if (iPtr->flags & DELETED) { |
| 818 |
|
Tcl_AppendToObj(Tcl_GetObjResult(interp), |
| 819 |
|
"attempt to call eval in deleted interpreter", -1); |
| 820 |
|
Tcl_SetErrorCode(interp, "CORE", "IDELETE", |
| 821 |
|
"attempt to call eval in deleted interpreter", |
| 822 |
|
(char *) NULL); |
| 823 |
|
return TCL_ERROR; |
| 824 |
|
} |
| 825 |
|
|
| 826 |
|
/* |
| 827 |
|
* Check depth of nested calls to Tcl_Eval: if this gets too large, |
| 828 |
|
* it's probably because of an infinite loop somewhere. |
| 829 |
|
*/ |
| 830 |
|
|
| 831 |
|
if (iPtr->numLevels >= iPtr->maxNestingDepth) { |
| 832 |
|
iPtr->result = "too many nested calls to Tcl_Eval (infinite loop?)"; |
| 833 |
|
return TCL_ERROR; |
| 834 |
|
} |
| 835 |
|
iPtr->numLevels++; |
| 836 |
|
|
| 837 |
|
/* |
| 838 |
|
* On the Mac, we will never reach the default recursion limit before |
| 839 |
|
* blowing the stack. So we need to do a check here. |
| 840 |
|
*/ |
| 841 |
|
|
| 842 |
|
if (TclpCheckStackSpace() == 0) { |
| 843 |
|
/*NOTREACHED*/ |
| 844 |
|
iPtr->numLevels--; |
| 845 |
|
iPtr->result = "too many nested calls to Tcl_Eval (infinite loop?)"; |
| 846 |
|
return TCL_ERROR; |
| 847 |
|
} |
| 848 |
|
|
| 849 |
|
/* |
| 850 |
|
* Find the procedure to execute this command. If there isn't one, |
| 851 |
|
* then see if there is a command "unknown". If so, create a new |
| 852 |
|
* word array with "unknown" as the first word and the original |
| 853 |
|
* command words as arguments. Then call ourselves recursively |
| 854 |
|
* to execute it. |
| 855 |
|
*/ |
| 856 |
|
|
| 857 |
|
cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[0]); |
| 858 |
|
if (cmdPtr == NULL) { |
| 859 |
|
newObjv = (Tcl_Obj **) ckalloc((unsigned) |
| 860 |
|
((objc + 1) * sizeof (Tcl_Obj *))); |
| 861 |
|
for (i = objc-1; i >= 0; i--) { |
| 862 |
|
newObjv[i+1] = objv[i]; |
| 863 |
|
} |
| 864 |
|
newObjv[0] = Tcl_NewStringObj("unknown", -1); |
| 865 |
|
Tcl_IncrRefCount(newObjv[0]); |
| 866 |
|
cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, newObjv[0]); |
| 867 |
|
if (cmdPtr == NULL) { |
| 868 |
|
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), |
| 869 |
|
"invalid command name \"", Tcl_GetString(objv[0]), "\"", |
| 870 |
|
(char *) NULL); |
| 871 |
|
code = TCL_ERROR; |
| 872 |
|
} else { |
| 873 |
|
code = EvalObjv(interp, objc+1, newObjv, command, length, 0); |
| 874 |
|
} |
| 875 |
|
Tcl_DecrRefCount(newObjv[0]); |
| 876 |
|
ckfree((char *) newObjv); |
| 877 |
|
goto done; |
| 878 |
|
} |
| 879 |
|
|
| 880 |
|
/* |
| 881 |
|
* Call trace procedures if needed. |
| 882 |
|
*/ |
| 883 |
|
|
| 884 |
|
argv = NULL; |
| 885 |
|
commandCopy = command; |
| 886 |
|
|
| 887 |
|
for (tracePtr = iPtr->tracePtr; tracePtr != NULL; tracePtr = nextPtr) { |
| 888 |
|
nextPtr = tracePtr->nextPtr; |
| 889 |
|
if (iPtr->numLevels > tracePtr->level) { |
| 890 |
|
continue; |
| 891 |
|
} |
| 892 |
|
|
| 893 |
|
/* |
| 894 |
|
* This is a bit messy because we have to emulate the old trace |
| 895 |
|
* interface, which uses strings for everything. |
| 896 |
|
*/ |
| 897 |
|
|
| 898 |
|
if (argv == NULL) { |
| 899 |
|
argv = (char **) ckalloc((unsigned) (objc + 1) * sizeof(char *)); |
| 900 |
|
for (i = 0; i < objc; i++) { |
| 901 |
|
argv[i] = Tcl_GetString(objv[i]); |
| 902 |
|
} |
| 903 |
|
argv[objc] = 0; |
| 904 |
|
|
| 905 |
|
if (length < 0) { |
| 906 |
|
length = strlen(command); |
| 907 |
|
} else if ((size_t)length < strlen(command)) { |
| 908 |
|
commandCopy = (char *) ckalloc((unsigned) (length + 1)); |
| 909 |
|
strncpy(commandCopy, command, (size_t) length); |
| 910 |
|
commandCopy[length] = 0; |
| 911 |
|
} |
| 912 |
|
} |
| 913 |
|
(*tracePtr->proc)(tracePtr->clientData, interp, iPtr->numLevels, |
| 914 |
|
commandCopy, cmdPtr->proc, cmdPtr->clientData, |
| 915 |
|
objc, argv); |
| 916 |
|
} |
| 917 |
|
if (argv != NULL) { |
| 918 |
|
ckfree((char *) argv); |
| 919 |
|
} |
| 920 |
|
if (commandCopy != command) { |
| 921 |
|
ckfree((char *) commandCopy); |
| 922 |
|
} |
| 923 |
|
|
| 924 |
|
/* |
| 925 |
|
* Finally, invoke the command's Tcl_ObjCmdProc. |
| 926 |
|
*/ |
| 927 |
|
|
| 928 |
|
iPtr->cmdCount++; |
| 929 |
|
savedVarFramePtr = iPtr->varFramePtr; |
| 930 |
|
if (flags & TCL_EVAL_GLOBAL) { |
| 931 |
|
iPtr->varFramePtr = NULL; |
| 932 |
|
} |
| 933 |
|
code = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, objc, objv); |
| 934 |
|
iPtr->varFramePtr = savedVarFramePtr; |
| 935 |
|
if (Tcl_AsyncReady()) { |
| 936 |
|
code = Tcl_AsyncInvoke(interp, code); |
| 937 |
|
} |
| 938 |
|
|
| 939 |
|
/* |
| 940 |
|
* If the interpreter has a non-empty string result, the result |
| 941 |
|
* object is either empty or stale because some procedure set |
| 942 |
|
* interp->result directly. If so, move the string result to the |
| 943 |
|
* result object, then reset the string result. |
| 944 |
|
*/ |
| 945 |
|
|
| 946 |
|
if (*(iPtr->result) != 0) { |
| 947 |
|
(void) Tcl_GetObjResult(interp); |
| 948 |
|
} |
| 949 |
|
|
| 950 |
|
done: |
| 951 |
|
iPtr->numLevels--; |
| 952 |
|
return code; |
| 953 |
|
} |
| 954 |
|
|
| 955 |
|
/* |
| 956 |
|
*---------------------------------------------------------------------- |
| 957 |
|
* |
| 958 |
|
* Tcl_EvalObjv -- |
| 959 |
|
* |
| 960 |
|
* This procedure evaluates a Tcl command that has already been |
| 961 |
|
* parsed into words, with one Tcl_Obj holding each word. |
| 962 |
|
* |
| 963 |
|
* Results: |
| 964 |
|
* The return value is a standard Tcl completion code such as |
| 965 |
|
* TCL_OK or TCL_ERROR. A result or error message is left in |
| 966 |
|
* interp's result. |
| 967 |
|
* |
| 968 |
|
* Side effects: |
| 969 |
|
* Depends on the command. |
| 970 |
|
* |
| 971 |
|
*---------------------------------------------------------------------- |
| 972 |
|
*/ |
| 973 |
|
|
| 974 |
|
int |
| 975 |
|
Tcl_EvalObjv(interp, objc, objv, flags) |
| 976 |
|
Tcl_Interp *interp; /* Interpreter in which to evaluate the |
| 977 |
|
* command. Also used for error |
| 978 |
|
* reporting. */ |
| 979 |
|
int objc; /* Number of words in command. */ |
| 980 |
|
Tcl_Obj *CONST objv[]; /* An array of pointers to objects that are |
| 981 |
|
* the words that make up the command. */ |
| 982 |
|
int flags; /* Collection of OR-ed bits that control |
| 983 |
|
* the evaluation of the script. Only |
| 984 |
|
* TCL_EVAL_GLOBAL is currently |
| 985 |
|
* supported. */ |
| 986 |
|
{ |
| 987 |
|
Interp *iPtr = (Interp *)interp; |
| 988 |
|
Trace *tracePtr; |
| 989 |
|
Tcl_DString cmdBuf; |
| 990 |
|
char *cmdString = ""; |
| 991 |
|
int cmdLen = 0; |
| 992 |
|
int code = TCL_OK; |
| 993 |
|
|
| 994 |
|
for (tracePtr = iPtr->tracePtr; tracePtr; tracePtr = tracePtr->nextPtr) { |
| 995 |
|
/* |
| 996 |
|
* EvalObjv will increment numLevels so use "<" rather than "<=" |
| 997 |
|
*/ |
| 998 |
|
if (iPtr->numLevels < tracePtr->level) { |
| 999 |
|
int i; |
| 1000 |
|
/* |
| 1001 |
|
* The command will be needed for an execution trace or stack trace |
| 1002 |
|
* generate a command string. |
| 1003 |
|
*/ |
| 1004 |
|
cmdtraced: |
| 1005 |
|
Tcl_DStringInit(&cmdBuf); |
| 1006 |
|
for (i = 0; i < objc; i++) { |
| 1007 |
|
Tcl_DStringAppendElement(&cmdBuf, Tcl_GetString(objv[i])); |
| 1008 |
|
} |
| 1009 |
|
cmdString = Tcl_DStringValue(&cmdBuf); |
| 1010 |
|
cmdLen = Tcl_DStringLength(&cmdBuf); |
| 1011 |
|
break; |
| 1012 |
|
} |
| 1013 |
|
} |
| 1014 |
|
|
| 1015 |
|
/* |
| 1016 |
|
* Execute the command if we have not done so already |
| 1017 |
|
*/ |
| 1018 |
|
switch (code) { |
| 1019 |
|
case TCL_OK: |
| 1020 |
|
code = EvalObjv(interp, objc, objv, cmdString, cmdLen, flags); |
| 1021 |
|
if (code == TCL_ERROR && cmdLen == 0) |
| 1022 |
|
goto cmdtraced; |
| 1023 |
|
break; |
| 1024 |
|
case TCL_ERROR: |
| 1025 |
|
Tcl_LogCommandInfo(interp, cmdString, cmdString, cmdLen); |
| 1026 |
|
break; |
| 1027 |
|
default: |
| 1028 |
|
/*NOTREACHED*/ |
| 1029 |
|
break; |
| 1030 |
|
} |
| 1031 |
|
|
| 1032 |
|
if (cmdLen != 0) { |
| 1033 |
|
Tcl_DStringFree(&cmdBuf); |
| 1034 |
|
} |
| 1035 |
|
return code; |
| 1036 |
|
} |
| 1037 |
|
|
| 1038 |
|
/* |
| 1039 |
|
*---------------------------------------------------------------------- |
| 1040 |
|
* |
| 1041 |
|
* Tcl_LogCommandInfo -- |
| 1042 |
|
* |
| 1043 |
|
* This procedure is invoked after an error occurs in an interpreter. |
| 1044 |
|
* It adds information to the "errorInfo" variable to describe the |
| 1045 |
|
* command that was being executed when the error occurred. |
| 1046 |
|
* |
| 1047 |
|
* Results: |
| 1048 |
|
* None. |
| 1049 |
|
* |
| 1050 |
|
* Side effects: |
| 1051 |
|
* Information about the command is added to errorInfo and the |
| 1052 |
|
* line number stored internally in the interpreter is set. If this |
| 1053 |
|
* is the first call to this procedure or Tcl_AddObjErrorInfo since |
| 1054 |
|
* an error occurred, then old information in errorInfo is |
| 1055 |
|
* deleted. |
| 1056 |
|
* |
| 1057 |
|
*---------------------------------------------------------------------- |
| 1058 |
|
*/ |
| 1059 |
|
|
| 1060 |
|
void |
| 1061 |
|
Tcl_LogCommandInfo(interp, script, command, length) |
| 1062 |
|
Tcl_Interp *interp; /* Interpreter in which to log information. */ |
| 1063 |
|
char *script; /* First character in script containing |
| 1064 |
|
* command (must be <= command). */ |
| 1065 |
|
char *command; /* First character in command that |
| 1066 |
|
* generated the error. */ |
| 1067 |
|
int length; /* Number of bytes in command (-1 means |
| 1068 |
|
* use all bytes up to first null byte). */ |
| 1069 |
|
{ |
| 1070 |
|
char buffer[200]; |
| 1071 |
|
register char *p; |
| 1072 |
|
char *ellipsis = ""; |
| 1073 |
|
Interp *iPtr = (Interp *) interp; |
| 1074 |
|
|
| 1075 |
|
if (iPtr->flags & ERR_ALREADY_LOGGED) { |
| 1076 |
|
/* |
| 1077 |
|
* Someone else has already logged error information for this |
| 1078 |
|
* command; we shouldn't add anything more. |
| 1079 |
|
*/ |
| 1080 |
|
|
| 1081 |
|
return; |
| 1082 |
|
} |
| 1083 |
|
|
| 1084 |
|
/* |
| 1085 |
|
* Compute the line number where the error occurred. |
| 1086 |
|
*/ |
| 1087 |
|
|
| 1088 |
|
iPtr->errorLine = 1; |
| 1089 |
|
for (p = script; p != command; p++) { |
| 1090 |
|
if (*p == '\n') { |
| 1091 |
|
iPtr->errorLine++; |
| 1092 |
|
} |
| 1093 |
|
} |
| 1094 |
|
|
| 1095 |
|
/* |
| 1096 |
|
* Create an error message to add to errorInfo, including up to a |
| 1097 |
|
* maximum number of characters of the command. |
| 1098 |
|
*/ |
| 1099 |
|
|
| 1100 |
|
if (length < 0) { |
| 1101 |
|
length = strlen(command); |
| 1102 |
|
} |
| 1103 |
|
if (length > 150) { |
| 1104 |
|
length = 150; |
| 1105 |
|
ellipsis = "..."; |
| 1106 |
|
} |
| 1107 |
|
if (!(iPtr->flags & ERR_IN_PROGRESS)) { |
| 1108 |
|
sprintf(buffer, "\n while executing\n\"%.*s%s\"", |
| 1109 |
|
length, command, ellipsis); |
| 1110 |
|
} else { |
| 1111 |
|
sprintf(buffer, "\n invoked from within\n\"%.*s%s\"", |
| 1112 |
|
length, command, ellipsis); |
| 1113 |
|
} |
| 1114 |
|
Tcl_AddObjErrorInfo(interp, buffer, -1); |
| 1115 |
|
iPtr->flags &= ~ERR_ALREADY_LOGGED; |
| 1116 |
|
} |
| 1117 |
|
|
| 1118 |
|
/* |
| 1119 |
|
*---------------------------------------------------------------------- |
| 1120 |
|
* |
| 1121 |
|
* Tcl_EvalTokens -- |
| 1122 |
|
* |
| 1123 |
|
* Given an array of tokens parsed from a Tcl command (e.g., the |
| 1124 |
|
* tokens that make up a word or the index for an array variable) |
| 1125 |
|
* this procedure evaluates the tokens and concatenates their |
| 1126 |
|
* values to form a single result value. |
| 1127 |
|
* |
| 1128 |
|
* Results: |
| 1129 |
|
* The return value is a pointer to a newly allocated Tcl_Obj |
| 1130 |
|
* containing the value of the array of tokens. The reference |
| 1131 |
|
* count of the returned object has been incremented. If an error |
| 1132 |
|
* occurs in evaluating the tokens then a NULL value is returned |
| 1133 |
|
* and an error message is left in interp's result. |
| 1134 |
|
* |
| 1135 |
|
* Side effects: |
| 1136 |
|
* A new object is allocated to hold the result. |
| 1137 |
|
* |
| 1138 |
|
*---------------------------------------------------------------------- |
| 1139 |
|
*/ |
| 1140 |
|
|
| 1141 |
|
Tcl_Obj * |
| 1142 |
|
Tcl_EvalTokens(interp, tokenPtr, count) |
| 1143 |
|
Tcl_Interp *interp; /* Interpreter in which to lookup |
| 1144 |
|
* variables, execute nested commands, |
| 1145 |
|
* and report errors. */ |
| 1146 |
|
Tcl_Token *tokenPtr; /* Pointer to first in an array of tokens |
| 1147 |
|
* to evaluate and concatenate. */ |
| 1148 |
|
int count; /* Number of tokens to consider at tokenPtr. |
| 1149 |
|
* Must be at least 1. */ |
| 1150 |
|
{ |
| 1151 |
|
Tcl_Obj *resultPtr, *indexPtr, *valuePtr, *newPtr; |
| 1152 |
|
char buffer[TCL_UTF_MAX]; |
| 1153 |
|
#ifdef TCL_MEM_DEBUG |
| 1154 |
|
# define MAX_VAR_CHARS 5 |
| 1155 |
|
#else |
| 1156 |
|
# define MAX_VAR_CHARS 30 |
| 1157 |
|
#endif |
| 1158 |
|
char nameBuffer[MAX_VAR_CHARS+1]; |
| 1159 |
|
char *varName, *index; |
| 1160 |
|
char *p = NULL; /* Initialized to avoid compiler warning. */ |
| 1161 |
|
int length, code; |
| 1162 |
|
|
| 1163 |
|
/* |
| 1164 |
|
* The only tricky thing about this procedure is that it attempts to |
| 1165 |
|
* avoid object creation and string copying whenever possible. For |
| 1166 |
|
* example, if the value is just a nested command, then use the |
| 1167 |
|
* command's result object directly. |
| 1168 |
|
*/ |
| 1169 |
|
|
| 1170 |
|
resultPtr = NULL; |
| 1171 |
|
for ( ; count > 0; count--, tokenPtr++) { |
| 1172 |
|
valuePtr = NULL; |
| 1173 |
|
|
| 1174 |
|
/* |
| 1175 |
|
* The switch statement below computes the next value to be |
| 1176 |
|
* concat to the result, as either a range of text or an |
| 1177 |
|
* object. |
| 1178 |
|
*/ |
| 1179 |
|
|
| 1180 |
|
switch (tokenPtr->type) { |
| 1181 |
|
case TCL_TOKEN_TEXT: |
| 1182 |
|
p = tokenPtr->start; |
| 1183 |
|
length = tokenPtr->size; |
| 1184 |
|
break; |
| 1185 |
|
|
| 1186 |
|
case TCL_TOKEN_BS: |
| 1187 |
|
length = Tcl_UtfBackslash(tokenPtr->start, (int *) NULL, |
| 1188 |
|
buffer); |
| 1189 |
|
p = buffer; |
| 1190 |
|
break; |
| 1191 |
|
|
| 1192 |
|
case TCL_TOKEN_COMMAND: |
| 1193 |
|
code = Tcl_EvalEx(interp, tokenPtr->start+1, tokenPtr->size-2, |
| 1194 |
|
0); |
| 1195 |
|
if (code != TCL_OK) { |
| 1196 |
|
goto error; |
| 1197 |
|
} |
| 1198 |
|
valuePtr = Tcl_GetObjResult(interp); |
| 1199 |
|
break; |
| 1200 |
|
|
| 1201 |
|
case TCL_TOKEN_VARIABLE: |
| 1202 |
|
if (tokenPtr->numComponents == 1) { |
| 1203 |
|
indexPtr = NULL; |
| 1204 |
|
} else { |
| 1205 |
|
indexPtr = Tcl_EvalTokens(interp, tokenPtr+2, |
| 1206 |
|
tokenPtr->numComponents - 1); |
| 1207 |
|
if (indexPtr == NULL) { |
| 1208 |
|
goto error; |
| 1209 |
|
} |
| 1210 |
|
} |
| 1211 |
|
|
| 1212 |
|
/* |
| 1213 |
|
* We have to make a copy of the variable name in order |
| 1214 |
|
* to have a null-terminated string. We can't make a |
| 1215 |
|
* temporary modification to the script to null-terminate |
| 1216 |
|
* the name, because a trace callback might potentially |
| 1217 |
|
* reuse the script and be affected by the null character. |
| 1218 |
|
*/ |
| 1219 |
|
|
| 1220 |
|
if (tokenPtr[1].size <= MAX_VAR_CHARS) { |
| 1221 |
|
varName = nameBuffer; |
| 1222 |
|
} else { |
| 1223 |
|
varName = ckalloc((unsigned) (tokenPtr[1].size + 1)); |
| 1224 |
|
} |
| 1225 |
|
strncpy(varName, tokenPtr[1].start, (size_t) tokenPtr[1].size); |
| 1226 |
|
varName[tokenPtr[1].size] = 0; |
| 1227 |
|
if (indexPtr != NULL) { |
| 1228 |
|
index = TclGetString(indexPtr); |
| 1229 |
|
} else { |
| 1230 |
|
index = NULL; |
| 1231 |
|
} |
| 1232 |
|
valuePtr = Tcl_GetVar2Ex(interp, varName, index, |
| 1233 |
|
TCL_LEAVE_ERR_MSG); |
| 1234 |
|
if (varName != nameBuffer) { |
| 1235 |
|
ckfree(varName); |
| 1236 |
|
} |
| 1237 |
|
if (indexPtr != NULL) { |
| 1238 |
|
Tcl_DecrRefCount(indexPtr); |
| 1239 |
|
} |
| 1240 |
|
if (valuePtr == NULL) { |
| 1241 |
|
goto error; |
| 1242 |
|
} |
| 1243 |
|
count -= tokenPtr->numComponents; |
| 1244 |
|
tokenPtr += tokenPtr->numComponents; |
| 1245 |
|
break; |
| 1246 |
|
|
| 1247 |
|
default: |
| 1248 |
|
panic("unexpected token type in Tcl_EvalTokens"); |
| 1249 |
|
} |
| 1250 |
|
|
| 1251 |
|
/* |
| 1252 |
|
* If valuePtr isn't NULL, the next piece of text comes from that |
| 1253 |
|
* object; otherwise, take length bytes starting at p. |
| 1254 |
|
*/ |
| 1255 |
|
|
| 1256 |
|
if (resultPtr == NULL) { |
| 1257 |
|
if (valuePtr != NULL) { |
| 1258 |
|
resultPtr = valuePtr; |
| 1259 |
|
} else { |
| 1260 |
|
resultPtr = Tcl_NewStringObj(p, length); |
| 1261 |
|
} |
| 1262 |
|
Tcl_IncrRefCount(resultPtr); |
| 1263 |
|
} else { |
| 1264 |
|
if (Tcl_IsShared(resultPtr)) { |
| 1265 |
|
newPtr = Tcl_DuplicateObj(resultPtr); |
| 1266 |
|
Tcl_DecrRefCount(resultPtr); |
| 1267 |
|
resultPtr = newPtr; |
| 1268 |
|
Tcl_IncrRefCount(resultPtr); |
| 1269 |
|
} |
| 1270 |
|
if (valuePtr != NULL) { |
| 1271 |
|
p = Tcl_GetStringFromObj(valuePtr, &length); |
| 1272 |
|
} |
| 1273 |
|
Tcl_AppendToObj(resultPtr, p, length); |
| 1274 |
|
} |
| 1275 |
|
} |
| 1276 |
|
return resultPtr; |
| 1277 |
|
|
| 1278 |
|
error: |
| 1279 |
|
if (resultPtr != NULL) { |
| 1280 |
|
Tcl_DecrRefCount(resultPtr); |
| 1281 |
|
} |
| 1282 |
|
return NULL; |
| 1283 |
|
} |
| 1284 |
|
|
| 1285 |
|
/* |
| 1286 |
|
*---------------------------------------------------------------------- |
| 1287 |
|
* |
| 1288 |
|
* Tcl_EvalEx -- |
| 1289 |
|
* |
| 1290 |
|
* This procedure evaluates a Tcl script without using the compiler |
| 1291 |
|
* or byte-code interpreter. It just parses the script, creates |
| 1292 |
|
* values for each word of each command, then calls EvalObjv |
| 1293 |
|
* to execute each command. |
| 1294 |
|
* |
| 1295 |
|
* Results: |
| 1296 |
|
* The return value is a standard Tcl completion code such as |
| 1297 |
|
* TCL_OK or TCL_ERROR. A result or error message is left in |
| 1298 |
|
* interp's result. |
| 1299 |
|
* |
| 1300 |
|
* Side effects: |
| 1301 |
|
* Depends on the script. |
| 1302 |
|
* |
| 1303 |
|
*---------------------------------------------------------------------- |
| 1304 |
|
*/ |
| 1305 |
|
|
| 1306 |
|
int |
| 1307 |
|
Tcl_EvalEx(interp, script, numBytes, flags) |
| 1308 |
|
Tcl_Interp *interp; /* Interpreter in which to evaluate the |
| 1309 |
|
* script. Also used for error reporting. */ |
| 1310 |
|
char *script; /* First character of script to evaluate. */ |
| 1311 |
|
int numBytes; /* Number of bytes in script. If < 0, the |
| 1312 |
|
* script consists of all bytes up to the |
| 1313 |
|
* first null character. */ |
| 1314 |
|
int flags; /* Collection of OR-ed bits that control |
| 1315 |
|
* the evaluation of the script. Only |
| 1316 |
|
* TCL_EVAL_GLOBAL is currently |
| 1317 |
|
* supported. */ |
| 1318 |
|
{ |
| 1319 |
|
Interp *iPtr = (Interp *) interp; |
| 1320 |
|
char *p, *next; |
| 1321 |
|
Tcl_Parse parse; |
| 1322 |
|
#define NUM_STATIC_OBJS 20 |
| 1323 |
|
Tcl_Obj *staticObjArray[NUM_STATIC_OBJS], **objv; |
| 1324 |
|
Tcl_Token *tokenPtr; |
| 1325 |
|
int i, code, commandLength, bytesLeft, nested; |
| 1326 |
|
CallFrame *savedVarFramePtr; /* Saves old copy of iPtr->varFramePtr |
| 1327 |
|
* in case TCL_EVAL_GLOBAL was set. */ |
| 1328 |
|
|
| 1329 |
|
/* |
| 1330 |
|
* The variables below keep track of how much state has been |
| 1331 |
|
* allocated while evaluating the script, so that it can be freed |
| 1332 |
|
* properly if an error occurs. |
| 1333 |
|
*/ |
| 1334 |
|
|
| 1335 |
|
int gotParse = 0, objectsUsed = 0; |
| 1336 |
|
|
| 1337 |
|
if (numBytes < 0) { |
| 1338 |
|
numBytes = strlen(script); |
| 1339 |
|
} |
| 1340 |
|
Tcl_ResetResult(interp); |
| 1341 |
|
|
| 1342 |
|
savedVarFramePtr = iPtr->varFramePtr; |
| 1343 |
|
if (flags & TCL_EVAL_GLOBAL) { |
| 1344 |
|
iPtr->varFramePtr = NULL; |
| 1345 |
|
} |
| 1346 |
|
|
| 1347 |
|
/* |
| 1348 |
|
* Each iteration through the following loop parses the next |
| 1349 |
|
* command from the script and then executes it. |
| 1350 |
|
*/ |
| 1351 |
|
|
| 1352 |
|
objv = staticObjArray; |
| 1353 |
|
p = script; |
| 1354 |
|
bytesLeft = numBytes; |
| 1355 |
|
if (iPtr->evalFlags & TCL_BRACKET_TERM) { |
| 1356 |
|
nested = 1; |
| 1357 |
|
} else { |
| 1358 |
|
nested = 0; |
| 1359 |
|
} |
| 1360 |
|
iPtr->evalFlags = 0; |
| 1361 |
|
do { |
| 1362 |
|
if (Tcl_ParseCommand(interp, p, bytesLeft, nested, &parse) |
| 1363 |
|
!= TCL_OK) { |
| 1364 |
|
code = TCL_ERROR; |
| 1365 |
|
goto error; |
| 1366 |
|
} |
| 1367 |
|
gotParse = 1; |
| 1368 |
|
if (parse.numWords > 0) { |
| 1369 |
|
/* |
| 1370 |
|
* Generate an array of objects for the words of the command. |
| 1371 |
|
*/ |
| 1372 |
|
|
| 1373 |
|
if (parse.numWords <= NUM_STATIC_OBJS) { |
| 1374 |
|
objv = staticObjArray; |
| 1375 |
|
} else { |
| 1376 |
|
objv = (Tcl_Obj **) ckalloc((unsigned) |
| 1377 |
|
(parse.numWords * sizeof (Tcl_Obj *))); |
| 1378 |
|
} |
| 1379 |
|
for (objectsUsed = 0, tokenPtr = parse.tokenPtr; |
| 1380 |
|
objectsUsed < parse.numWords; |
| 1381 |
|
objectsUsed++, tokenPtr += (tokenPtr->numComponents + 1)) { |
| 1382 |
|
objv[objectsUsed] = Tcl_EvalTokens(interp, tokenPtr+1, |
| 1383 |
|
tokenPtr->numComponents); |
| 1384 |
|
if (objv[objectsUsed] == NULL) { |
| 1385 |
|
code = TCL_ERROR; |
| 1386 |
|
goto error; |
| 1387 |
|
} |
| 1388 |
|
} |
| 1389 |
|
|
| 1390 |
|
/* |
| 1391 |
|
* Execute the command and free the objects for its words. |
| 1392 |
|
*/ |
| 1393 |
|
|
| 1394 |
|
code = EvalObjv(interp, objectsUsed, objv, p, bytesLeft, 0); |
| 1395 |
|
if (code != TCL_OK) { |
| 1396 |
|
goto error; |
| 1397 |
|
} |
| 1398 |
|
for (i = 0; i < objectsUsed; i++) { |
| 1399 |
|
Tcl_DecrRefCount(objv[i]); |
| 1400 |
|
} |
| 1401 |
|
objectsUsed = 0; |
| 1402 |
|
if (objv != staticObjArray) { |
| 1403 |
|
ckfree((char *) objv); |
| 1404 |
|
objv = staticObjArray; |
| 1405 |
|
} |
| 1406 |
|
} |
| 1407 |
|
|
| 1408 |
|
/* |
| 1409 |
|
* Advance to the next command in the script. |
| 1410 |
|
*/ |
| 1411 |
|
|
| 1412 |
|
next = parse.commandStart + parse.commandSize; |
| 1413 |
|
bytesLeft -= next - p; |
| 1414 |
|
p = next; |
| 1415 |
|
Tcl_FreeParse(&parse); |
| 1416 |
|
gotParse = 0; |
| 1417 |
|
if ((nested != 0) && (p > script) && (p[-1] == ']')) { |
| 1418 |
|
/* |
| 1419 |
|
* We get here in the special case where the TCL_BRACKET_TERM |
| 1420 |
|
* flag was set in the interpreter and we reached a close |
| 1421 |
|
* bracket in the script. Return immediately. |
| 1422 |
|
*/ |
| 1423 |
|
|
| 1424 |
|
iPtr->termOffset = (p - 1) - script; |
| 1425 |
|
iPtr->varFramePtr = savedVarFramePtr; |
| 1426 |
|
return TCL_OK; |
| 1427 |
|
} |
| 1428 |
|
} while (bytesLeft > 0); |
| 1429 |
|
iPtr->termOffset = p - script; |
| 1430 |
|
iPtr->varFramePtr = savedVarFramePtr; |
| 1431 |
|
return TCL_OK; |
| 1432 |
|
|
| 1433 |
|
error: |
| 1434 |
|
/* |
| 1435 |
|
* Generate various pieces of error information, such as the line |
| 1436 |
|
* number where the error occurred and information to add to the |
| 1437 |
|
* errorInfo variable. Then free resources that had been allocated |
| 1438 |
|
* to the command. |
| 1439 |
|
*/ |
| 1440 |
|
|
| 1441 |
|
if ((code == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) { |
| 1442 |
|
commandLength = parse.commandSize; |
| 1443 |
|
if ((parse.commandStart + commandLength) != (script + numBytes)) { |
| 1444 |
|
/* |
| 1445 |
|
* The command where the error occurred didn't end at the end |
| 1446 |
|
* of the script (i.e. it ended at a terminator character such |
| 1447 |
|
* as ";". Reduce the length by one so that the error message |
| 1448 |
|
* doesn't include the terminator character. |
| 1449 |
|
*/ |
| 1450 |
|
|
| 1451 |
|
commandLength -= 1; |
| 1452 |
|
} |
| 1453 |
|
Tcl_LogCommandInfo(interp, script, parse.commandStart, commandLength); |
| 1454 |
|
} |
| 1455 |
|
|
| 1456 |
|
for (i = 0; i < objectsUsed; i++) { |
| 1457 |
|
Tcl_DecrRefCount(objv[i]); |
| 1458 |
|
} |
| 1459 |
|
if (gotParse) { |
| 1460 |
|
p = parse.commandStart + parse.commandSize; |
| 1461 |
|
Tcl_FreeParse(&parse); |
| 1462 |
|
if ((nested != 0) && (p > script) && (p[-1] == ']')) { |
| 1463 |
|
/* |
| 1464 |
|
* We get here in the special case where the TCL_BRACKET_TERM |
| 1465 |
|
* flag was set in the interpreter and we reached a close |
| 1466 |
|
* bracket in the script. Return immediately. |
| 1467 |
|
*/ |
| 1468 |
|
|
| 1469 |
|
iPtr->termOffset = (p - 1) - script; |
| 1470 |
|
} else { |
| 1471 |
|
iPtr->termOffset = p - script; |
| 1472 |
|
} |
| 1473 |
|
} |
| 1474 |
|
if (objv != staticObjArray) { |
| 1475 |
|
ckfree((char *) objv); |
| 1476 |
|
} |
| 1477 |
|
iPtr->varFramePtr = savedVarFramePtr; |
| 1478 |
|
return code; |
| 1479 |
|
} |
| 1480 |
|
|
| 1481 |
|
/* |
| 1482 |
|
*---------------------------------------------------------------------- |
| 1483 |
|
* |
| 1484 |
|
* Tcl_Eval -- |
| 1485 |
|
* |
| 1486 |
|
* Execute a Tcl command in a string. This procedure executes the |
| 1487 |
|
* script directly, rather than compiling it to bytecodes. Before |
| 1488 |
|
* the arrival of the bytecode compiler in Tcl 8.0 Tcl_Eval was |
| 1489 |
|
* the main procedure used for executing Tcl commands, but nowadays |
| 1490 |
|
* it isn't used much. |
| 1491 |
|
* |
| 1492 |
|
* Results: |
| 1493 |
|
* The return value is one of the return codes defined in tcl.h |
| 1494 |
|
* (such as TCL_OK), and interp's result contains a value |
| 1495 |
|
* to supplement the return code. The value of the result |
| 1496 |
|
* will persist only until the next call to Tcl_Eval or Tcl_EvalObj: |
| 1497 |
|
* you must copy it or lose it! |
| 1498 |
|
* |
| 1499 |
|
* Side effects: |
| 1500 |
|
* Can be almost arbitrary, depending on the commands in the script. |
| 1501 |
|
* |
| 1502 |
|
*---------------------------------------------------------------------- |
| 1503 |
|
*/ |
| 1504 |
|
|
| 1505 |
|
int |
| 1506 |
|
Tcl_Eval(interp, string) |
| 1507 |
|
Tcl_Interp *interp; /* Token for command interpreter (returned |
| 1508 |
|
* by previous call to Tcl_CreateInterp). */ |
| 1509 |
|
char *string; /* Pointer to TCL command to execute. */ |
| 1510 |
|
{ |
| 1511 |
|
int code; |
| 1512 |
|
|
| 1513 |
|
code = Tcl_EvalEx(interp, string, -1, 0); |
| 1514 |
|
|
| 1515 |
|
/* |
| 1516 |
|
* For backwards compatibility with old C code that predates the |
| 1517 |
|
* object system in Tcl 8.0, we have to mirror the object result |
| 1518 |
|
* back into the string result (some callers may expect it there). |
| 1519 |
|
*/ |
| 1520 |
|
|
| 1521 |
|
Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)), |
| 1522 |
|
TCL_VOLATILE); |
| 1523 |
|
return code; |
| 1524 |
|
} |
| 1525 |
|
|
| 1526 |
|
/* |
| 1527 |
|
*---------------------------------------------------------------------- |
| 1528 |
|
* |
| 1529 |
|
* Tcl_EvalObj, Tcl_GlobalEvalObj -- |
| 1530 |
|
* |
| 1531 |
|
* These functions are deprecated but we keep them around for backwards |
| 1532 |
|
* compatibility reasons. |
| 1533 |
|
* |
| 1534 |
|
* Results: |
| 1535 |
|
* See the functions they call. |
| 1536 |
|
* |
| 1537 |
|
* Side effects: |
| 1538 |
|
* See the functions they call. |
| 1539 |
|
* |
| 1540 |
|
*---------------------------------------------------------------------- |
| 1541 |
|
*/ |
| 1542 |
|
|
| 1543 |
|
#undef Tcl_EvalObj |
| 1544 |
|
int |
| 1545 |
|
Tcl_EvalObj(interp, objPtr) |
| 1546 |
|
Tcl_Interp * interp; |
| 1547 |
|
Tcl_Obj * objPtr; |
| 1548 |
|
{ |
| 1549 |
|
return Tcl_EvalObjEx(interp, objPtr, 0); |
| 1550 |
|
} |
| 1551 |
|
|
| 1552 |
|
#undef Tcl_GlobalEvalObj |
| 1553 |
|
int |
| 1554 |
|
Tcl_GlobalEvalObj(interp, objPtr) |
| 1555 |
|
Tcl_Interp * interp; |
| 1556 |
|
Tcl_Obj * objPtr; |
| 1557 |
|
{ |
| 1558 |
|
return Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL); |
| 1559 |
|
} |
| 1560 |
|
|
| 1561 |
|
/* |
| 1562 |
|
*---------------------------------------------------------------------- |
| 1563 |
|
* |
| 1564 |
|
* Tcl_ParseVarName -- |
| 1565 |
|
* |
| 1566 |
|
* Given a string starting with a $ sign, parse off a variable |
| 1567 |
|
* name and return information about the parse. |
| 1568 |
|
* |
| 1569 |
|
* Results: |
| 1570 |
|
* The return value is TCL_OK if the command was parsed |
| 1571 |
|
* successfully and TCL_ERROR otherwise. If an error occurs and |
| 1572 |
|
* interp isn't NULL then an error message is left in its result. |
| 1573 |
|
* On a successful return, tokenPtr and numTokens fields of |
| 1574 |
|
* parsePtr are filled in with information about the variable name |
| 1575 |
|
* that was parsed. The "size" field of the first new token gives |
| 1576 |
|
* the total number of bytes in the variable name. Other fields in |
| 1577 |
|
* parsePtr are undefined. |
| 1578 |
|
* |
| 1579 |
|
* Side effects: |
| 1580 |
|
* If there is insufficient space in parsePtr to hold all the |
| 1581 |
|
* information about the command, then additional space is |
| 1582 |
|
* malloc-ed. If the procedure returns TCL_OK then the caller must |
| 1583 |
|
* eventually invoke Tcl_FreeParse to release any additional space |
| 1584 |
|
* that was allocated. |
| 1585 |
|
* |
| 1586 |
|
*---------------------------------------------------------------------- |
| 1587 |
|
*/ |
| 1588 |
|
|
| 1589 |
|
int |
| 1590 |
|
Tcl_ParseVarName(interp, string, numBytes, parsePtr, append) |
| 1591 |
|
Tcl_Interp *interp; /* Interpreter to use for error reporting; |
| 1592 |
|
* if NULL, then no error message is |
| 1593 |
|
* provided. */ |
| 1594 |
|
char *string; /* String containing variable name. First |
| 1595 |
|
* character must be "$". */ |
| 1596 |
|
int numBytes; /* Total number of bytes in string. If < 0, |
| 1597 |
|
* the string consists of all bytes up to the |
| 1598 |
|
* first null character. */ |
| 1599 |
|
Tcl_Parse *parsePtr; /* Structure to fill in with information |
| 1600 |
|
* about the variable name. */ |
| 1601 |
|
int append; /* Non-zero means append tokens to existing |
| 1602 |
|
* information in parsePtr; zero means ignore |
| 1603 |
|
* existing tokens in parsePtr and reinitialize |
| 1604 |
|
* it. */ |
| 1605 |
|
{ |
| 1606 |
|
Tcl_Token *tokenPtr; |
| 1607 |
|
char *end, *src; |
| 1608 |
|
unsigned char c; |
| 1609 |
|
int varIndex, offset; |
| 1610 |
|
Tcl_UniChar ch; |
| 1611 |
|
unsigned array; |
| 1612 |
|
|
| 1613 |
|
if (numBytes >= 0) { |
| 1614 |
|
end = string + numBytes; |
| 1615 |
|
} else { |
| 1616 |
|
end = string + strlen(string); |
| 1617 |
|
} |
| 1618 |
|
|
| 1619 |
|
if (!append) { |
| 1620 |
|
parsePtr->numWords = 0; |
| 1621 |
|
parsePtr->tokenPtr = parsePtr->staticTokens; |
| 1622 |
|
parsePtr->numTokens = 0; |
| 1623 |
|
parsePtr->tokensAvailable = NUM_STATIC_TOKENS; |
| 1624 |
|
parsePtr->string = string; |
| 1625 |
|
parsePtr->end = end; |
| 1626 |
|
parsePtr->interp = interp; |
| 1627 |
|
parsePtr->errorType = TCL_PARSE_SUCCESS; |
| 1628 |
|
parsePtr->incomplete = 0; |
| 1629 |
|
} |
| 1630 |
|
|
| 1631 |
|
/* |
| 1632 |
|
* Generate one token for the variable, an additional token for the |
| 1633 |
|
* name, plus any number of additional tokens for the index, if |
| 1634 |
|
* there is one. |
| 1635 |
|
*/ |
| 1636 |
|
|
| 1637 |
|
src = string; |
| 1638 |
|
if ((parsePtr->numTokens + 2) > parsePtr->tokensAvailable) { |
| 1639 |
|
TclExpandTokenArray(parsePtr); |
| 1640 |
|
} |
| 1641 |
|
tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens]; |
| 1642 |
|
tokenPtr->type = TCL_TOKEN_VARIABLE; |
| 1643 |
|
tokenPtr->start = src; |
| 1644 |
|
varIndex = parsePtr->numTokens; |
| 1645 |
|
parsePtr->numTokens++; |
| 1646 |
|
tokenPtr++; |
| 1647 |
|
src++; |
| 1648 |
|
if (src >= end) { |
| 1649 |
|
goto justADollarSign; |
| 1650 |
|
} |
| 1651 |
|
tokenPtr->type = TCL_TOKEN_TEXT; |
| 1652 |
|
tokenPtr->start = src; |
| 1653 |
|
tokenPtr->numComponents = 0; |
| 1654 |
|
|
| 1655 |
|
/* |
| 1656 |
|
* The name of the variable can have three forms: |
| 1657 |
|
* 1. The $ sign is followed by an open curly brace. Then |
| 1658 |
|
* the variable name is everything up to the next close |
| 1659 |
|
* curly brace, and the variable is a scalar variable. |
| 1660 |
|
* 2. The $ sign is not followed by an open curly brace. Then |
| 1661 |
|
* the variable name is everything up to the next |
| 1662 |
|
* character that isn't a letter, digit, or underscore. |
| 1663 |
|
* :: sequences are also considered part of the variable |
| 1664 |
|
* name, in order to support namespaces. If the following |
| 1665 |
|
* character is an open parenthesis, then the information |
| 1666 |
|
* between parentheses is the array element name. |
| 1667 |
|
* 3. The $ sign is followed by something that isn't a letter, |
| 1668 |
|
* digit, or underscore: in this case, there is no variable |
| 1669 |
|
* name and the token is just "$". |
| 1670 |
|
*/ |
| 1671 |
|
|
| 1672 |
|
if (*src == '{') { |
| 1673 |
|
src++; |
| 1674 |
|
tokenPtr->type = TCL_TOKEN_TEXT; |
| 1675 |
|
tokenPtr->start = src; |
| 1676 |
|
tokenPtr->numComponents = 0; |
| 1677 |
|
while (1) { |
| 1678 |
|
if (src == end) { |
| 1679 |
|
if (interp != NULL) { |
| 1680 |
|
Tcl_SetResult(interp, |
| 1681 |
|
"missing close-brace for variable name", |
| 1682 |
|
TCL_STATIC); |
| 1683 |
|
} |
| 1684 |
|
parsePtr->errorType = TCL_PARSE_MISSING_VAR_BRACE; |
| 1685 |
|
parsePtr->term = tokenPtr->start-1; |
| 1686 |
|
parsePtr->incomplete = 1; |
| 1687 |
|
goto error; |
| 1688 |
|
} |
| 1689 |
|
if (*src == '}') { |
| 1690 |
|
break; |
| 1691 |
|
} |
| 1692 |
|
src++; |
| 1693 |
|
} |
| 1694 |
|
tokenPtr->size = src - tokenPtr->start; |
| 1695 |
|
tokenPtr[-1].size = src - tokenPtr[-1].start; |
| 1696 |
|
parsePtr->numTokens++; |
| 1697 |
|
src++; |
| 1698 |
|
} else { |
| 1699 |
|
tokenPtr->type = TCL_TOKEN_TEXT; |
| 1700 |
|
tokenPtr->start = src; |
| 1701 |
|
tokenPtr->numComponents = 0; |
| 1702 |
|
while (src != end) { |
| 1703 |
|
offset = Tcl_UtfToUniChar(src, &ch); |
| 1704 |
|
c = UCHAR(ch); |
| 1705 |
|
if (isalnum(c) || (c == '_')) { /* INTL: ISO only, UCHAR. */ |
| 1706 |
|
src += offset; |
| 1707 |
|
continue; |
| 1708 |
|
} |
| 1709 |
|
if ((c == ':') && (((src+1) != end) && (src[1] == ':'))) { |
| 1710 |
|
src += 2; |
| 1711 |
|
while ((src != end) && (*src == ':')) { |
| 1712 |
|
src += 1; |
| 1713 |
|
} |
| 1714 |
|
continue; |
| 1715 |
|
} |
| 1716 |
|
break; |
| 1717 |
|
} |
| 1718 |
|
|
| 1719 |
|
/* |
| 1720 |
|
* Support for empty array names here. |
| 1721 |
|
*/ |
| 1722 |
|
array = ((src != end) && (*src == '(')); |
| 1723 |
|
tokenPtr->size = src - tokenPtr->start; |
| 1724 |
|
if (tokenPtr->size == 0 && !array) { |
| 1725 |
|
goto justADollarSign; |
| 1726 |
|
} |
| 1727 |
|
parsePtr->numTokens++; |
| 1728 |
|
if (array) { |
| 1729 |
|
/* |
| 1730 |
|
* This is a reference to an array element. Call |
| 1731 |
|
* ParseTokens recursively to parse the element name, |
| 1732 |
|
* since it could contain any number of substitutions. |
| 1733 |
|
*/ |
| 1734 |
|
|
| 1735 |
|
if (ParseTokens(src+1, TYPE_CLOSE_PAREN, parsePtr) |
| 1736 |
|
!= TCL_OK) { |
| 1737 |
|
goto error; |
| 1738 |
|
} |
| 1739 |
|
if ((parsePtr->term == end) || (*parsePtr->term != ')')) { |
| 1740 |
|
if (parsePtr->interp != NULL) { |
| 1741 |
|
Tcl_SetResult(parsePtr->interp, "missing )", |
| 1742 |
|
TCL_STATIC); |
| 1743 |
|
} |
| 1744 |
|
parsePtr->errorType = TCL_PARSE_MISSING_PAREN; |
| 1745 |
|
parsePtr->term = src; |
| 1746 |
|
parsePtr->incomplete = 1; |
| 1747 |
|
goto error; |
| 1748 |
|
} |
| 1749 |
|
src = parsePtr->term + 1; |
| 1750 |
|
} |
| 1751 |
|
} |
| 1752 |
|
tokenPtr = &parsePtr->tokenPtr[varIndex]; |
| 1753 |
|
tokenPtr->size = src - tokenPtr->start; |
| 1754 |
|
tokenPtr->numComponents = parsePtr->numTokens - (varIndex + 1); |
| 1755 |
|
return TCL_OK; |
| 1756 |
|
|
| 1757 |
|
/* |
| 1758 |
|
* The dollar sign isn't followed by a variable name. |
| 1759 |
|
* replace the TCL_TOKEN_VARIABLE token with a |
| 1760 |
|
* TCL_TOKEN_TEXT token for the dollar sign. |
| 1761 |
|
*/ |
| 1762 |
|
|
| 1763 |
|
justADollarSign: |
| 1764 |
|
tokenPtr = &parsePtr->tokenPtr[varIndex]; |
| 1765 |
|
tokenPtr->type = TCL_TOKEN_TEXT; |
| 1766 |
|
tokenPtr->size = 1; |
| 1767 |
|
tokenPtr->numComponents = 0; |
| 1768 |
|
return TCL_OK; |
| 1769 |
|
|
| 1770 |
|
error: |
| 1771 |
|
Tcl_FreeParse(parsePtr); |
| 1772 |
|
return TCL_ERROR; |
| 1773 |
|
} |
| 1774 |
|
|
| 1775 |
|
/* |
| 1776 |
|
*---------------------------------------------------------------------- |
| 1777 |
|
* |
| 1778 |
|
* Tcl_ParseVar -- |
| 1779 |
|
* |
| 1780 |
|
* Given a string starting with a $ sign, parse off a variable |
| 1781 |
|
* name and return its value. |
| 1782 |
|
* |
| 1783 |
|
* Results: |
| 1784 |
|
* The return value is the contents of the variable given by |
| 1785 |
|
* the leading characters of string. If termPtr isn't NULL, |
| 1786 |
|
* *termPtr gets filled in with the address of the character |
| 1787 |
|
* just after the last one in the variable specifier. If the |
| 1788 |
|
* variable doesn't exist, then the return value is NULL and |
| 1789 |
|
* an error message will be left in interp's result. |
| 1790 |
|
* |
| 1791 |
|
* Side effects: |
| 1792 |
|
* None. |
| 1793 |
|
* |
| 1794 |
|
*---------------------------------------------------------------------- |
| 1795 |
|
*/ |
| 1796 |
|
|
| 1797 |
|
char * |
| 1798 |
|
Tcl_ParseVar(interp, string, termPtr) |
| 1799 |
|
Tcl_Interp *interp; /* Context for looking up variable. */ |
| 1800 |
|
register char *string; /* String containing variable name. |
| 1801 |
|
* First character must be "$". */ |
| 1802 |
|
char **termPtr; /* If non-NULL, points to word to fill |
| 1803 |
|
* in with character just after last |
| 1804 |
|
* one in the variable specifier. */ |
| 1805 |
|
|
| 1806 |
|
{ |
| 1807 |
|
Tcl_Parse parse; |
| 1808 |
|
register Tcl_Obj *objPtr; |
| 1809 |
|
|
| 1810 |
|
if (Tcl_ParseVarName(interp, string, -1, &parse, 0) != TCL_OK) { |
| 1811 |
|
return NULL; |
| 1812 |
|
} |
| 1813 |
|
|
| 1814 |
|
if (termPtr != NULL) { |
| 1815 |
|
*termPtr = string + parse.tokenPtr->size; |
| 1816 |
|
} |
| 1817 |
|
if (parse.numTokens == 1) { |
| 1818 |
|
/* |
| 1819 |
|
* There isn't a variable name after all: the $ is just a $. |
| 1820 |
|
*/ |
| 1821 |
|
|
| 1822 |
|
return "$"; |
| 1823 |
|
} |
| 1824 |
|
|
| 1825 |
|
objPtr = Tcl_EvalTokens(interp, parse.tokenPtr, parse.numTokens); |
| 1826 |
|
if (objPtr == NULL) { |
| 1827 |
|
return NULL; |
| 1828 |
|
} |
| 1829 |
|
|
| 1830 |
|
/* |
| 1831 |
|
* At this point we should have an object containing the value of |
| 1832 |
|
* a variable. Just return the string from that object. |
| 1833 |
|
*/ |
| 1834 |
|
|
| 1835 |
|
#ifdef TCL_COMPILE_DEBUG |
| 1836 |
|
if (objPtr->refCount < 2) { |
| 1837 |
|
panic("Tcl_ParseVar got temporary object from Tcl_EvalTokens"); |
| 1838 |
|
} |
| 1839 |
|
#endif /*TCL_COMPILE_DEBUG*/ |
| 1840 |
|
TclDecrRefCount(objPtr); |
| 1841 |
|
return TclGetString(objPtr); |
| 1842 |
|
} |
| 1843 |
|
|
| 1844 |
|
/* |
| 1845 |
|
*---------------------------------------------------------------------- |
| 1846 |
|
* |
| 1847 |
|
* Tcl_ParseBraces -- |
| 1848 |
|
* |
| 1849 |
|
* Given a string in braces such as a Tcl command argument or a string |
| 1850 |
|
* value in a Tcl expression, this procedure parses the string and |
| 1851 |
|
* returns information about the parse. |
| 1852 |
|
* |
| 1853 |
|
* Results: |
| 1854 |
|
* The return value is TCL_OK if the string was parsed successfully and |
| 1855 |
|
* TCL_ERROR otherwise. If an error occurs and interp isn't NULL then |
| 1856 |
|
* an error message is left in its result. On a successful return, |
| 1857 |
|
* tokenPtr and numTokens fields of parsePtr are filled in with |
| 1858 |
|
* information about the string that was parsed. Other fields in |
| 1859 |
|
* parsePtr are undefined. termPtr is set to point to the character |
| 1860 |
|
* just after the last one in the braced string. |
| 1861 |
|
* |
| 1862 |
|
* Side effects: |
| 1863 |
|
* If there is insufficient space in parsePtr to hold all the |
| 1864 |
|
* information about the command, then additional space is |
| 1865 |
|
* malloc-ed. If the procedure returns TCL_OK then the caller must |
| 1866 |
|
* eventually invoke Tcl_FreeParse to release any additional space |
| 1867 |
|
* that was allocated. |
| 1868 |
|
* |
| 1869 |
|
*---------------------------------------------------------------------- |
| 1870 |
|
*/ |
| 1871 |
|
|
| 1872 |
|
int |
| 1873 |
|
Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr) |
| 1874 |
|
Tcl_Interp *interp; /* Interpreter to use for error reporting; |
| 1875 |
|
* if NULL, then no error message is |
| 1876 |
|
* provided. */ |
| 1877 |
|
char *string; /* String containing the string in braces. |
| 1878 |
|
* The first character must be '{'. */ |
| 1879 |
|
int numBytes; /* Total number of bytes in string. If < 0, |
| 1880 |
|
* the string consists of all bytes up to |
| 1881 |
|
* the first null character. */ |
| 1882 |
|
register Tcl_Parse *parsePtr; |
| 1883 |
|
/* Structure to fill in with information |
| 1884 |
|
* about the string. */ |
| 1885 |
|
int append; /* Non-zero means append tokens to existing |
| 1886 |
|
* information in parsePtr; zero means |
| 1887 |
|
* ignore existing tokens in parsePtr and |
| 1888 |
|
* reinitialize it. */ |
| 1889 |
|
char **termPtr; /* If non-NULL, points to word in which to |
| 1890 |
|
* store a pointer to the character just |
| 1891 |
|
* after the terminating '}' if the parse |
| 1892 |
|
* was successful. */ |
| 1893 |
|
|
| 1894 |
|
{ |
| 1895 |
|
char utfBytes[TCL_UTF_MAX]; /* For result of backslash substitution. */ |
| 1896 |
|
Tcl_Token *tokenPtr; |
| 1897 |
|
register char *src, *end; |
| 1898 |
|
int startIndex, level, length; |
| 1899 |
|
|
| 1900 |
|
if ((numBytes >= 0) || (string == NULL)) { |
| 1901 |
|
end = string + numBytes; |
| 1902 |
|
} else { |
| 1903 |
|
end = string + strlen(string); |
| 1904 |
|
} |
| 1905 |
|
|
| 1906 |
|
if (!append) { |
| 1907 |
|
parsePtr->numWords = 0; |
| 1908 |
|
parsePtr->tokenPtr = parsePtr->staticTokens; |
| 1909 |
|
parsePtr->numTokens = 0; |
| 1910 |
|
parsePtr->tokensAvailable = NUM_STATIC_TOKENS; |
| 1911 |
|
parsePtr->string = string; |
| 1912 |
|
parsePtr->end = end; |
| 1913 |
|
parsePtr->interp = interp; |
| 1914 |
|
parsePtr->errorType = TCL_PARSE_SUCCESS; |
| 1915 |
|
} |
| 1916 |
|
|
| 1917 |
|
src = string+1; |
| 1918 |
|
startIndex = parsePtr->numTokens; |
| 1919 |
|
|
| 1920 |
|
if (parsePtr->numTokens == parsePtr->tokensAvailable) { |
| 1921 |
|
TclExpandTokenArray(parsePtr); |
| 1922 |
|
} |
| 1923 |
|
tokenPtr = &parsePtr->tokenPtr[startIndex]; |
| 1924 |
|
tokenPtr->type = TCL_TOKEN_TEXT; |
| 1925 |
|
tokenPtr->start = src; |
| 1926 |
|
tokenPtr->numComponents = 0; |
| 1927 |
|
level = 1; |
| 1928 |
|
while (1) { |
| 1929 |
|
while (CHAR_TYPE(*src) == TYPE_NORMAL) { |
| 1930 |
|
src++; |
| 1931 |
|
} |
| 1932 |
|
if (*src == '}') { |
| 1933 |
|
level--; |
| 1934 |
|
if (level == 0) { |
| 1935 |
|
break; |
| 1936 |
|
} |
| 1937 |
|
src++; |
| 1938 |
|
} else if (*src == '{') { |
| 1939 |
|
level++; |
| 1940 |
|
src++; |
| 1941 |
|
} else if (*src == '\\') { |
| 1942 |
|
Tcl_UtfBackslash(src, &length, utfBytes); |
| 1943 |
|
if (src[1] == '\n') { |
| 1944 |
|
/* |
| 1945 |
|
* A backslash-newline sequence must be collapsed, even |
| 1946 |
|
* inside braces, so we have to split the word into |
| 1947 |
|
* multiple tokens so that the backslash-newline can be |
| 1948 |
|
* represented explicitly. |
| 1949 |
|
*/ |
| 1950 |
|
|
| 1951 |
|
if ((src + 2) == end) { |
| 1952 |
|
parsePtr->incomplete = 1; |
| 1953 |
|
} |
| 1954 |
|
tokenPtr->size = (src - tokenPtr->start); |
| 1955 |
|
if (tokenPtr->size != 0) { |
| 1956 |
|
parsePtr->numTokens++; |
| 1957 |
|
} |
| 1958 |
|
if ((parsePtr->numTokens+1) >= parsePtr->tokensAvailable) { |
| 1959 |
|
TclExpandTokenArray(parsePtr); |
| 1960 |
|
} |
| 1961 |
|
tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens]; |
| 1962 |
|
tokenPtr->type = TCL_TOKEN_BS; |
| 1963 |
|
tokenPtr->start = src; |
| 1964 |
|
tokenPtr->size = length; |
| 1965 |
|
tokenPtr->numComponents = 0; |
| 1966 |
|
parsePtr->numTokens++; |
| 1967 |
|
|
| 1968 |
|
src += length; |
| 1969 |
|
tokenPtr++; |
| 1970 |
|
tokenPtr->type = TCL_TOKEN_TEXT; |
| 1971 |
|
tokenPtr->start = src; |
| 1972 |
|
tokenPtr->numComponents = 0; |
| 1973 |
|
} else { |
| 1974 |
|
src += length; |
| 1975 |
|
} |
| 1976 |
|
} else if (src == end) { |
| 1977 |
|
int openBrace; |
| 1978 |
|
|
| 1979 |
|
if (interp != NULL) { |
| 1980 |
|
Tcl_SetResult(interp, "missing close-brace", TCL_STATIC); |
| 1981 |
|
} |
| 1982 |
|
/* |
| 1983 |
|
* Search the source string for a possible open |
| 1984 |
|
* brace within the context of a comment. Since we |
| 1985 |
|
* aren't performing a full Tcl parse, just look for |
| 1986 |
|
* an open brace preceeded by a '<whitspace>#' on |
| 1987 |
|
* the same line. |
| 1988 |
|
*/ |
| 1989 |
|
openBrace = 0; |
| 1990 |
|
while (src > string ) { |
| 1991 |
|
switch (*src) { |
| 1992 |
|
case '{': |
| 1993 |
|
openBrace = 1; |
| 1994 |
|
break; |
| 1995 |
|
case '\n': |
| 1996 |
|
openBrace = 0; |
| 1997 |
|
break; |
| 1998 |
|
case '#': |
| 1999 |
|
if ((openBrace == 1) && (isspace(UCHAR(src[-1])))) { |
| 2000 |
|
if (interp != NULL) { |
| 2001 |
|
Tcl_AppendResult(interp, |
| 2002 |
|
": possible unbalanced brace in comment", |
| 2003 |
|
(char *) NULL); |
| 2004 |
|
} |
| 2005 |
|
openBrace = -1; |
| 2006 |
|
break; |
| 2007 |
|
} |
| 2008 |
|
break; |
| 2009 |
|
} |
| 2010 |
|
if (openBrace == -1) { |
| 2011 |
|
break; |
| 2012 |
|
} |
| 2013 |
|
src--; |
| 2014 |
|
} |
| 2015 |
|
parsePtr->errorType = TCL_PARSE_MISSING_BRACE; |
| 2016 |
|
parsePtr->term = string; |
| 2017 |
|
parsePtr->incomplete = 1; |
| 2018 |
|
goto error; |
| 2019 |
|
} else { |
| 2020 |
|
src++; |
| 2021 |
|
} |
| 2022 |
|
} |
| 2023 |
|
|
| 2024 |
|
/* |
| 2025 |
|
* Decide if we need to finish emitting a partially-finished token. |
| 2026 |
|
* There are 3 cases: |
| 2027 |
|
* {abc \newline xyz} or {xyz} - finish emitting "xyz" token |
| 2028 |
|
* {abc \newline} - don't emit token after \newline |
| 2029 |
|
* {} - finish emitting zero-sized token |
| 2030 |
|
* The last case ensures that there is a token (even if empty) that |
| 2031 |
|
* describes the braced string. |
| 2032 |
|
*/ |
| 2033 |
|
|
| 2034 |
|
if ((src != tokenPtr->start) |
| 2035 |
|
|| (parsePtr->numTokens == startIndex)) { |
| 2036 |
|
tokenPtr->size = (src - tokenPtr->start); |
| 2037 |
|
parsePtr->numTokens++; |
| 2038 |
|
} |
| 2039 |
|
if (termPtr != NULL) { |
| 2040 |
|
*termPtr = src+1; |
| 2041 |
|
} |
| 2042 |
|
return TCL_OK; |
| 2043 |
|
|
| 2044 |
|
error: |
| 2045 |
|
Tcl_FreeParse(parsePtr); |
| 2046 |
|
return TCL_ERROR; |
| 2047 |
|
} |
| 2048 |
|
|
| 2049 |
|
/* |
| 2050 |
|
*---------------------------------------------------------------------- |
| 2051 |
|
* |
| 2052 |
|
* Tcl_ParseQuotedString -- |
| 2053 |
|
* |
| 2054 |
|
* Given a double-quoted string such as a quoted Tcl command argument |
| 2055 |
|
* or a quoted value in a Tcl expression, this procedure parses the |
| 2056 |
|
* string and returns information about the parse. |
| 2057 |
|
* |
| 2058 |
|
* Results: |
| 2059 |
|
* The return value is TCL_OK if the string was parsed successfully and |
| 2060 |
|
* TCL_ERROR otherwise. If an error occurs and interp isn't NULL then |
| 2061 |
|
* an error message is left in its result. On a successful return, |
| 2062 |
|
* tokenPtr and numTokens fields of parsePtr are filled in with |
| 2063 |
|
* information about the string that was parsed. Other fields in |
| 2064 |
|
* parsePtr are undefined. termPtr is set to point to the character |
| 2065 |
|
* just after the quoted string's terminating close-quote. |
| 2066 |
|
* |
| 2067 |
|
* Side effects: |
| 2068 |
|
* If there is insufficient space in parsePtr to hold all the |
| 2069 |
|
* information about the command, then additional space is |
| 2070 |
|
* malloc-ed. If the procedure returns TCL_OK then the caller must |
| 2071 |
|
* eventually invoke Tcl_FreeParse to release any additional space |
| 2072 |
|
* that was allocated. |
| 2073 |
|
* |
| 2074 |
|
*---------------------------------------------------------------------- |
| 2075 |
|
*/ |
| 2076 |
|
|
| 2077 |
|
int |
| 2078 |
|
Tcl_ParseQuotedString(interp, string, numBytes, parsePtr, append, termPtr) |
| 2079 |
|
Tcl_Interp *interp; /* Interpreter to use for error reporting; |
| 2080 |
|
* if NULL, then no error message is |
| 2081 |
|
* provided. */ |
| 2082 |
|
char *string; /* String containing the quoted string. |
| 2083 |
|
* The first character must be '"'. */ |
| 2084 |
|
int numBytes; /* Total number of bytes in string. If < 0, |
| 2085 |
|
* the string consists of all bytes up to |
| 2086 |
|
* the first null character. */ |
| 2087 |
|
register Tcl_Parse *parsePtr; |
| 2088 |
|
/* Structure to fill in with information |
| 2089 |
|
* about the string. */ |
| 2090 |
|
int append; /* Non-zero means append tokens to existing |
| 2091 |
|
* information in parsePtr; zero means |
| 2092 |
|
* ignore existing tokens in parsePtr and |
| 2093 |
|
* reinitialize it. */ |
| 2094 |
|
char **termPtr; /* If non-NULL, points to word in which to |
| 2095 |
|
* store a pointer to the character just |
| 2096 |
|
* after the quoted string's terminating |
| 2097 |
|
* close-quote if the parse succeeds. */ |
| 2098 |
|
{ |
| 2099 |
|
char *end; |
| 2100 |
|
|
| 2101 |
|
if ((numBytes >= 0) || (string == NULL)) { |
| 2102 |
|
end = string + numBytes; |
| 2103 |
|
} else { |
| 2104 |
|
end = string + strlen(string); |
| 2105 |
|
} |
| 2106 |
|
|
| 2107 |
|
if (!append) { |
| 2108 |
|
parsePtr->numWords = 0; |
| 2109 |
|
parsePtr->tokenPtr = parsePtr->staticTokens; |
| 2110 |
|
parsePtr->numTokens = 0; |
| 2111 |
|
parsePtr->tokensAvailable = NUM_STATIC_TOKENS; |
| 2112 |
|
parsePtr->string = string; |
| 2113 |
|
parsePtr->end = end; |
| 2114 |
|
parsePtr->interp = interp; |
| 2115 |
|
parsePtr->errorType = TCL_PARSE_SUCCESS; |
| 2116 |
|
} |
| 2117 |
|
|
| 2118 |
|
if (ParseTokens(string+1, TYPE_QUOTE, parsePtr) != TCL_OK) { |
| 2119 |
|
goto error; |
| 2120 |
|
} |
| 2121 |
|
if (*parsePtr->term != '"') { |
| 2122 |
|
if (interp != NULL) { |
| 2123 |
|
Tcl_SetResult(parsePtr->interp, "missing \"", TCL_STATIC); |
| 2124 |
|
} |
| 2125 |
|
parsePtr->errorType = TCL_PARSE_MISSING_QUOTE; |
| 2126 |
|
parsePtr->term = string; |
| 2127 |
|
parsePtr->incomplete = 1; |
| 2128 |
|
goto error; |
| 2129 |
|
} |
| 2130 |
|
if (termPtr != NULL) { |
| 2131 |
|
*termPtr = (parsePtr->term + 1); |
| 2132 |
|
} |
| 2133 |
|
return TCL_OK; |
| 2134 |
|
|
| 2135 |
|
error: |
| 2136 |
|
Tcl_FreeParse(parsePtr); |
| 2137 |
|
return TCL_ERROR; |
| 2138 |
|
} |
| 2139 |
|
|
| 2140 |
|
/* |
| 2141 |
|
*---------------------------------------------------------------------- |
| 2142 |
|
* |
| 2143 |
|
* CommandComplete -- |
| 2144 |
|
* |
| 2145 |
|
* This procedure is shared by TclCommandComplete and |
| 2146 |
|
* Tcl_ObjCommandcoComplete; it does all the real work of seeing |
| 2147 |
|
* whether a script is complete |
| 2148 |
|
* |
| 2149 |
|
* Results: |
| 2150 |
|
* 1 is returned if the script is complete, 0 if there are open |
| 2151 |
|
* delimiters such as " or (. 1 is also returned if there is a |
| 2152 |
|
* parse error in the script other than unmatched delimiters. |
| 2153 |
|
* |
| 2154 |
|
* Side effects: |
| 2155 |
|
* None. |
| 2156 |
|
* |
| 2157 |
|
*---------------------------------------------------------------------- |
| 2158 |
|
*/ |
| 2159 |
|
|
| 2160 |
|
static int |
| 2161 |
|
CommandComplete(script, length) |
| 2162 |
|
char *script; /* Script to check. */ |
| 2163 |
|
int length; /* Number of bytes in script. */ |
| 2164 |
|
{ |
| 2165 |
|
Tcl_Parse parse; |
| 2166 |
|
char *p, *end; |
| 2167 |
|
int result; |
| 2168 |
|
|
| 2169 |
|
p = script; |
| 2170 |
|
end = p + length; |
| 2171 |
|
while (Tcl_ParseCommand((Tcl_Interp *) NULL, p, end - p, 0, &parse) |
| 2172 |
|
== TCL_OK) { |
| 2173 |
|
p = parse.commandStart + parse.commandSize; |
| 2174 |
|
if (*p == 0) { |
| 2175 |
|
break; |
| 2176 |
|
} |
| 2177 |
|
Tcl_FreeParse(&parse); |
| 2178 |
|
} |
| 2179 |
|
if (parse.incomplete) { |
| 2180 |
|
result = 0; |
| 2181 |
|
} else { |
| 2182 |
|
result = 1; |
| 2183 |
|
} |
| 2184 |
|
Tcl_FreeParse(&parse); |
| 2185 |
|
return result; |
| 2186 |
|
} |
| 2187 |
|
|
| 2188 |
|
/* |
| 2189 |
|
*---------------------------------------------------------------------- |
| 2190 |
|
* |
| 2191 |
|
* Tcl_CommandComplete -- |
| 2192 |
|
* |
| 2193 |
|
* Given a partial or complete Tcl script, this procedure |
| 2194 |
|
* determines whether the script is complete in the sense |
| 2195 |
|
* of having matched braces and quotes and brackets. |
| 2196 |
|
* |
| 2197 |
|
* Results: |
| 2198 |
|
* 1 is returned if the script is complete, 0 otherwise. |
| 2199 |
|
* 1 is also returned if there is a parse error in the script |
| 2200 |
|
* other than unmatched delimiters. |
| 2201 |
|
* |
| 2202 |
|
* Side effects: |
| 2203 |
|
* None. |
| 2204 |
|
* |
| 2205 |
|
*---------------------------------------------------------------------- |
| 2206 |
|
*/ |
| 2207 |
|
|
| 2208 |
|
int |
| 2209 |
|
Tcl_CommandComplete(script) |
| 2210 |
|
char *script; /* Script to check. */ |
| 2211 |
|
{ |
| 2212 |
|
return CommandComplete(script, (int) strlen(script)); |
| 2213 |
|
} |
| 2214 |
|
|
| 2215 |
|
/* |
| 2216 |
|
*---------------------------------------------------------------------- |
| 2217 |
|
* |
| 2218 |
|
* TclObjCommandComplete -- |
| 2219 |
|
* |
| 2220 |
|
* Given a partial or complete Tcl command in a Tcl object, this |
| 2221 |
|
* procedure determines whether the command is complete in the sense of |
| 2222 |
|
* having matched braces and quotes and brackets. |
| 2223 |
|
* |
| 2224 |
|
* Results: |
| 2225 |
|
* 1 is returned if the command is complete, 0 otherwise. |
| 2226 |
|
* |
| 2227 |
|
* Side effects: |
| 2228 |
|
* None. |
| 2229 |
|
* |
| 2230 |
|
*---------------------------------------------------------------------- |
| 2231 |
|
*/ |
| 2232 |
|
|
| 2233 |
|
int |
| 2234 |
|
TclObjCommandComplete(objPtr) |
| 2235 |
|
Tcl_Obj *objPtr; /* Points to object holding script |
| 2236 |
|
* to check. */ |
| 2237 |
|
{ |
| 2238 |
|
char *script; |
| 2239 |
|
int length; |
| 2240 |
|
|
| 2241 |
|
script = Tcl_GetStringFromObj(objPtr, &length); |
| 2242 |
|
return CommandComplete(script, length); |
| 2243 |
|
} |
| 2244 |
|
|
| 2245 |
|
/* |
| 2246 |
|
*---------------------------------------------------------------------- |
| 2247 |
|
* |
| 2248 |
|
* TclIsLocalScalar -- |
| 2249 |
|
* |
| 2250 |
|
* Check to see if a given string is a legal scalar variable |
| 2251 |
|
* name with no namespace qualifiers or substitutions. |
| 2252 |
|
* |
| 2253 |
|
* Results: |
| 2254 |
|
* Returns 1 if the variable is a local scalar. |
| 2255 |
|
* |
| 2256 |
|
* Side effects: |
| 2257 |
|
* None. |
| 2258 |
|
* |
| 2259 |
|
*---------------------------------------------------------------------- |
| 2260 |
|
*/ |
| 2261 |
|
|
| 2262 |
|
int |
| 2263 |
|
TclIsLocalScalar(src, len) |
| 2264 |
|
CONST char *src; |
| 2265 |
|
int len; |
| 2266 |
|
{ |
| 2267 |
|
CONST char *p; |
| 2268 |
|
CONST char *lastChar = src + (len - 1); |
| 2269 |
|
|
| 2270 |
|
for (p = src; p <= lastChar; p++) { |
| 2271 |
|
if ((CHAR_TYPE(*p) != TYPE_NORMAL) && |
| 2272 |
|
(CHAR_TYPE(*p) != TYPE_COMMAND_END)) { |
| 2273 |
|
/* |
| 2274 |
|
* TCL_COMMAND_END is returned for the last character |
| 2275 |
|
* of the string. By this point we know it isn't |
| 2276 |
|
* an array or namespace reference. |
| 2277 |
|
*/ |
| 2278 |
|
|
| 2279 |
|
return 0; |
| 2280 |
|
} |
| 2281 |
|
if (*p == '(') { |
| 2282 |
|
if (*lastChar == ')') { /* we have an array element */ |
| 2283 |
|
return 0; |
| 2284 |
|
} |
| 2285 |
|
} else if (*p == ':') { |
| 2286 |
|
if ((p != lastChar) && *(p+1) == ':') { /* qualified name */ |
| 2287 |
|
return 0; |
| 2288 |
|
} |
| 2289 |
|
} |
| 2290 |
|
} |
| 2291 |
|
|
| 2292 |
|
return 1; |
| 2293 |
|
} |
| 2294 |
|
|
| 2295 |
|
/* End of tclparse.c */ |
Parent Directory
| 
Revision Log
| 
Patch