sl@0: /* sl@0: * tclParse.c -- sl@0: * sl@0: * This file contains procedures that parse Tcl scripts. They sl@0: * do so in a general-purpose fashion that can be used for many sl@0: * different purposes, including compilation, direct execution, sl@0: * code analysis, etc. sl@0: * sl@0: * Copyright (c) 1997 Sun Microsystems, Inc. sl@0: * Copyright (c) 1998-2000 Ajuba Solutions. sl@0: * Portions Copyright (c) 2007-2008 Nokia Corporation and/or its subsidiaries. All rights reserved. sl@0: * Contributions from Don Porter, NIST, 2002. (not subject to US copyright) sl@0: * sl@0: * See the file "license.terms" for information on usage and redistribution sl@0: * of this file, and for a DISCLAIMER OF ALL WARRANTIES. sl@0: * sl@0: * RCS: @(#) $Id: tclParse.c,v 1.25.2.1 2006/09/24 21:15:10 msofer Exp $ sl@0: */ sl@0: sl@0: #include "tclInt.h" sl@0: #include "tclPort.h" sl@0: sl@0: /* sl@0: * The following table provides parsing information about each possible sl@0: * 8-bit character. The table is designed to be referenced with either sl@0: * signed or unsigned characters, so it has 384 entries. The first 128 sl@0: * entries correspond to negative character values, the next 256 correspond sl@0: * to positive character values. The last 128 entries are identical to the sl@0: * first 128. The table is always indexed with a 128-byte offset (the 128th sl@0: * entry corresponds to a character value of 0). sl@0: * sl@0: * The macro CHAR_TYPE is used to index into the table and return sl@0: * information about its character argument. The following return sl@0: * values are defined. sl@0: * sl@0: * TYPE_NORMAL - All characters that don't have special significance sl@0: * to the Tcl parser. sl@0: * TYPE_SPACE - The character is a whitespace character other sl@0: * than newline. sl@0: * TYPE_COMMAND_END - Character is newline or semicolon. sl@0: * TYPE_SUBS - Character begins a substitution or has other sl@0: * special meaning in ParseTokens: backslash, dollar sl@0: * sign, or open bracket. sl@0: * TYPE_QUOTE - Character is a double quote. sl@0: * TYPE_CLOSE_PAREN - Character is a right parenthesis. sl@0: * TYPE_CLOSE_BRACK - Character is a right square bracket. sl@0: * TYPE_BRACE - Character is a curly brace (either left or right). sl@0: */ sl@0: sl@0: #define TYPE_NORMAL 0 sl@0: #define TYPE_SPACE 0x1 sl@0: #define TYPE_COMMAND_END 0x2 sl@0: #define TYPE_SUBS 0x4 sl@0: #define TYPE_QUOTE 0x8 sl@0: #define TYPE_CLOSE_PAREN 0x10 sl@0: #define TYPE_CLOSE_BRACK 0x20 sl@0: #define TYPE_BRACE 0x40 sl@0: sl@0: #define CHAR_TYPE(c) (charTypeTable+128)[(int)(c)] sl@0: sl@0: static CONST char charTypeTable[] = { sl@0: /* sl@0: * Negative character values, from -128 to -1: sl@0: */ sl@0: sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: sl@0: /* sl@0: * Positive character values, from 0-127: sl@0: */ sl@0: sl@0: TYPE_SUBS, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_SPACE, TYPE_COMMAND_END, TYPE_SPACE, sl@0: TYPE_SPACE, TYPE_SPACE, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_SPACE, TYPE_NORMAL, TYPE_QUOTE, TYPE_NORMAL, sl@0: TYPE_SUBS, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_CLOSE_PAREN, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_COMMAND_END, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_SUBS, sl@0: TYPE_SUBS, TYPE_CLOSE_BRACK, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_BRACE, sl@0: TYPE_NORMAL, TYPE_BRACE, TYPE_NORMAL, TYPE_NORMAL, sl@0: sl@0: /* sl@0: * Large unsigned character values, from 128-255: sl@0: */ sl@0: sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, sl@0: }; sl@0: sl@0: /* sl@0: * Prototypes for local procedures defined in this file: sl@0: */ sl@0: sl@0: static int CommandComplete _ANSI_ARGS_((CONST char *script, sl@0: int numBytes)); sl@0: static int ParseComment _ANSI_ARGS_((CONST char *src, int numBytes, sl@0: Tcl_Parse *parsePtr)); sl@0: static int ParseTokens _ANSI_ARGS_((CONST char *src, int numBytes, sl@0: int mask, Tcl_Parse *parsePtr)); sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_ParseCommand -- sl@0: * sl@0: * Given a string, this procedure parses the first Tcl command sl@0: * in the string and returns information about the structure of sl@0: * the command. sl@0: * sl@0: * Results: sl@0: * The return value is TCL_OK if the command was parsed sl@0: * successfully and TCL_ERROR otherwise. If an error occurs sl@0: * and interp isn't NULL then an error message is left in sl@0: * its result. On a successful return, parsePtr is filled in sl@0: * with information about the command that was parsed. sl@0: * sl@0: * Side effects: sl@0: * If there is insufficient space in parsePtr to hold all the sl@0: * information about the command, then additional space is sl@0: * malloc-ed. If the procedure returns TCL_OK then the caller must sl@0: * eventually invoke Tcl_FreeParse to release any additional space sl@0: * that was allocated. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C int sl@0: Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr) sl@0: Tcl_Interp *interp; /* Interpreter to use for error reporting; sl@0: * if NULL, then no error message is sl@0: * provided. */ sl@0: CONST char *string; /* First character of string containing sl@0: * one or more Tcl commands. */ sl@0: register int numBytes; /* Total number of bytes in string. If < 0, sl@0: * the script consists of all bytes up to sl@0: * the first null character. */ sl@0: int nested; /* Non-zero means this is a nested command: sl@0: * close bracket should be considered sl@0: * a command terminator. If zero, then close sl@0: * bracket has no special meaning. */ sl@0: register Tcl_Parse *parsePtr; sl@0: /* Structure to fill in with information sl@0: * about the parsed command; any previous sl@0: * information in the structure is sl@0: * ignored. */ sl@0: { sl@0: register CONST char *src; /* Points to current character sl@0: * in the command. */ sl@0: char type; /* Result returned by CHAR_TYPE(*src). */ sl@0: Tcl_Token *tokenPtr; /* Pointer to token being filled in. */ sl@0: int wordIndex; /* Index of word token for current word. */ sl@0: int terminators; /* CHAR_TYPE bits that indicate the end sl@0: * of a command. */ sl@0: CONST char *termPtr; /* Set by Tcl_ParseBraces/QuotedString to sl@0: * point to char after terminating one. */ sl@0: int scanned; sl@0: sl@0: if ((string == NULL) && (numBytes!=0)) { sl@0: if (interp != NULL) { sl@0: Tcl_SetResult(interp, "can't parse a NULL pointer", TCL_STATIC); sl@0: } sl@0: return TCL_ERROR; sl@0: } sl@0: if (numBytes < 0) { sl@0: numBytes = strlen(string); sl@0: } sl@0: parsePtr->commentStart = NULL; sl@0: parsePtr->commentSize = 0; sl@0: parsePtr->commandStart = NULL; sl@0: parsePtr->commandSize = 0; sl@0: parsePtr->numWords = 0; sl@0: parsePtr->tokenPtr = parsePtr->staticTokens; sl@0: parsePtr->numTokens = 0; sl@0: parsePtr->tokensAvailable = NUM_STATIC_TOKENS; sl@0: parsePtr->string = string; sl@0: parsePtr->end = string + numBytes; sl@0: parsePtr->term = parsePtr->end; sl@0: parsePtr->interp = interp; sl@0: parsePtr->incomplete = 0; sl@0: parsePtr->errorType = TCL_PARSE_SUCCESS; sl@0: if (nested != 0) { sl@0: terminators = TYPE_COMMAND_END | TYPE_CLOSE_BRACK; sl@0: } else { sl@0: terminators = TYPE_COMMAND_END; sl@0: } sl@0: sl@0: /* sl@0: * Parse any leading space and comments before the first word of the sl@0: * command. sl@0: */ sl@0: sl@0: scanned = ParseComment(string, numBytes, parsePtr); sl@0: src = (string + scanned); numBytes -= scanned; sl@0: if (numBytes == 0) { sl@0: if (nested) { sl@0: parsePtr->incomplete = nested; sl@0: } sl@0: } sl@0: sl@0: /* sl@0: * The following loop parses the words of the command, one word sl@0: * in each iteration through the loop. sl@0: */ sl@0: sl@0: parsePtr->commandStart = src; sl@0: while (1) { sl@0: /* sl@0: * Create the token for the word. sl@0: */ sl@0: sl@0: if (parsePtr->numTokens == parsePtr->tokensAvailable) { sl@0: TclExpandTokenArray(parsePtr); sl@0: } sl@0: wordIndex = parsePtr->numTokens; sl@0: tokenPtr = &parsePtr->tokenPtr[wordIndex]; sl@0: tokenPtr->type = TCL_TOKEN_WORD; sl@0: sl@0: /* sl@0: * Skip white space before the word. Also skip a backslash-newline sl@0: * sequence: it should be treated just like white space. sl@0: */ sl@0: sl@0: scanned = TclParseWhiteSpace(src, numBytes, parsePtr, &type); sl@0: src += scanned; numBytes -= scanned; sl@0: if (numBytes == 0) { sl@0: parsePtr->term = src; sl@0: break; sl@0: } sl@0: if ((type & terminators) != 0) { sl@0: parsePtr->term = src; sl@0: src++; sl@0: break; sl@0: } sl@0: tokenPtr->start = src; sl@0: parsePtr->numTokens++; sl@0: parsePtr->numWords++; sl@0: sl@0: /* sl@0: * At this point the word can have one of three forms: something sl@0: * enclosed in quotes, something enclosed in braces, or an sl@0: * unquoted word (anything else). sl@0: */ sl@0: sl@0: if (*src == '"') { sl@0: if (Tcl_ParseQuotedString(interp, src, numBytes, sl@0: parsePtr, 1, &termPtr) != TCL_OK) { sl@0: goto error; sl@0: } sl@0: src = termPtr; numBytes = parsePtr->end - src; sl@0: } else if (*src == '{') { sl@0: if (Tcl_ParseBraces(interp, src, numBytes, sl@0: parsePtr, 1, &termPtr) != TCL_OK) { sl@0: goto error; sl@0: } sl@0: src = termPtr; numBytes = parsePtr->end - src; sl@0: } else { sl@0: /* sl@0: * This is an unquoted word. Call ParseTokens and let it do sl@0: * all of the work. sl@0: */ sl@0: sl@0: if (ParseTokens(src, numBytes, TYPE_SPACE|terminators, sl@0: parsePtr) != TCL_OK) { sl@0: goto error; sl@0: } sl@0: src = parsePtr->term; numBytes = parsePtr->end - src; sl@0: } sl@0: sl@0: /* sl@0: * Finish filling in the token for the word and check for the sl@0: * special case of a word consisting of a single range of sl@0: * literal text. sl@0: */ sl@0: sl@0: tokenPtr = &parsePtr->tokenPtr[wordIndex]; sl@0: tokenPtr->size = src - tokenPtr->start; sl@0: tokenPtr->numComponents = parsePtr->numTokens - (wordIndex + 1); sl@0: if ((tokenPtr->numComponents == 1) sl@0: && (tokenPtr[1].type == TCL_TOKEN_TEXT)) { sl@0: tokenPtr->type = TCL_TOKEN_SIMPLE_WORD; sl@0: } sl@0: sl@0: /* sl@0: * Do two additional checks: (a) make sure we're really at the sl@0: * end of a word (there might have been garbage left after a sl@0: * quoted or braced word), and (b) check for the end of the sl@0: * command. sl@0: */ sl@0: sl@0: scanned = TclParseWhiteSpace(src, numBytes, parsePtr, &type); sl@0: if (scanned) { sl@0: src += scanned; numBytes -= scanned; sl@0: continue; sl@0: } sl@0: sl@0: if (numBytes == 0) { sl@0: parsePtr->term = src; sl@0: break; sl@0: } sl@0: if ((type & terminators) != 0) { sl@0: parsePtr->term = src; sl@0: src++; sl@0: break; sl@0: } sl@0: if (src[-1] == '"') { sl@0: if (interp != NULL) { sl@0: Tcl_SetResult(interp, "extra characters after close-quote", sl@0: TCL_STATIC); sl@0: } sl@0: parsePtr->errorType = TCL_PARSE_QUOTE_EXTRA; sl@0: } else { sl@0: if (interp != NULL) { sl@0: Tcl_SetResult(interp, "extra characters after close-brace", sl@0: TCL_STATIC); sl@0: } sl@0: parsePtr->errorType = TCL_PARSE_BRACE_EXTRA; sl@0: } sl@0: parsePtr->term = src; sl@0: goto error; sl@0: } sl@0: sl@0: parsePtr->commandSize = src - parsePtr->commandStart; sl@0: return TCL_OK; sl@0: sl@0: error: sl@0: Tcl_FreeParse(parsePtr); sl@0: if (parsePtr->commandStart == NULL) { sl@0: parsePtr->commandStart = string; sl@0: } sl@0: parsePtr->commandSize = parsePtr->end - parsePtr->commandStart; sl@0: return TCL_ERROR; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * TclParseWhiteSpace -- sl@0: * sl@0: * Scans up to numBytes bytes starting at src, consuming white sl@0: * space as defined by Tcl's parsing rules. sl@0: * sl@0: * Results: sl@0: * Returns the number of bytes recognized as white space. Records sl@0: * at parsePtr, information about the parse. Records at typePtr sl@0: * the character type of the non-whitespace character that terminated sl@0: * the scan. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: int sl@0: TclParseWhiteSpace(src, numBytes, parsePtr, typePtr) sl@0: CONST char *src; /* First character to parse. */ sl@0: register int numBytes; /* Max number of bytes to scan. */ sl@0: Tcl_Parse *parsePtr; /* Information about parse in progress. sl@0: * Updated if parsing indicates sl@0: * an incomplete command. */ sl@0: char *typePtr; /* Points to location to store character sl@0: * type of character that ends run sl@0: * of whitespace */ sl@0: { sl@0: register char type = TYPE_NORMAL; sl@0: register CONST char *p = src; sl@0: sl@0: while (1) { sl@0: while (numBytes && ((type = CHAR_TYPE(*p)) & TYPE_SPACE)) { sl@0: numBytes--; p++; sl@0: } sl@0: if (numBytes && (type & TYPE_SUBS)) { sl@0: if (*p != '\\') { sl@0: break; sl@0: } sl@0: if (--numBytes == 0) { sl@0: break; sl@0: } sl@0: if (p[1] != '\n') { sl@0: break; sl@0: } sl@0: p+=2; sl@0: if (--numBytes == 0) { sl@0: parsePtr->incomplete = 1; sl@0: break; sl@0: } sl@0: continue; sl@0: } sl@0: break; sl@0: } sl@0: *typePtr = type; sl@0: return (p - src); sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * TclParseHex -- sl@0: * sl@0: * Scans a hexadecimal number as a Tcl_UniChar value. sl@0: * (e.g., for parsing \x and \u escape sequences). sl@0: * At most numBytes bytes are scanned. sl@0: * sl@0: * Results: sl@0: * The numeric value is stored in *resultPtr. sl@0: * Returns the number of bytes consumed. sl@0: * sl@0: * Notes: sl@0: * Relies on the following properties of the ASCII sl@0: * character set, with which UTF-8 is compatible: sl@0: * sl@0: * The digits '0' .. '9' and the letters 'A' .. 'Z' and 'a' .. 'z' sl@0: * occupy consecutive code points, and '0' < 'A' < 'a'. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: int sl@0: TclParseHex(src, numBytes, resultPtr) sl@0: CONST char *src; /* First character to parse. */ sl@0: int numBytes; /* Max number of byes to scan */ sl@0: Tcl_UniChar *resultPtr; /* Points to storage provided by sl@0: * caller where the Tcl_UniChar sl@0: * resulting from the conversion is sl@0: * to be written. */ sl@0: { sl@0: Tcl_UniChar result = 0; sl@0: register CONST char *p = src; sl@0: sl@0: while (numBytes--) { sl@0: unsigned char digit = UCHAR(*p); sl@0: sl@0: if (!isxdigit(digit)) sl@0: break; sl@0: sl@0: ++p; sl@0: result <<= 4; sl@0: sl@0: if (digit >= 'a') { sl@0: result |= (10 + digit - 'a'); sl@0: } else if (digit >= 'A') { sl@0: result |= (10 + digit - 'A'); sl@0: } else { sl@0: result |= (digit - '0'); sl@0: } sl@0: } sl@0: sl@0: *resultPtr = result; sl@0: return (p - src); sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * TclParseBackslash -- sl@0: * sl@0: * Scans up to numBytes bytes starting at src, consuming a sl@0: * backslash sequence as defined by Tcl's parsing rules. sl@0: * sl@0: * Results: sl@0: * Records at readPtr the number of bytes making up the backslash sl@0: * sequence. Records at dst the UTF-8 encoded equivalent of sl@0: * that backslash sequence. Returns the number of bytes written sl@0: * to dst, at most TCL_UTF_MAX. Either readPtr or dst may be sl@0: * NULL, if the results are not needed, but the return value is sl@0: * the same either way. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: int sl@0: TclParseBackslash(src, numBytes, readPtr, dst) sl@0: CONST char * src; /* Points to the backslash character of a sl@0: * a backslash sequence */ sl@0: int numBytes; /* Max number of bytes to scan */ sl@0: int *readPtr; /* NULL, or points to storage where the sl@0: * number of bytes scanned should be written. */ sl@0: char *dst; /* NULL, or points to buffer where the UTF-8 sl@0: * encoding of the backslash sequence is to be sl@0: * written. At most TCL_UTF_MAX bytes will be sl@0: * written there. */ sl@0: { sl@0: register CONST char *p = src+1; sl@0: Tcl_UniChar result; sl@0: int count; sl@0: char buf[TCL_UTF_MAX]; sl@0: sl@0: if (numBytes == 0) { sl@0: if (readPtr != NULL) { sl@0: *readPtr = 0; sl@0: } sl@0: return 0; sl@0: } sl@0: sl@0: if (dst == NULL) { sl@0: dst = buf; sl@0: } sl@0: sl@0: if (numBytes == 1) { sl@0: /* Can only scan the backslash. Return it. */ sl@0: result = '\\'; sl@0: count = 1; sl@0: goto done; sl@0: } sl@0: sl@0: count = 2; sl@0: switch (*p) { sl@0: /* sl@0: * Note: in the conversions below, use absolute values (e.g., sl@0: * 0xa) rather than symbolic values (e.g. \n) that get converted sl@0: * by the compiler. It's possible that compilers on some sl@0: * platforms will do the symbolic conversions differently, which sl@0: * could result in non-portable Tcl scripts. sl@0: */ sl@0: sl@0: case 'a': sl@0: result = 0x7; sl@0: break; sl@0: case 'b': sl@0: result = 0x8; sl@0: break; sl@0: case 'f': sl@0: result = 0xc; sl@0: break; sl@0: case 'n': sl@0: result = 0xa; sl@0: break; sl@0: case 'r': sl@0: result = 0xd; sl@0: break; sl@0: case 't': sl@0: result = 0x9; sl@0: break; sl@0: case 'v': sl@0: result = 0xb; sl@0: break; sl@0: case 'x': sl@0: count += TclParseHex(p+1, numBytes-1, &result); sl@0: if (count == 2) { sl@0: /* No hexadigits -> This is just "x". */ sl@0: result = 'x'; sl@0: } else { sl@0: /* Keep only the last byte (2 hex digits) */ sl@0: result = (unsigned char) result; sl@0: } sl@0: break; sl@0: case 'u': sl@0: count += TclParseHex(p+1, (numBytes > 5) ? 4 : numBytes-1, &result); sl@0: if (count == 2) { sl@0: /* No hexadigits -> This is just "u". */ sl@0: result = 'u'; sl@0: } sl@0: break; sl@0: case '\n': sl@0: count--; sl@0: do { sl@0: p++; count++; sl@0: } while ((count < numBytes) && ((*p == ' ') || (*p == '\t'))); sl@0: result = ' '; sl@0: break; sl@0: case 0: sl@0: result = '\\'; sl@0: count = 1; sl@0: break; sl@0: default: sl@0: /* sl@0: * Check for an octal number \oo?o? sl@0: */ sl@0: if (isdigit(UCHAR(*p)) && (UCHAR(*p) < '8')) { /* INTL: digit */ sl@0: result = (unsigned char)(*p - '0'); sl@0: p++; sl@0: if ((numBytes == 2) || !isdigit(UCHAR(*p)) /* INTL: digit */ sl@0: || (UCHAR(*p) >= '8')) { sl@0: break; sl@0: } sl@0: count = 3; sl@0: result = (unsigned char)((result << 3) + (*p - '0')); sl@0: p++; sl@0: if ((numBytes == 3) || !isdigit(UCHAR(*p)) /* INTL: digit */ sl@0: || (UCHAR(*p) >= '8')) { sl@0: break; sl@0: } sl@0: count = 4; sl@0: result = (unsigned char)((result << 3) + (*p - '0')); sl@0: break; sl@0: } sl@0: /* sl@0: * We have to convert here in case the user has put a sl@0: * backslash in front of a multi-byte utf-8 character. sl@0: * While this means nothing special, we shouldn't break up sl@0: * a correct utf-8 character. [Bug #217987] test subst-3.2 sl@0: */ sl@0: if (Tcl_UtfCharComplete(p, numBytes - 1)) { sl@0: count = Tcl_UtfToUniChar(p, &result) + 1; /* +1 for '\' */ sl@0: } else { sl@0: char utfBytes[TCL_UTF_MAX]; sl@0: memcpy(utfBytes, p, (size_t) (numBytes - 1)); sl@0: utfBytes[numBytes - 1] = '\0'; sl@0: count = Tcl_UtfToUniChar(utfBytes, &result) + 1; sl@0: } sl@0: break; sl@0: } sl@0: sl@0: done: sl@0: if (readPtr != NULL) { sl@0: *readPtr = count; sl@0: } sl@0: return Tcl_UniCharToUtf((int) result, dst); sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * ParseComment -- sl@0: * sl@0: * Scans up to numBytes bytes starting at src, consuming a sl@0: * Tcl comment as defined by Tcl's parsing rules. sl@0: * sl@0: * Results: sl@0: * Records in parsePtr information about the parse. Returns the sl@0: * number of bytes consumed. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: static int sl@0: ParseComment(src, numBytes, parsePtr) sl@0: CONST char *src; /* First character to parse. */ sl@0: register int numBytes; /* Max number of bytes to scan. */ sl@0: Tcl_Parse *parsePtr; /* Information about parse in progress. sl@0: * Updated if parsing indicates sl@0: * an incomplete command. */ sl@0: { sl@0: register CONST char *p = src; sl@0: while (numBytes) { sl@0: char type; sl@0: int scanned; sl@0: do { sl@0: scanned = TclParseWhiteSpace(p, numBytes, parsePtr, &type); sl@0: p += scanned; numBytes -= scanned; sl@0: } while (numBytes && (*p == '\n') && (p++,numBytes--)); sl@0: if ((numBytes == 0) || (*p != '#')) { sl@0: break; sl@0: } sl@0: if (parsePtr->commentStart == NULL) { sl@0: parsePtr->commentStart = p; sl@0: } sl@0: while (numBytes) { sl@0: if (*p == '\\') { sl@0: scanned = TclParseWhiteSpace(p, numBytes, parsePtr, &type); sl@0: if (scanned) { sl@0: p += scanned; numBytes -= scanned; sl@0: } else { sl@0: /* sl@0: * General backslash substitution in comments isn't sl@0: * part of the formal spec, but test parse-15.47 sl@0: * and history indicate that it has been the de facto sl@0: * rule. Don't change it now. sl@0: */ sl@0: TclParseBackslash(p, numBytes, &scanned, NULL); sl@0: p += scanned; numBytes -= scanned; sl@0: } sl@0: } else { sl@0: p++; numBytes--; sl@0: if (p[-1] == '\n') { sl@0: break; sl@0: } sl@0: } sl@0: } sl@0: parsePtr->commentSize = p - parsePtr->commentStart; sl@0: } sl@0: return (p - src); sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * ParseTokens -- sl@0: * sl@0: * This procedure forms the heart of the Tcl parser. It parses one sl@0: * or more tokens from a string, up to a termination point sl@0: * specified by the caller. This procedure is used to parse sl@0: * unquoted command words (those not in quotes or braces), words in sl@0: * quotes, and array indices for variables. No more than numBytes sl@0: * bytes will be scanned. sl@0: * sl@0: * Results: sl@0: * Tokens are added to parsePtr and parsePtr->term is filled in sl@0: * with the address of the character that terminated the parse (the sl@0: * first one whose CHAR_TYPE matched mask or the character at sl@0: * parsePtr->end). The return value is TCL_OK if the parse sl@0: * completed successfully and TCL_ERROR otherwise. If a parse sl@0: * error occurs and parsePtr->interp isn't NULL, then an error sl@0: * message is left in the interpreter's result. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static int sl@0: ParseTokens(src, numBytes, mask, parsePtr) sl@0: register CONST char *src; /* First character to parse. */ sl@0: register int numBytes; /* Max number of bytes to scan. */ sl@0: int mask; /* Specifies when to stop parsing. The sl@0: * parse stops at the first unquoted sl@0: * character whose CHAR_TYPE contains sl@0: * any of the bits in mask. */ sl@0: Tcl_Parse *parsePtr; /* Information about parse in progress. sl@0: * Updated with additional tokens and sl@0: * termination information. */ sl@0: { sl@0: char type; sl@0: int originalTokens, varToken; sl@0: Tcl_Token *tokenPtr; sl@0: Tcl_Parse nested; sl@0: sl@0: /* sl@0: * Each iteration through the following loop adds one token of sl@0: * type TCL_TOKEN_TEXT, TCL_TOKEN_BS, TCL_TOKEN_COMMAND, or sl@0: * TCL_TOKEN_VARIABLE to parsePtr. For TCL_TOKEN_VARIABLE tokens, sl@0: * additional tokens are added for the parsed variable name. sl@0: */ sl@0: sl@0: originalTokens = parsePtr->numTokens; sl@0: while (numBytes && !((type = CHAR_TYPE(*src)) & mask)) { sl@0: if (parsePtr->numTokens == parsePtr->tokensAvailable) { sl@0: TclExpandTokenArray(parsePtr); sl@0: } sl@0: tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens]; sl@0: tokenPtr->start = src; sl@0: tokenPtr->numComponents = 0; sl@0: sl@0: if ((type & TYPE_SUBS) == 0) { sl@0: /* sl@0: * This is a simple range of characters. Scan to find the end sl@0: * of the range. sl@0: */ sl@0: sl@0: while ((++src, --numBytes) sl@0: && !(CHAR_TYPE(*src) & (mask | TYPE_SUBS))) { sl@0: /* empty loop */ sl@0: } sl@0: tokenPtr->type = TCL_TOKEN_TEXT; sl@0: tokenPtr->size = src - tokenPtr->start; sl@0: parsePtr->numTokens++; sl@0: } else if (*src == '$') { sl@0: /* sl@0: * This is a variable reference. Call Tcl_ParseVarName to do sl@0: * all the dirty work of parsing the name. sl@0: */ sl@0: sl@0: varToken = parsePtr->numTokens; sl@0: if (Tcl_ParseVarName(parsePtr->interp, src, numBytes, sl@0: parsePtr, 1) != TCL_OK) { sl@0: return TCL_ERROR; sl@0: } sl@0: src += parsePtr->tokenPtr[varToken].size; sl@0: numBytes -= parsePtr->tokenPtr[varToken].size; sl@0: } else if (*src == '[') { sl@0: /* sl@0: * Command substitution. Call Tcl_ParseCommand recursively sl@0: * (and repeatedly) to parse the nested command(s), then sl@0: * throw away the parse information. sl@0: */ sl@0: sl@0: src++; numBytes--; sl@0: while (1) { sl@0: if (Tcl_ParseCommand(parsePtr->interp, src, sl@0: numBytes, 1, &nested) != TCL_OK) { sl@0: parsePtr->errorType = nested.errorType; sl@0: parsePtr->term = nested.term; sl@0: parsePtr->incomplete = nested.incomplete; sl@0: return TCL_ERROR; sl@0: } sl@0: src = nested.commandStart + nested.commandSize; sl@0: numBytes = parsePtr->end - src; sl@0: sl@0: /* sl@0: * This is equivalent to Tcl_FreeParse(&nested), but sl@0: * presumably inlined here for sake of runtime optimization sl@0: */ sl@0: sl@0: if (nested.tokenPtr != nested.staticTokens) { sl@0: ckfree((char *) nested.tokenPtr); sl@0: } sl@0: sl@0: /* sl@0: * Check for the closing ']' that ends the command sl@0: * substitution. It must have been the last character of sl@0: * the parsed command. sl@0: */ sl@0: sl@0: if ((nested.term < parsePtr->end) && (*nested.term == ']') sl@0: && !nested.incomplete) { sl@0: break; sl@0: } sl@0: if (numBytes == 0) { sl@0: if (parsePtr->interp != NULL) { sl@0: Tcl_SetResult(parsePtr->interp, sl@0: "missing close-bracket", TCL_STATIC); sl@0: } sl@0: parsePtr->errorType = TCL_PARSE_MISSING_BRACKET; sl@0: parsePtr->term = tokenPtr->start; sl@0: parsePtr->incomplete = 1; sl@0: return TCL_ERROR; sl@0: } sl@0: } sl@0: tokenPtr->type = TCL_TOKEN_COMMAND; sl@0: tokenPtr->size = src - tokenPtr->start; sl@0: parsePtr->numTokens++; sl@0: } else if (*src == '\\') { sl@0: /* sl@0: * Backslash substitution. sl@0: */ sl@0: TclParseBackslash(src, numBytes, &tokenPtr->size, NULL); sl@0: sl@0: if (tokenPtr->size == 1) { sl@0: /* Just a backslash, due to end of string */ sl@0: tokenPtr->type = TCL_TOKEN_TEXT; sl@0: parsePtr->numTokens++; sl@0: src++; numBytes--; sl@0: continue; sl@0: } sl@0: sl@0: if (src[1] == '\n') { sl@0: if (numBytes == 2) { sl@0: parsePtr->incomplete = 1; sl@0: } sl@0: sl@0: /* sl@0: * Note: backslash-newline is special in that it is sl@0: * treated the same as a space character would be. This sl@0: * means that it could terminate the token. sl@0: */ sl@0: sl@0: if (mask & TYPE_SPACE) { sl@0: if (parsePtr->numTokens == originalTokens) { sl@0: goto finishToken; sl@0: } sl@0: break; sl@0: } sl@0: } sl@0: sl@0: tokenPtr->type = TCL_TOKEN_BS; sl@0: parsePtr->numTokens++; sl@0: src += tokenPtr->size; sl@0: numBytes -= tokenPtr->size; sl@0: } else if (*src == 0) { sl@0: tokenPtr->type = TCL_TOKEN_TEXT; sl@0: tokenPtr->size = 1; sl@0: parsePtr->numTokens++; sl@0: src++; numBytes--; sl@0: } else { sl@0: panic("ParseTokens encountered unknown character"); sl@0: } sl@0: } sl@0: if (parsePtr->numTokens == originalTokens) { sl@0: /* sl@0: * There was nothing in this range of text. Add an empty token sl@0: * for the empty range, so that there is always at least one sl@0: * token added. sl@0: */ sl@0: if (parsePtr->numTokens == parsePtr->tokensAvailable) { sl@0: TclExpandTokenArray(parsePtr); sl@0: } sl@0: tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens]; sl@0: tokenPtr->start = src; sl@0: tokenPtr->numComponents = 0; sl@0: sl@0: finishToken: sl@0: tokenPtr->type = TCL_TOKEN_TEXT; sl@0: tokenPtr->size = 0; sl@0: parsePtr->numTokens++; sl@0: } sl@0: parsePtr->term = src; sl@0: return TCL_OK; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_FreeParse -- sl@0: * sl@0: * This procedure is invoked to free any dynamic storage that may sl@0: * have been allocated by a previous call to Tcl_ParseCommand. sl@0: * sl@0: * Results: sl@0: * None. sl@0: * sl@0: * Side effects: sl@0: * If there is any dynamically allocated memory in *parsePtr, sl@0: * it is freed. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C void sl@0: Tcl_FreeParse(parsePtr) sl@0: Tcl_Parse *parsePtr; /* Structure that was filled in by a sl@0: * previous call to Tcl_ParseCommand. */ sl@0: { sl@0: if (parsePtr->tokenPtr != parsePtr->staticTokens) { sl@0: ckfree((char *) parsePtr->tokenPtr); sl@0: parsePtr->tokenPtr = parsePtr->staticTokens; sl@0: } sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * TclExpandTokenArray -- sl@0: * sl@0: * This procedure is invoked when the current space for tokens in sl@0: * a Tcl_Parse structure fills up; it allocates memory to grow the sl@0: * token array sl@0: * sl@0: * Results: sl@0: * None. sl@0: * sl@0: * Side effects: sl@0: * Memory is allocated for a new larger token array; the memory sl@0: * for the old array is freed, if it had been dynamically allocated. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: void sl@0: TclExpandTokenArray(parsePtr) sl@0: Tcl_Parse *parsePtr; /* Parse structure whose token space sl@0: * has overflowed. */ sl@0: { sl@0: int newCount; sl@0: Tcl_Token *newPtr; sl@0: sl@0: newCount = parsePtr->tokensAvailable*2; sl@0: newPtr = (Tcl_Token *) ckalloc((unsigned) (newCount * sizeof(Tcl_Token))); sl@0: memcpy((VOID *) newPtr, (VOID *) parsePtr->tokenPtr, sl@0: (size_t) (parsePtr->tokensAvailable * sizeof(Tcl_Token))); sl@0: if (parsePtr->tokenPtr != parsePtr->staticTokens) { sl@0: ckfree((char *) parsePtr->tokenPtr); sl@0: } sl@0: parsePtr->tokenPtr = newPtr; sl@0: parsePtr->tokensAvailable = newCount; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_ParseVarName -- sl@0: * sl@0: * Given a string starting with a $ sign, parse off a variable sl@0: * name and return information about the parse. No more than sl@0: * numBytes bytes will be scanned. sl@0: * sl@0: * Results: sl@0: * The return value is TCL_OK if the command was parsed sl@0: * successfully and TCL_ERROR otherwise. If an error occurs and sl@0: * interp isn't NULL then an error message is left in its result. sl@0: * On a successful return, tokenPtr and numTokens fields of sl@0: * parsePtr are filled in with information about the variable name sl@0: * that was parsed. The "size" field of the first new token gives sl@0: * the total number of bytes in the variable name. Other fields in sl@0: * parsePtr are undefined. sl@0: * sl@0: * Side effects: sl@0: * If there is insufficient space in parsePtr to hold all the sl@0: * information about the command, then additional space is sl@0: * malloc-ed. If the procedure returns TCL_OK then the caller must sl@0: * eventually invoke Tcl_FreeParse to release any additional space sl@0: * that was allocated. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C int sl@0: Tcl_ParseVarName(interp, string, numBytes, parsePtr, append) sl@0: Tcl_Interp *interp; /* Interpreter to use for error reporting; sl@0: * if NULL, then no error message is sl@0: * provided. */ sl@0: CONST char *string; /* String containing variable name. First sl@0: * character must be "$". */ sl@0: register int numBytes; /* Total number of bytes in string. If < 0, sl@0: * the string consists of all bytes up to the sl@0: * first null character. */ sl@0: Tcl_Parse *parsePtr; /* Structure to fill in with information sl@0: * about the variable name. */ sl@0: int append; /* Non-zero means append tokens to existing sl@0: * information in parsePtr; zero means ignore sl@0: * existing tokens in parsePtr and reinitialize sl@0: * it. */ sl@0: { sl@0: Tcl_Token *tokenPtr; sl@0: register CONST char *src; sl@0: unsigned char c; sl@0: int varIndex, offset; sl@0: Tcl_UniChar ch; sl@0: unsigned array; sl@0: sl@0: if ((numBytes == 0) || (string == NULL)) { sl@0: return TCL_ERROR; sl@0: } sl@0: if (numBytes < 0) { sl@0: numBytes = strlen(string); sl@0: } sl@0: sl@0: if (!append) { sl@0: parsePtr->numWords = 0; sl@0: parsePtr->tokenPtr = parsePtr->staticTokens; sl@0: parsePtr->numTokens = 0; sl@0: parsePtr->tokensAvailable = NUM_STATIC_TOKENS; sl@0: parsePtr->string = string; sl@0: parsePtr->end = (string + numBytes); sl@0: parsePtr->interp = interp; sl@0: parsePtr->errorType = TCL_PARSE_SUCCESS; sl@0: parsePtr->incomplete = 0; sl@0: } sl@0: sl@0: /* sl@0: * Generate one token for the variable, an additional token for the sl@0: * name, plus any number of additional tokens for the index, if sl@0: * there is one. sl@0: */ sl@0: sl@0: src = string; sl@0: if ((parsePtr->numTokens + 2) > parsePtr->tokensAvailable) { sl@0: TclExpandTokenArray(parsePtr); sl@0: } sl@0: tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens]; sl@0: tokenPtr->type = TCL_TOKEN_VARIABLE; sl@0: tokenPtr->start = src; sl@0: varIndex = parsePtr->numTokens; sl@0: parsePtr->numTokens++; sl@0: tokenPtr++; sl@0: src++; numBytes--; sl@0: if (numBytes == 0) { sl@0: goto justADollarSign; sl@0: } sl@0: tokenPtr->type = TCL_TOKEN_TEXT; sl@0: tokenPtr->start = src; sl@0: tokenPtr->numComponents = 0; sl@0: sl@0: /* sl@0: * The name of the variable can have three forms: sl@0: * 1. The $ sign is followed by an open curly brace. Then sl@0: * the variable name is everything up to the next close sl@0: * curly brace, and the variable is a scalar variable. sl@0: * 2. The $ sign is not followed by an open curly brace. Then sl@0: * the variable name is everything up to the next sl@0: * character that isn't a letter, digit, or underscore. sl@0: * :: sequences are also considered part of the variable sl@0: * name, in order to support namespaces. If the following sl@0: * character is an open parenthesis, then the information sl@0: * between parentheses is the array element name. sl@0: * 3. The $ sign is followed by something that isn't a letter, sl@0: * digit, or underscore: in this case, there is no variable sl@0: * name and the token is just "$". sl@0: */ sl@0: sl@0: if (*src == '{') { sl@0: src++; numBytes--; sl@0: tokenPtr->type = TCL_TOKEN_TEXT; sl@0: tokenPtr->start = src; sl@0: tokenPtr->numComponents = 0; sl@0: sl@0: while (numBytes && (*src != '}')) { sl@0: numBytes--; src++; sl@0: } sl@0: if (numBytes == 0) { sl@0: if (interp != NULL) { sl@0: Tcl_SetResult(interp, "missing close-brace for variable name", sl@0: TCL_STATIC); sl@0: } sl@0: parsePtr->errorType = TCL_PARSE_MISSING_VAR_BRACE; sl@0: parsePtr->term = tokenPtr->start-1; sl@0: parsePtr->incomplete = 1; sl@0: goto error; sl@0: } sl@0: tokenPtr->size = src - tokenPtr->start; sl@0: tokenPtr[-1].size = src - tokenPtr[-1].start; sl@0: parsePtr->numTokens++; sl@0: src++; sl@0: } else { sl@0: tokenPtr->type = TCL_TOKEN_TEXT; sl@0: tokenPtr->start = src; sl@0: tokenPtr->numComponents = 0; sl@0: while (numBytes) { sl@0: if (Tcl_UtfCharComplete(src, numBytes)) { sl@0: offset = Tcl_UtfToUniChar(src, &ch); sl@0: } else { sl@0: char utfBytes[TCL_UTF_MAX]; sl@0: memcpy(utfBytes, src, (size_t) numBytes); sl@0: utfBytes[numBytes] = '\0'; sl@0: offset = Tcl_UtfToUniChar(utfBytes, &ch); sl@0: } sl@0: c = UCHAR(ch); sl@0: if (isalnum(c) || (c == '_')) { /* INTL: ISO only, UCHAR. */ sl@0: src += offset; numBytes -= offset; sl@0: continue; sl@0: } sl@0: if ((c == ':') && (numBytes != 1) && (src[1] == ':')) { sl@0: src += 2; numBytes -= 2; sl@0: while (numBytes && (*src == ':')) { sl@0: src++; numBytes--; sl@0: } sl@0: continue; sl@0: } sl@0: break; sl@0: } sl@0: sl@0: /* sl@0: * Support for empty array names here. sl@0: */ sl@0: array = (numBytes && (*src == '(')); sl@0: tokenPtr->size = src - tokenPtr->start; sl@0: if ((tokenPtr->size == 0) && !array) { sl@0: goto justADollarSign; sl@0: } sl@0: parsePtr->numTokens++; sl@0: if (array) { sl@0: /* sl@0: * This is a reference to an array element. Call sl@0: * ParseTokens recursively to parse the element name, sl@0: * since it could contain any number of substitutions. sl@0: */ sl@0: sl@0: if (ParseTokens(src+1, numBytes-1, TYPE_CLOSE_PAREN, parsePtr) sl@0: != TCL_OK) { sl@0: goto error; sl@0: } sl@0: if ((parsePtr->term == (src + numBytes)) sl@0: || (*parsePtr->term != ')')) { sl@0: if (parsePtr->interp != NULL) { sl@0: Tcl_SetResult(parsePtr->interp, "missing )", sl@0: TCL_STATIC); sl@0: } sl@0: parsePtr->errorType = TCL_PARSE_MISSING_PAREN; sl@0: parsePtr->term = src; sl@0: parsePtr->incomplete = 1; sl@0: goto error; sl@0: } sl@0: src = parsePtr->term + 1; sl@0: } sl@0: } sl@0: tokenPtr = &parsePtr->tokenPtr[varIndex]; sl@0: tokenPtr->size = src - tokenPtr->start; sl@0: tokenPtr->numComponents = parsePtr->numTokens - (varIndex + 1); sl@0: return TCL_OK; sl@0: sl@0: /* sl@0: * The dollar sign isn't followed by a variable name. sl@0: * replace the TCL_TOKEN_VARIABLE token with a sl@0: * TCL_TOKEN_TEXT token for the dollar sign. sl@0: */ sl@0: sl@0: justADollarSign: sl@0: tokenPtr = &parsePtr->tokenPtr[varIndex]; sl@0: tokenPtr->type = TCL_TOKEN_TEXT; sl@0: tokenPtr->size = 1; sl@0: tokenPtr->numComponents = 0; sl@0: return TCL_OK; sl@0: sl@0: error: sl@0: Tcl_FreeParse(parsePtr); sl@0: return TCL_ERROR; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_ParseVar -- sl@0: * sl@0: * Given a string starting with a $ sign, parse off a variable sl@0: * name and return its value. sl@0: * sl@0: * Results: sl@0: * The return value is the contents of the variable given by sl@0: * the leading characters of string. If termPtr isn't NULL, sl@0: * *termPtr gets filled in with the address of the character sl@0: * just after the last one in the variable specifier. If the sl@0: * variable doesn't exist, then the return value is NULL and sl@0: * an error message will be left in interp's result. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C CONST char * sl@0: Tcl_ParseVar(interp, string, termPtr) sl@0: Tcl_Interp *interp; /* Context for looking up variable. */ sl@0: register CONST char *string; /* String containing variable name. sl@0: * First character must be "$". */ sl@0: CONST char **termPtr; /* If non-NULL, points to word to fill sl@0: * in with character just after last sl@0: * one in the variable specifier. */ sl@0: sl@0: { sl@0: Tcl_Parse parse; sl@0: register Tcl_Obj *objPtr; sl@0: int code; sl@0: sl@0: if (Tcl_ParseVarName(interp, string, -1, &parse, 0) != TCL_OK) { sl@0: return NULL; sl@0: } sl@0: sl@0: if (termPtr != NULL) { sl@0: *termPtr = string + parse.tokenPtr->size; sl@0: } sl@0: if (parse.numTokens == 1) { sl@0: /* sl@0: * There isn't a variable name after all: the $ is just a $. sl@0: */ sl@0: sl@0: return "$"; sl@0: } sl@0: sl@0: code = Tcl_EvalTokensStandard(interp, parse.tokenPtr, parse.numTokens); sl@0: if (code != TCL_OK) { sl@0: return NULL; sl@0: } sl@0: objPtr = Tcl_GetObjResult(interp); sl@0: sl@0: /* sl@0: * At this point we should have an object containing the value of sl@0: * a variable. Just return the string from that object. sl@0: * sl@0: * This should have returned the object for the user to manage, but sl@0: * instead we have some weak reference to the string value in the sl@0: * object, which is why we make sure the object exists after resetting sl@0: * the result. This isn't ideal, but it's the best we can do with the sl@0: * current documented interface. -- hobbs sl@0: */ sl@0: sl@0: if (!Tcl_IsShared(objPtr)) { sl@0: Tcl_IncrRefCount(objPtr); sl@0: } sl@0: Tcl_ResetResult(interp); sl@0: return TclGetString(objPtr); sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_ParseBraces -- sl@0: * sl@0: * Given a string in braces such as a Tcl command argument or a string sl@0: * value in a Tcl expression, this procedure parses the string and sl@0: * returns information about the parse. No more than numBytes bytes sl@0: * will be scanned. sl@0: * sl@0: * Results: sl@0: * The return value is TCL_OK if the string was parsed successfully and sl@0: * TCL_ERROR otherwise. If an error occurs and interp isn't NULL then sl@0: * an error message is left in its result. On a successful return, sl@0: * tokenPtr and numTokens fields of parsePtr are filled in with sl@0: * information about the string that was parsed. Other fields in sl@0: * parsePtr are undefined. termPtr is set to point to the character sl@0: * just after the last one in the braced string. sl@0: * sl@0: * Side effects: sl@0: * If there is insufficient space in parsePtr to hold all the sl@0: * information about the command, then additional space is sl@0: * malloc-ed. If the procedure returns TCL_OK then the caller must sl@0: * eventually invoke Tcl_FreeParse to release any additional space sl@0: * that was allocated. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C int sl@0: Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr) sl@0: Tcl_Interp *interp; /* Interpreter to use for error reporting; sl@0: * if NULL, then no error message is sl@0: * provided. */ sl@0: CONST char *string; /* String containing the string in braces. sl@0: * The first character must be '{'. */ sl@0: register int numBytes; /* Total number of bytes in string. If < 0, sl@0: * the string consists of all bytes up to sl@0: * the first null character. */ sl@0: register Tcl_Parse *parsePtr; sl@0: /* Structure to fill in with information sl@0: * about the string. */ sl@0: int append; /* Non-zero means append tokens to existing sl@0: * information in parsePtr; zero means sl@0: * ignore existing tokens in parsePtr and sl@0: * reinitialize it. */ sl@0: CONST char **termPtr; /* If non-NULL, points to word in which to sl@0: * store a pointer to the character just sl@0: * after the terminating '}' if the parse sl@0: * was successful. */ sl@0: sl@0: { sl@0: Tcl_Token *tokenPtr; sl@0: register CONST char *src; sl@0: int startIndex, level, length; sl@0: sl@0: if ((numBytes == 0) || (string == NULL)) { sl@0: return TCL_ERROR; sl@0: } sl@0: if (numBytes < 0) { sl@0: numBytes = strlen(string); sl@0: } sl@0: sl@0: if (!append) { sl@0: parsePtr->numWords = 0; sl@0: parsePtr->tokenPtr = parsePtr->staticTokens; sl@0: parsePtr->numTokens = 0; sl@0: parsePtr->tokensAvailable = NUM_STATIC_TOKENS; sl@0: parsePtr->string = string; sl@0: parsePtr->end = (string + numBytes); sl@0: parsePtr->interp = interp; sl@0: parsePtr->errorType = TCL_PARSE_SUCCESS; sl@0: } sl@0: sl@0: src = string; sl@0: startIndex = parsePtr->numTokens; sl@0: sl@0: if (parsePtr->numTokens == parsePtr->tokensAvailable) { sl@0: TclExpandTokenArray(parsePtr); sl@0: } sl@0: tokenPtr = &parsePtr->tokenPtr[startIndex]; sl@0: tokenPtr->type = TCL_TOKEN_TEXT; sl@0: tokenPtr->start = src+1; sl@0: tokenPtr->numComponents = 0; sl@0: level = 1; sl@0: while (1) { sl@0: while (++src, --numBytes) { sl@0: if (CHAR_TYPE(*src) != TYPE_NORMAL) { sl@0: break; sl@0: } sl@0: } sl@0: if (numBytes == 0) { sl@0: register int openBrace = 0; sl@0: sl@0: parsePtr->errorType = TCL_PARSE_MISSING_BRACE; sl@0: parsePtr->term = string; sl@0: parsePtr->incomplete = 1; sl@0: if (interp == NULL) { sl@0: /* sl@0: * Skip straight to the exit code since we have no sl@0: * interpreter to put error message in. sl@0: */ sl@0: goto error; sl@0: } sl@0: sl@0: Tcl_SetResult(interp, "missing close-brace", TCL_STATIC); sl@0: sl@0: /* sl@0: * Guess if the problem is due to comments by searching sl@0: * the source string for a possible open brace within the sl@0: * context of a comment. Since we aren't performing a sl@0: * full Tcl parse, just look for an open brace preceded sl@0: * by a '#' on the same line. sl@0: */ sl@0: sl@0: for (; src > string; src--) { sl@0: switch (*src) { sl@0: case '{': sl@0: openBrace = 1; sl@0: break; sl@0: case '\n': sl@0: openBrace = 0; sl@0: break; sl@0: case '#' : sl@0: if (openBrace && (isspace(UCHAR(src[-1])))) { sl@0: Tcl_AppendResult(interp, sl@0: ": possible unbalanced brace in comment", sl@0: (char *) NULL); sl@0: goto error; sl@0: } sl@0: break; sl@0: } sl@0: } sl@0: sl@0: error: sl@0: Tcl_FreeParse(parsePtr); sl@0: return TCL_ERROR; sl@0: } sl@0: switch (*src) { sl@0: case '{': sl@0: level++; sl@0: break; sl@0: case '}': sl@0: if (--level == 0) { sl@0: sl@0: /* sl@0: * Decide if we need to finish emitting a sl@0: * partially-finished token. There are 3 cases: sl@0: * {abc \newline xyz} or {xyz} sl@0: * - finish emitting "xyz" token sl@0: * {abc \newline} sl@0: * - don't emit token after \newline sl@0: * {} - finish emitting zero-sized token sl@0: * sl@0: * The last case ensures that there is a token sl@0: * (even if empty) that describes the braced string. sl@0: */ sl@0: sl@0: if ((src != tokenPtr->start) sl@0: || (parsePtr->numTokens == startIndex)) { sl@0: tokenPtr->size = (src - tokenPtr->start); sl@0: parsePtr->numTokens++; sl@0: } sl@0: if (termPtr != NULL) { sl@0: *termPtr = src+1; sl@0: } sl@0: return TCL_OK; sl@0: } sl@0: break; sl@0: case '\\': sl@0: TclParseBackslash(src, numBytes, &length, NULL); sl@0: if ((length > 1) && (src[1] == '\n')) { sl@0: /* sl@0: * A backslash-newline sequence must be collapsed, even sl@0: * inside braces, so we have to split the word into sl@0: * multiple tokens so that the backslash-newline can be sl@0: * represented explicitly. sl@0: */ sl@0: sl@0: if (numBytes == 2) { sl@0: parsePtr->incomplete = 1; sl@0: } sl@0: tokenPtr->size = (src - tokenPtr->start); sl@0: if (tokenPtr->size != 0) { sl@0: parsePtr->numTokens++; sl@0: } sl@0: if ((parsePtr->numTokens+1) >= parsePtr->tokensAvailable) { sl@0: TclExpandTokenArray(parsePtr); sl@0: } sl@0: tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens]; sl@0: tokenPtr->type = TCL_TOKEN_BS; sl@0: tokenPtr->start = src; sl@0: tokenPtr->size = length; sl@0: tokenPtr->numComponents = 0; sl@0: parsePtr->numTokens++; sl@0: sl@0: src += length - 1; sl@0: numBytes -= length - 1; sl@0: tokenPtr++; sl@0: tokenPtr->type = TCL_TOKEN_TEXT; sl@0: tokenPtr->start = src + 1; sl@0: tokenPtr->numComponents = 0; sl@0: } else { sl@0: src += length - 1; sl@0: numBytes -= length - 1; sl@0: } sl@0: break; sl@0: } sl@0: } sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_ParseQuotedString -- sl@0: * sl@0: * Given a double-quoted string such as a quoted Tcl command argument sl@0: * or a quoted value in a Tcl expression, this procedure parses the sl@0: * string and returns information about the parse. No more than sl@0: * numBytes bytes will be scanned. sl@0: * sl@0: * Results: sl@0: * The return value is TCL_OK if the string was parsed successfully and sl@0: * TCL_ERROR otherwise. If an error occurs and interp isn't NULL then sl@0: * an error message is left in its result. On a successful return, sl@0: * tokenPtr and numTokens fields of parsePtr are filled in with sl@0: * information about the string that was parsed. Other fields in sl@0: * parsePtr are undefined. termPtr is set to point to the character sl@0: * just after the quoted string's terminating close-quote. sl@0: * sl@0: * Side effects: sl@0: * If there is insufficient space in parsePtr to hold all the sl@0: * information about the command, then additional space is sl@0: * malloc-ed. If the procedure returns TCL_OK then the caller must sl@0: * eventually invoke Tcl_FreeParse to release any additional space sl@0: * that was allocated. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C int sl@0: Tcl_ParseQuotedString(interp, string, numBytes, parsePtr, append, termPtr) sl@0: Tcl_Interp *interp; /* Interpreter to use for error reporting; sl@0: * if NULL, then no error message is sl@0: * provided. */ sl@0: CONST char *string; /* String containing the quoted string. sl@0: * The first character must be '"'. */ sl@0: register int numBytes; /* Total number of bytes in string. If < 0, sl@0: * the string consists of all bytes up to sl@0: * the first null character. */ sl@0: register Tcl_Parse *parsePtr; sl@0: /* Structure to fill in with information sl@0: * about the string. */ sl@0: int append; /* Non-zero means append tokens to existing sl@0: * information in parsePtr; zero means sl@0: * ignore existing tokens in parsePtr and sl@0: * reinitialize it. */ sl@0: CONST char **termPtr; /* If non-NULL, points to word in which to sl@0: * store a pointer to the character just sl@0: * after the quoted string's terminating sl@0: * close-quote if the parse succeeds. */ sl@0: { sl@0: if ((numBytes == 0) || (string == NULL)) { sl@0: return TCL_ERROR; sl@0: } sl@0: if (numBytes < 0) { sl@0: numBytes = strlen(string); sl@0: } sl@0: sl@0: if (!append) { sl@0: parsePtr->numWords = 0; sl@0: parsePtr->tokenPtr = parsePtr->staticTokens; sl@0: parsePtr->numTokens = 0; sl@0: parsePtr->tokensAvailable = NUM_STATIC_TOKENS; sl@0: parsePtr->string = string; sl@0: parsePtr->end = (string + numBytes); sl@0: parsePtr->interp = interp; sl@0: parsePtr->errorType = TCL_PARSE_SUCCESS; sl@0: } sl@0: sl@0: if (ParseTokens(string+1, numBytes-1, TYPE_QUOTE, parsePtr) != TCL_OK) { sl@0: goto error; sl@0: } sl@0: if (*parsePtr->term != '"') { sl@0: if (interp != NULL) { sl@0: Tcl_SetResult(parsePtr->interp, "missing \"", TCL_STATIC); sl@0: } sl@0: parsePtr->errorType = TCL_PARSE_MISSING_QUOTE; sl@0: parsePtr->term = string; sl@0: parsePtr->incomplete = 1; sl@0: goto error; sl@0: } sl@0: if (termPtr != NULL) { sl@0: *termPtr = (parsePtr->term + 1); sl@0: } sl@0: return TCL_OK; sl@0: sl@0: error: sl@0: Tcl_FreeParse(parsePtr); sl@0: return TCL_ERROR; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * CommandComplete -- sl@0: * sl@0: * This procedure is shared by TclCommandComplete and sl@0: * Tcl_ObjCommandcoComplete; it does all the real work of seeing sl@0: * whether a script is complete sl@0: * sl@0: * Results: sl@0: * 1 is returned if the script is complete, 0 if there are open sl@0: * delimiters such as " or (. 1 is also returned if there is a sl@0: * parse error in the script other than unmatched delimiters. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: static int sl@0: CommandComplete(script, numBytes) sl@0: CONST char *script; /* Script to check. */ sl@0: int numBytes; /* Number of bytes in script. */ sl@0: { sl@0: Tcl_Parse parse; sl@0: CONST char *p, *end; sl@0: int result; sl@0: sl@0: p = script; sl@0: end = p + numBytes; sl@0: while (Tcl_ParseCommand((Tcl_Interp *) NULL, p, end - p, 0, &parse) sl@0: == TCL_OK) { sl@0: p = parse.commandStart + parse.commandSize; sl@0: if (p >= end) { sl@0: break; sl@0: } sl@0: Tcl_FreeParse(&parse); sl@0: } sl@0: if (parse.incomplete) { sl@0: result = 0; sl@0: } else { sl@0: result = 1; sl@0: } sl@0: Tcl_FreeParse(&parse); sl@0: return result; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * Tcl_CommandComplete -- sl@0: * sl@0: * Given a partial or complete Tcl script, this procedure sl@0: * determines whether the script is complete in the sense sl@0: * of having matched braces and quotes and brackets. sl@0: * sl@0: * Results: sl@0: * 1 is returned if the script is complete, 0 otherwise. sl@0: * 1 is also returned if there is a parse error in the script sl@0: * other than unmatched delimiters. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: EXPORT_C int sl@0: Tcl_CommandComplete(script) sl@0: CONST char *script; /* Script to check. */ sl@0: { sl@0: return CommandComplete(script, (int) strlen(script)); sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * TclObjCommandComplete -- sl@0: * sl@0: * Given a partial or complete Tcl command in a Tcl object, this sl@0: * procedure determines whether the command is complete in the sense of sl@0: * having matched braces and quotes and brackets. sl@0: * sl@0: * Results: sl@0: * 1 is returned if the command is complete, 0 otherwise. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: int sl@0: TclObjCommandComplete(objPtr) sl@0: Tcl_Obj *objPtr; /* Points to object holding script sl@0: * to check. */ sl@0: { sl@0: CONST char *script; sl@0: int length; sl@0: sl@0: script = Tcl_GetStringFromObj(objPtr, &length); sl@0: return CommandComplete(script, length); sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * TclIsLocalScalar -- sl@0: * sl@0: * Check to see if a given string is a legal scalar variable sl@0: * name with no namespace qualifiers or substitutions. sl@0: * sl@0: * Results: sl@0: * Returns 1 if the variable is a local scalar. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: int sl@0: TclIsLocalScalar(src, len) sl@0: CONST char *src; sl@0: int len; sl@0: { sl@0: CONST char *p; sl@0: CONST char *lastChar = src + (len - 1); sl@0: sl@0: for (p = src; p <= lastChar; p++) { sl@0: if ((CHAR_TYPE(*p) != TYPE_NORMAL) && sl@0: (CHAR_TYPE(*p) != TYPE_COMMAND_END)) { sl@0: /* sl@0: * TCL_COMMAND_END is returned for the last character sl@0: * of the string. By this point we know it isn't sl@0: * an array or namespace reference. sl@0: */ sl@0: sl@0: return 0; sl@0: } sl@0: if (*p == '(') { sl@0: if (*lastChar == ')') { /* we have an array element */ sl@0: return 0; sl@0: } sl@0: } else if (*p == ':') { sl@0: if ((p != lastChar) && *(p+1) == ':') { /* qualified name */ sl@0: return 0; sl@0: } sl@0: } sl@0: } sl@0: sl@0: return 1; sl@0: }