os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/generic/tclParse.c
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/generic/tclParse.c Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,1785 @@
1.4 +/*
1.5 + * tclParse.c --
1.6 + *
1.7 + * This file contains procedures that parse Tcl scripts. They
1.8 + * do so in a general-purpose fashion that can be used for many
1.9 + * different purposes, including compilation, direct execution,
1.10 + * code analysis, etc.
1.11 + *
1.12 + * Copyright (c) 1997 Sun Microsystems, Inc.
1.13 + * Copyright (c) 1998-2000 Ajuba Solutions.
1.14 + * Portions Copyright (c) 2007-2008 Nokia Corporation and/or its subsidiaries. All rights reserved.
1.15 + * Contributions from Don Porter, NIST, 2002. (not subject to US copyright)
1.16 + *
1.17 + * See the file "license.terms" for information on usage and redistribution
1.18 + * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.19 + *
1.20 + * RCS: @(#) $Id: tclParse.c,v 1.25.2.1 2006/09/24 21:15:10 msofer Exp $
1.21 + */
1.22 +
1.23 +#include "tclInt.h"
1.24 +#include "tclPort.h"
1.25 +
1.26 +/*
1.27 + * The following table provides parsing information about each possible
1.28 + * 8-bit character. The table is designed to be referenced with either
1.29 + * signed or unsigned characters, so it has 384 entries. The first 128
1.30 + * entries correspond to negative character values, the next 256 correspond
1.31 + * to positive character values. The last 128 entries are identical to the
1.32 + * first 128. The table is always indexed with a 128-byte offset (the 128th
1.33 + * entry corresponds to a character value of 0).
1.34 + *
1.35 + * The macro CHAR_TYPE is used to index into the table and return
1.36 + * information about its character argument. The following return
1.37 + * values are defined.
1.38 + *
1.39 + * TYPE_NORMAL - All characters that don't have special significance
1.40 + * to the Tcl parser.
1.41 + * TYPE_SPACE - The character is a whitespace character other
1.42 + * than newline.
1.43 + * TYPE_COMMAND_END - Character is newline or semicolon.
1.44 + * TYPE_SUBS - Character begins a substitution or has other
1.45 + * special meaning in ParseTokens: backslash, dollar
1.46 + * sign, or open bracket.
1.47 + * TYPE_QUOTE - Character is a double quote.
1.48 + * TYPE_CLOSE_PAREN - Character is a right parenthesis.
1.49 + * TYPE_CLOSE_BRACK - Character is a right square bracket.
1.50 + * TYPE_BRACE - Character is a curly brace (either left or right).
1.51 + */
1.52 +
1.53 +#define TYPE_NORMAL 0
1.54 +#define TYPE_SPACE 0x1
1.55 +#define TYPE_COMMAND_END 0x2
1.56 +#define TYPE_SUBS 0x4
1.57 +#define TYPE_QUOTE 0x8
1.58 +#define TYPE_CLOSE_PAREN 0x10
1.59 +#define TYPE_CLOSE_BRACK 0x20
1.60 +#define TYPE_BRACE 0x40
1.61 +
1.62 +#define CHAR_TYPE(c) (charTypeTable+128)[(int)(c)]
1.63 +
1.64 +static CONST char charTypeTable[] = {
1.65 + /*
1.66 + * Negative character values, from -128 to -1:
1.67 + */
1.68 +
1.69 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.70 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.71 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.72 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.73 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.74 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.75 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.76 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.77 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.78 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.79 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.80 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.81 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.82 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.83 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.84 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.85 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.86 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.87 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.88 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.89 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.90 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.91 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.92 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.93 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.94 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.95 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.96 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.97 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.98 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.99 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.100 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.101 +
1.102 + /*
1.103 + * Positive character values, from 0-127:
1.104 + */
1.105 +
1.106 + TYPE_SUBS, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.107 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.108 + TYPE_NORMAL, TYPE_SPACE, TYPE_COMMAND_END, TYPE_SPACE,
1.109 + TYPE_SPACE, TYPE_SPACE, TYPE_NORMAL, TYPE_NORMAL,
1.110 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.111 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.112 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.113 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.114 + TYPE_SPACE, TYPE_NORMAL, TYPE_QUOTE, TYPE_NORMAL,
1.115 + TYPE_SUBS, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.116 + TYPE_NORMAL, TYPE_CLOSE_PAREN, TYPE_NORMAL, TYPE_NORMAL,
1.117 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.118 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.119 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.120 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_COMMAND_END,
1.121 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.122 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.123 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.124 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.125 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.126 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.127 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.128 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_SUBS,
1.129 + TYPE_SUBS, TYPE_CLOSE_BRACK, TYPE_NORMAL, TYPE_NORMAL,
1.130 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.131 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.132 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.133 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.134 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.135 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.136 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_BRACE,
1.137 + TYPE_NORMAL, TYPE_BRACE, TYPE_NORMAL, TYPE_NORMAL,
1.138 +
1.139 + /*
1.140 + * Large unsigned character values, from 128-255:
1.141 + */
1.142 +
1.143 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.144 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.145 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.146 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.147 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.148 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.149 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.150 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.151 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.152 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.153 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.154 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.155 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.156 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.157 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.158 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.159 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.160 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.161 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.162 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.163 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.164 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.165 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.166 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.167 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.168 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.169 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.170 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.171 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.172 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.173 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.174 + TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
1.175 +};
1.176 +
1.177 +/*
1.178 + * Prototypes for local procedures defined in this file:
1.179 + */
1.180 +
1.181 +static int CommandComplete _ANSI_ARGS_((CONST char *script,
1.182 + int numBytes));
1.183 +static int ParseComment _ANSI_ARGS_((CONST char *src, int numBytes,
1.184 + Tcl_Parse *parsePtr));
1.185 +static int ParseTokens _ANSI_ARGS_((CONST char *src, int numBytes,
1.186 + int mask, Tcl_Parse *parsePtr));
1.187 +
1.188 +/*
1.189 + *----------------------------------------------------------------------
1.190 + *
1.191 + * Tcl_ParseCommand --
1.192 + *
1.193 + * Given a string, this procedure parses the first Tcl command
1.194 + * in the string and returns information about the structure of
1.195 + * the command.
1.196 + *
1.197 + * Results:
1.198 + * The return value is TCL_OK if the command was parsed
1.199 + * successfully and TCL_ERROR otherwise. If an error occurs
1.200 + * and interp isn't NULL then an error message is left in
1.201 + * its result. On a successful return, parsePtr is filled in
1.202 + * with information about the command that was parsed.
1.203 + *
1.204 + * Side effects:
1.205 + * If there is insufficient space in parsePtr to hold all the
1.206 + * information about the command, then additional space is
1.207 + * malloc-ed. If the procedure returns TCL_OK then the caller must
1.208 + * eventually invoke Tcl_FreeParse to release any additional space
1.209 + * that was allocated.
1.210 + *
1.211 + *----------------------------------------------------------------------
1.212 + */
1.213 +
1.214 +EXPORT_C int
1.215 +Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr)
1.216 + Tcl_Interp *interp; /* Interpreter to use for error reporting;
1.217 + * if NULL, then no error message is
1.218 + * provided. */
1.219 + CONST char *string; /* First character of string containing
1.220 + * one or more Tcl commands. */
1.221 + register int numBytes; /* Total number of bytes in string. If < 0,
1.222 + * the script consists of all bytes up to
1.223 + * the first null character. */
1.224 + int nested; /* Non-zero means this is a nested command:
1.225 + * close bracket should be considered
1.226 + * a command terminator. If zero, then close
1.227 + * bracket has no special meaning. */
1.228 + register Tcl_Parse *parsePtr;
1.229 + /* Structure to fill in with information
1.230 + * about the parsed command; any previous
1.231 + * information in the structure is
1.232 + * ignored. */
1.233 +{
1.234 + register CONST char *src; /* Points to current character
1.235 + * in the command. */
1.236 + char type; /* Result returned by CHAR_TYPE(*src). */
1.237 + Tcl_Token *tokenPtr; /* Pointer to token being filled in. */
1.238 + int wordIndex; /* Index of word token for current word. */
1.239 + int terminators; /* CHAR_TYPE bits that indicate the end
1.240 + * of a command. */
1.241 + CONST char *termPtr; /* Set by Tcl_ParseBraces/QuotedString to
1.242 + * point to char after terminating one. */
1.243 + int scanned;
1.244 +
1.245 + if ((string == NULL) && (numBytes!=0)) {
1.246 + if (interp != NULL) {
1.247 + Tcl_SetResult(interp, "can't parse a NULL pointer", TCL_STATIC);
1.248 + }
1.249 + return TCL_ERROR;
1.250 + }
1.251 + if (numBytes < 0) {
1.252 + numBytes = strlen(string);
1.253 + }
1.254 + parsePtr->commentStart = NULL;
1.255 + parsePtr->commentSize = 0;
1.256 + parsePtr->commandStart = NULL;
1.257 + parsePtr->commandSize = 0;
1.258 + parsePtr->numWords = 0;
1.259 + parsePtr->tokenPtr = parsePtr->staticTokens;
1.260 + parsePtr->numTokens = 0;
1.261 + parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
1.262 + parsePtr->string = string;
1.263 + parsePtr->end = string + numBytes;
1.264 + parsePtr->term = parsePtr->end;
1.265 + parsePtr->interp = interp;
1.266 + parsePtr->incomplete = 0;
1.267 + parsePtr->errorType = TCL_PARSE_SUCCESS;
1.268 + if (nested != 0) {
1.269 + terminators = TYPE_COMMAND_END | TYPE_CLOSE_BRACK;
1.270 + } else {
1.271 + terminators = TYPE_COMMAND_END;
1.272 + }
1.273 +
1.274 + /*
1.275 + * Parse any leading space and comments before the first word of the
1.276 + * command.
1.277 + */
1.278 +
1.279 + scanned = ParseComment(string, numBytes, parsePtr);
1.280 + src = (string + scanned); numBytes -= scanned;
1.281 + if (numBytes == 0) {
1.282 + if (nested) {
1.283 + parsePtr->incomplete = nested;
1.284 + }
1.285 + }
1.286 +
1.287 + /*
1.288 + * The following loop parses the words of the command, one word
1.289 + * in each iteration through the loop.
1.290 + */
1.291 +
1.292 + parsePtr->commandStart = src;
1.293 + while (1) {
1.294 + /*
1.295 + * Create the token for the word.
1.296 + */
1.297 +
1.298 + if (parsePtr->numTokens == parsePtr->tokensAvailable) {
1.299 + TclExpandTokenArray(parsePtr);
1.300 + }
1.301 + wordIndex = parsePtr->numTokens;
1.302 + tokenPtr = &parsePtr->tokenPtr[wordIndex];
1.303 + tokenPtr->type = TCL_TOKEN_WORD;
1.304 +
1.305 + /*
1.306 + * Skip white space before the word. Also skip a backslash-newline
1.307 + * sequence: it should be treated just like white space.
1.308 + */
1.309 +
1.310 + scanned = TclParseWhiteSpace(src, numBytes, parsePtr, &type);
1.311 + src += scanned; numBytes -= scanned;
1.312 + if (numBytes == 0) {
1.313 + parsePtr->term = src;
1.314 + break;
1.315 + }
1.316 + if ((type & terminators) != 0) {
1.317 + parsePtr->term = src;
1.318 + src++;
1.319 + break;
1.320 + }
1.321 + tokenPtr->start = src;
1.322 + parsePtr->numTokens++;
1.323 + parsePtr->numWords++;
1.324 +
1.325 + /*
1.326 + * At this point the word can have one of three forms: something
1.327 + * enclosed in quotes, something enclosed in braces, or an
1.328 + * unquoted word (anything else).
1.329 + */
1.330 +
1.331 + if (*src == '"') {
1.332 + if (Tcl_ParseQuotedString(interp, src, numBytes,
1.333 + parsePtr, 1, &termPtr) != TCL_OK) {
1.334 + goto error;
1.335 + }
1.336 + src = termPtr; numBytes = parsePtr->end - src;
1.337 + } else if (*src == '{') {
1.338 + if (Tcl_ParseBraces(interp, src, numBytes,
1.339 + parsePtr, 1, &termPtr) != TCL_OK) {
1.340 + goto error;
1.341 + }
1.342 + src = termPtr; numBytes = parsePtr->end - src;
1.343 + } else {
1.344 + /*
1.345 + * This is an unquoted word. Call ParseTokens and let it do
1.346 + * all of the work.
1.347 + */
1.348 +
1.349 + if (ParseTokens(src, numBytes, TYPE_SPACE|terminators,
1.350 + parsePtr) != TCL_OK) {
1.351 + goto error;
1.352 + }
1.353 + src = parsePtr->term; numBytes = parsePtr->end - src;
1.354 + }
1.355 +
1.356 + /*
1.357 + * Finish filling in the token for the word and check for the
1.358 + * special case of a word consisting of a single range of
1.359 + * literal text.
1.360 + */
1.361 +
1.362 + tokenPtr = &parsePtr->tokenPtr[wordIndex];
1.363 + tokenPtr->size = src - tokenPtr->start;
1.364 + tokenPtr->numComponents = parsePtr->numTokens - (wordIndex + 1);
1.365 + if ((tokenPtr->numComponents == 1)
1.366 + && (tokenPtr[1].type == TCL_TOKEN_TEXT)) {
1.367 + tokenPtr->type = TCL_TOKEN_SIMPLE_WORD;
1.368 + }
1.369 +
1.370 + /*
1.371 + * Do two additional checks: (a) make sure we're really at the
1.372 + * end of a word (there might have been garbage left after a
1.373 + * quoted or braced word), and (b) check for the end of the
1.374 + * command.
1.375 + */
1.376 +
1.377 + scanned = TclParseWhiteSpace(src, numBytes, parsePtr, &type);
1.378 + if (scanned) {
1.379 + src += scanned; numBytes -= scanned;
1.380 + continue;
1.381 + }
1.382 +
1.383 + if (numBytes == 0) {
1.384 + parsePtr->term = src;
1.385 + break;
1.386 + }
1.387 + if ((type & terminators) != 0) {
1.388 + parsePtr->term = src;
1.389 + src++;
1.390 + break;
1.391 + }
1.392 + if (src[-1] == '"') {
1.393 + if (interp != NULL) {
1.394 + Tcl_SetResult(interp, "extra characters after close-quote",
1.395 + TCL_STATIC);
1.396 + }
1.397 + parsePtr->errorType = TCL_PARSE_QUOTE_EXTRA;
1.398 + } else {
1.399 + if (interp != NULL) {
1.400 + Tcl_SetResult(interp, "extra characters after close-brace",
1.401 + TCL_STATIC);
1.402 + }
1.403 + parsePtr->errorType = TCL_PARSE_BRACE_EXTRA;
1.404 + }
1.405 + parsePtr->term = src;
1.406 + goto error;
1.407 + }
1.408 +
1.409 + parsePtr->commandSize = src - parsePtr->commandStart;
1.410 + return TCL_OK;
1.411 +
1.412 + error:
1.413 + Tcl_FreeParse(parsePtr);
1.414 + if (parsePtr->commandStart == NULL) {
1.415 + parsePtr->commandStart = string;
1.416 + }
1.417 + parsePtr->commandSize = parsePtr->end - parsePtr->commandStart;
1.418 + return TCL_ERROR;
1.419 +}
1.420 +
1.421 +/*
1.422 + *----------------------------------------------------------------------
1.423 + *
1.424 + * TclParseWhiteSpace --
1.425 + *
1.426 + * Scans up to numBytes bytes starting at src, consuming white
1.427 + * space as defined by Tcl's parsing rules.
1.428 + *
1.429 + * Results:
1.430 + * Returns the number of bytes recognized as white space. Records
1.431 + * at parsePtr, information about the parse. Records at typePtr
1.432 + * the character type of the non-whitespace character that terminated
1.433 + * the scan.
1.434 + *
1.435 + * Side effects:
1.436 + * None.
1.437 + *
1.438 + *----------------------------------------------------------------------
1.439 + */
1.440 +int
1.441 +TclParseWhiteSpace(src, numBytes, parsePtr, typePtr)
1.442 + CONST char *src; /* First character to parse. */
1.443 + register int numBytes; /* Max number of bytes to scan. */
1.444 + Tcl_Parse *parsePtr; /* Information about parse in progress.
1.445 + * Updated if parsing indicates
1.446 + * an incomplete command. */
1.447 + char *typePtr; /* Points to location to store character
1.448 + * type of character that ends run
1.449 + * of whitespace */
1.450 +{
1.451 + register char type = TYPE_NORMAL;
1.452 + register CONST char *p = src;
1.453 +
1.454 + while (1) {
1.455 + while (numBytes && ((type = CHAR_TYPE(*p)) & TYPE_SPACE)) {
1.456 + numBytes--; p++;
1.457 + }
1.458 + if (numBytes && (type & TYPE_SUBS)) {
1.459 + if (*p != '\\') {
1.460 + break;
1.461 + }
1.462 + if (--numBytes == 0) {
1.463 + break;
1.464 + }
1.465 + if (p[1] != '\n') {
1.466 + break;
1.467 + }
1.468 + p+=2;
1.469 + if (--numBytes == 0) {
1.470 + parsePtr->incomplete = 1;
1.471 + break;
1.472 + }
1.473 + continue;
1.474 + }
1.475 + break;
1.476 + }
1.477 + *typePtr = type;
1.478 + return (p - src);
1.479 +}
1.480 +
1.481 +/*
1.482 + *----------------------------------------------------------------------
1.483 + *
1.484 + * TclParseHex --
1.485 + *
1.486 + * Scans a hexadecimal number as a Tcl_UniChar value.
1.487 + * (e.g., for parsing \x and \u escape sequences).
1.488 + * At most numBytes bytes are scanned.
1.489 + *
1.490 + * Results:
1.491 + * The numeric value is stored in *resultPtr.
1.492 + * Returns the number of bytes consumed.
1.493 + *
1.494 + * Notes:
1.495 + * Relies on the following properties of the ASCII
1.496 + * character set, with which UTF-8 is compatible:
1.497 + *
1.498 + * The digits '0' .. '9' and the letters 'A' .. 'Z' and 'a' .. 'z'
1.499 + * occupy consecutive code points, and '0' < 'A' < 'a'.
1.500 + *
1.501 + *----------------------------------------------------------------------
1.502 + */
1.503 +int
1.504 +TclParseHex(src, numBytes, resultPtr)
1.505 + CONST char *src; /* First character to parse. */
1.506 + int numBytes; /* Max number of byes to scan */
1.507 + Tcl_UniChar *resultPtr; /* Points to storage provided by
1.508 + * caller where the Tcl_UniChar
1.509 + * resulting from the conversion is
1.510 + * to be written. */
1.511 +{
1.512 + Tcl_UniChar result = 0;
1.513 + register CONST char *p = src;
1.514 +
1.515 + while (numBytes--) {
1.516 + unsigned char digit = UCHAR(*p);
1.517 +
1.518 + if (!isxdigit(digit))
1.519 + break;
1.520 +
1.521 + ++p;
1.522 + result <<= 4;
1.523 +
1.524 + if (digit >= 'a') {
1.525 + result |= (10 + digit - 'a');
1.526 + } else if (digit >= 'A') {
1.527 + result |= (10 + digit - 'A');
1.528 + } else {
1.529 + result |= (digit - '0');
1.530 + }
1.531 + }
1.532 +
1.533 + *resultPtr = result;
1.534 + return (p - src);
1.535 +}
1.536 +
1.537 +/*
1.538 + *----------------------------------------------------------------------
1.539 + *
1.540 + * TclParseBackslash --
1.541 + *
1.542 + * Scans up to numBytes bytes starting at src, consuming a
1.543 + * backslash sequence as defined by Tcl's parsing rules.
1.544 + *
1.545 + * Results:
1.546 + * Records at readPtr the number of bytes making up the backslash
1.547 + * sequence. Records at dst the UTF-8 encoded equivalent of
1.548 + * that backslash sequence. Returns the number of bytes written
1.549 + * to dst, at most TCL_UTF_MAX. Either readPtr or dst may be
1.550 + * NULL, if the results are not needed, but the return value is
1.551 + * the same either way.
1.552 + *
1.553 + * Side effects:
1.554 + * None.
1.555 + *
1.556 + *----------------------------------------------------------------------
1.557 + */
1.558 +int
1.559 +TclParseBackslash(src, numBytes, readPtr, dst)
1.560 + CONST char * src; /* Points to the backslash character of a
1.561 + * a backslash sequence */
1.562 + int numBytes; /* Max number of bytes to scan */
1.563 + int *readPtr; /* NULL, or points to storage where the
1.564 + * number of bytes scanned should be written. */
1.565 + char *dst; /* NULL, or points to buffer where the UTF-8
1.566 + * encoding of the backslash sequence is to be
1.567 + * written. At most TCL_UTF_MAX bytes will be
1.568 + * written there. */
1.569 +{
1.570 + register CONST char *p = src+1;
1.571 + Tcl_UniChar result;
1.572 + int count;
1.573 + char buf[TCL_UTF_MAX];
1.574 +
1.575 + if (numBytes == 0) {
1.576 + if (readPtr != NULL) {
1.577 + *readPtr = 0;
1.578 + }
1.579 + return 0;
1.580 + }
1.581 +
1.582 + if (dst == NULL) {
1.583 + dst = buf;
1.584 + }
1.585 +
1.586 + if (numBytes == 1) {
1.587 + /* Can only scan the backslash. Return it. */
1.588 + result = '\\';
1.589 + count = 1;
1.590 + goto done;
1.591 + }
1.592 +
1.593 + count = 2;
1.594 + switch (*p) {
1.595 + /*
1.596 + * Note: in the conversions below, use absolute values (e.g.,
1.597 + * 0xa) rather than symbolic values (e.g. \n) that get converted
1.598 + * by the compiler. It's possible that compilers on some
1.599 + * platforms will do the symbolic conversions differently, which
1.600 + * could result in non-portable Tcl scripts.
1.601 + */
1.602 +
1.603 + case 'a':
1.604 + result = 0x7;
1.605 + break;
1.606 + case 'b':
1.607 + result = 0x8;
1.608 + break;
1.609 + case 'f':
1.610 + result = 0xc;
1.611 + break;
1.612 + case 'n':
1.613 + result = 0xa;
1.614 + break;
1.615 + case 'r':
1.616 + result = 0xd;
1.617 + break;
1.618 + case 't':
1.619 + result = 0x9;
1.620 + break;
1.621 + case 'v':
1.622 + result = 0xb;
1.623 + break;
1.624 + case 'x':
1.625 + count += TclParseHex(p+1, numBytes-1, &result);
1.626 + if (count == 2) {
1.627 + /* No hexadigits -> This is just "x". */
1.628 + result = 'x';
1.629 + } else {
1.630 + /* Keep only the last byte (2 hex digits) */
1.631 + result = (unsigned char) result;
1.632 + }
1.633 + break;
1.634 + case 'u':
1.635 + count += TclParseHex(p+1, (numBytes > 5) ? 4 : numBytes-1, &result);
1.636 + if (count == 2) {
1.637 + /* No hexadigits -> This is just "u". */
1.638 + result = 'u';
1.639 + }
1.640 + break;
1.641 + case '\n':
1.642 + count--;
1.643 + do {
1.644 + p++; count++;
1.645 + } while ((count < numBytes) && ((*p == ' ') || (*p == '\t')));
1.646 + result = ' ';
1.647 + break;
1.648 + case 0:
1.649 + result = '\\';
1.650 + count = 1;
1.651 + break;
1.652 + default:
1.653 + /*
1.654 + * Check for an octal number \oo?o?
1.655 + */
1.656 + if (isdigit(UCHAR(*p)) && (UCHAR(*p) < '8')) { /* INTL: digit */
1.657 + result = (unsigned char)(*p - '0');
1.658 + p++;
1.659 + if ((numBytes == 2) || !isdigit(UCHAR(*p)) /* INTL: digit */
1.660 + || (UCHAR(*p) >= '8')) {
1.661 + break;
1.662 + }
1.663 + count = 3;
1.664 + result = (unsigned char)((result << 3) + (*p - '0'));
1.665 + p++;
1.666 + if ((numBytes == 3) || !isdigit(UCHAR(*p)) /* INTL: digit */
1.667 + || (UCHAR(*p) >= '8')) {
1.668 + break;
1.669 + }
1.670 + count = 4;
1.671 + result = (unsigned char)((result << 3) + (*p - '0'));
1.672 + break;
1.673 + }
1.674 + /*
1.675 + * We have to convert here in case the user has put a
1.676 + * backslash in front of a multi-byte utf-8 character.
1.677 + * While this means nothing special, we shouldn't break up
1.678 + * a correct utf-8 character. [Bug #217987] test subst-3.2
1.679 + */
1.680 + if (Tcl_UtfCharComplete(p, numBytes - 1)) {
1.681 + count = Tcl_UtfToUniChar(p, &result) + 1; /* +1 for '\' */
1.682 + } else {
1.683 + char utfBytes[TCL_UTF_MAX];
1.684 + memcpy(utfBytes, p, (size_t) (numBytes - 1));
1.685 + utfBytes[numBytes - 1] = '\0';
1.686 + count = Tcl_UtfToUniChar(utfBytes, &result) + 1;
1.687 + }
1.688 + break;
1.689 + }
1.690 +
1.691 + done:
1.692 + if (readPtr != NULL) {
1.693 + *readPtr = count;
1.694 + }
1.695 + return Tcl_UniCharToUtf((int) result, dst);
1.696 +}
1.697 +
1.698 +/*
1.699 + *----------------------------------------------------------------------
1.700 + *
1.701 + * ParseComment --
1.702 + *
1.703 + * Scans up to numBytes bytes starting at src, consuming a
1.704 + * Tcl comment as defined by Tcl's parsing rules.
1.705 + *
1.706 + * Results:
1.707 + * Records in parsePtr information about the parse. Returns the
1.708 + * number of bytes consumed.
1.709 + *
1.710 + * Side effects:
1.711 + * None.
1.712 + *
1.713 + *----------------------------------------------------------------------
1.714 + */
1.715 +static int
1.716 +ParseComment(src, numBytes, parsePtr)
1.717 + CONST char *src; /* First character to parse. */
1.718 + register int numBytes; /* Max number of bytes to scan. */
1.719 + Tcl_Parse *parsePtr; /* Information about parse in progress.
1.720 + * Updated if parsing indicates
1.721 + * an incomplete command. */
1.722 +{
1.723 + register CONST char *p = src;
1.724 + while (numBytes) {
1.725 + char type;
1.726 + int scanned;
1.727 + do {
1.728 + scanned = TclParseWhiteSpace(p, numBytes, parsePtr, &type);
1.729 + p += scanned; numBytes -= scanned;
1.730 + } while (numBytes && (*p == '\n') && (p++,numBytes--));
1.731 + if ((numBytes == 0) || (*p != '#')) {
1.732 + break;
1.733 + }
1.734 + if (parsePtr->commentStart == NULL) {
1.735 + parsePtr->commentStart = p;
1.736 + }
1.737 + while (numBytes) {
1.738 + if (*p == '\\') {
1.739 + scanned = TclParseWhiteSpace(p, numBytes, parsePtr, &type);
1.740 + if (scanned) {
1.741 + p += scanned; numBytes -= scanned;
1.742 + } else {
1.743 + /*
1.744 + * General backslash substitution in comments isn't
1.745 + * part of the formal spec, but test parse-15.47
1.746 + * and history indicate that it has been the de facto
1.747 + * rule. Don't change it now.
1.748 + */
1.749 + TclParseBackslash(p, numBytes, &scanned, NULL);
1.750 + p += scanned; numBytes -= scanned;
1.751 + }
1.752 + } else {
1.753 + p++; numBytes--;
1.754 + if (p[-1] == '\n') {
1.755 + break;
1.756 + }
1.757 + }
1.758 + }
1.759 + parsePtr->commentSize = p - parsePtr->commentStart;
1.760 + }
1.761 + return (p - src);
1.762 +}
1.763 +
1.764 +/*
1.765 + *----------------------------------------------------------------------
1.766 + *
1.767 + * ParseTokens --
1.768 + *
1.769 + * This procedure forms the heart of the Tcl parser. It parses one
1.770 + * or more tokens from a string, up to a termination point
1.771 + * specified by the caller. This procedure is used to parse
1.772 + * unquoted command words (those not in quotes or braces), words in
1.773 + * quotes, and array indices for variables. No more than numBytes
1.774 + * bytes will be scanned.
1.775 + *
1.776 + * Results:
1.777 + * Tokens are added to parsePtr and parsePtr->term is filled in
1.778 + * with the address of the character that terminated the parse (the
1.779 + * first one whose CHAR_TYPE matched mask or the character at
1.780 + * parsePtr->end). The return value is TCL_OK if the parse
1.781 + * completed successfully and TCL_ERROR otherwise. If a parse
1.782 + * error occurs and parsePtr->interp isn't NULL, then an error
1.783 + * message is left in the interpreter's result.
1.784 + *
1.785 + * Side effects:
1.786 + * None.
1.787 + *
1.788 + *----------------------------------------------------------------------
1.789 + */
1.790 +
1.791 +static int
1.792 +ParseTokens(src, numBytes, mask, parsePtr)
1.793 + register CONST char *src; /* First character to parse. */
1.794 + register int numBytes; /* Max number of bytes to scan. */
1.795 + int mask; /* Specifies when to stop parsing. The
1.796 + * parse stops at the first unquoted
1.797 + * character whose CHAR_TYPE contains
1.798 + * any of the bits in mask. */
1.799 + Tcl_Parse *parsePtr; /* Information about parse in progress.
1.800 + * Updated with additional tokens and
1.801 + * termination information. */
1.802 +{
1.803 + char type;
1.804 + int originalTokens, varToken;
1.805 + Tcl_Token *tokenPtr;
1.806 + Tcl_Parse nested;
1.807 +
1.808 + /*
1.809 + * Each iteration through the following loop adds one token of
1.810 + * type TCL_TOKEN_TEXT, TCL_TOKEN_BS, TCL_TOKEN_COMMAND, or
1.811 + * TCL_TOKEN_VARIABLE to parsePtr. For TCL_TOKEN_VARIABLE tokens,
1.812 + * additional tokens are added for the parsed variable name.
1.813 + */
1.814 +
1.815 + originalTokens = parsePtr->numTokens;
1.816 + while (numBytes && !((type = CHAR_TYPE(*src)) & mask)) {
1.817 + if (parsePtr->numTokens == parsePtr->tokensAvailable) {
1.818 + TclExpandTokenArray(parsePtr);
1.819 + }
1.820 + tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
1.821 + tokenPtr->start = src;
1.822 + tokenPtr->numComponents = 0;
1.823 +
1.824 + if ((type & TYPE_SUBS) == 0) {
1.825 + /*
1.826 + * This is a simple range of characters. Scan to find the end
1.827 + * of the range.
1.828 + */
1.829 +
1.830 + while ((++src, --numBytes)
1.831 + && !(CHAR_TYPE(*src) & (mask | TYPE_SUBS))) {
1.832 + /* empty loop */
1.833 + }
1.834 + tokenPtr->type = TCL_TOKEN_TEXT;
1.835 + tokenPtr->size = src - tokenPtr->start;
1.836 + parsePtr->numTokens++;
1.837 + } else if (*src == '$') {
1.838 + /*
1.839 + * This is a variable reference. Call Tcl_ParseVarName to do
1.840 + * all the dirty work of parsing the name.
1.841 + */
1.842 +
1.843 + varToken = parsePtr->numTokens;
1.844 + if (Tcl_ParseVarName(parsePtr->interp, src, numBytes,
1.845 + parsePtr, 1) != TCL_OK) {
1.846 + return TCL_ERROR;
1.847 + }
1.848 + src += parsePtr->tokenPtr[varToken].size;
1.849 + numBytes -= parsePtr->tokenPtr[varToken].size;
1.850 + } else if (*src == '[') {
1.851 + /*
1.852 + * Command substitution. Call Tcl_ParseCommand recursively
1.853 + * (and repeatedly) to parse the nested command(s), then
1.854 + * throw away the parse information.
1.855 + */
1.856 +
1.857 + src++; numBytes--;
1.858 + while (1) {
1.859 + if (Tcl_ParseCommand(parsePtr->interp, src,
1.860 + numBytes, 1, &nested) != TCL_OK) {
1.861 + parsePtr->errorType = nested.errorType;
1.862 + parsePtr->term = nested.term;
1.863 + parsePtr->incomplete = nested.incomplete;
1.864 + return TCL_ERROR;
1.865 + }
1.866 + src = nested.commandStart + nested.commandSize;
1.867 + numBytes = parsePtr->end - src;
1.868 +
1.869 + /*
1.870 + * This is equivalent to Tcl_FreeParse(&nested), but
1.871 + * presumably inlined here for sake of runtime optimization
1.872 + */
1.873 +
1.874 + if (nested.tokenPtr != nested.staticTokens) {
1.875 + ckfree((char *) nested.tokenPtr);
1.876 + }
1.877 +
1.878 + /*
1.879 + * Check for the closing ']' that ends the command
1.880 + * substitution. It must have been the last character of
1.881 + * the parsed command.
1.882 + */
1.883 +
1.884 + if ((nested.term < parsePtr->end) && (*nested.term == ']')
1.885 + && !nested.incomplete) {
1.886 + break;
1.887 + }
1.888 + if (numBytes == 0) {
1.889 + if (parsePtr->interp != NULL) {
1.890 + Tcl_SetResult(parsePtr->interp,
1.891 + "missing close-bracket", TCL_STATIC);
1.892 + }
1.893 + parsePtr->errorType = TCL_PARSE_MISSING_BRACKET;
1.894 + parsePtr->term = tokenPtr->start;
1.895 + parsePtr->incomplete = 1;
1.896 + return TCL_ERROR;
1.897 + }
1.898 + }
1.899 + tokenPtr->type = TCL_TOKEN_COMMAND;
1.900 + tokenPtr->size = src - tokenPtr->start;
1.901 + parsePtr->numTokens++;
1.902 + } else if (*src == '\\') {
1.903 + /*
1.904 + * Backslash substitution.
1.905 + */
1.906 + TclParseBackslash(src, numBytes, &tokenPtr->size, NULL);
1.907 +
1.908 + if (tokenPtr->size == 1) {
1.909 + /* Just a backslash, due to end of string */
1.910 + tokenPtr->type = TCL_TOKEN_TEXT;
1.911 + parsePtr->numTokens++;
1.912 + src++; numBytes--;
1.913 + continue;
1.914 + }
1.915 +
1.916 + if (src[1] == '\n') {
1.917 + if (numBytes == 2) {
1.918 + parsePtr->incomplete = 1;
1.919 + }
1.920 +
1.921 + /*
1.922 + * Note: backslash-newline is special in that it is
1.923 + * treated the same as a space character would be. This
1.924 + * means that it could terminate the token.
1.925 + */
1.926 +
1.927 + if (mask & TYPE_SPACE) {
1.928 + if (parsePtr->numTokens == originalTokens) {
1.929 + goto finishToken;
1.930 + }
1.931 + break;
1.932 + }
1.933 + }
1.934 +
1.935 + tokenPtr->type = TCL_TOKEN_BS;
1.936 + parsePtr->numTokens++;
1.937 + src += tokenPtr->size;
1.938 + numBytes -= tokenPtr->size;
1.939 + } else if (*src == 0) {
1.940 + tokenPtr->type = TCL_TOKEN_TEXT;
1.941 + tokenPtr->size = 1;
1.942 + parsePtr->numTokens++;
1.943 + src++; numBytes--;
1.944 + } else {
1.945 + panic("ParseTokens encountered unknown character");
1.946 + }
1.947 + }
1.948 + if (parsePtr->numTokens == originalTokens) {
1.949 + /*
1.950 + * There was nothing in this range of text. Add an empty token
1.951 + * for the empty range, so that there is always at least one
1.952 + * token added.
1.953 + */
1.954 + if (parsePtr->numTokens == parsePtr->tokensAvailable) {
1.955 + TclExpandTokenArray(parsePtr);
1.956 + }
1.957 + tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
1.958 + tokenPtr->start = src;
1.959 + tokenPtr->numComponents = 0;
1.960 +
1.961 + finishToken:
1.962 + tokenPtr->type = TCL_TOKEN_TEXT;
1.963 + tokenPtr->size = 0;
1.964 + parsePtr->numTokens++;
1.965 + }
1.966 + parsePtr->term = src;
1.967 + return TCL_OK;
1.968 +}
1.969 +
1.970 +/*
1.971 + *----------------------------------------------------------------------
1.972 + *
1.973 + * Tcl_FreeParse --
1.974 + *
1.975 + * This procedure is invoked to free any dynamic storage that may
1.976 + * have been allocated by a previous call to Tcl_ParseCommand.
1.977 + *
1.978 + * Results:
1.979 + * None.
1.980 + *
1.981 + * Side effects:
1.982 + * If there is any dynamically allocated memory in *parsePtr,
1.983 + * it is freed.
1.984 + *
1.985 + *----------------------------------------------------------------------
1.986 + */
1.987 +
1.988 +EXPORT_C void
1.989 +Tcl_FreeParse(parsePtr)
1.990 + Tcl_Parse *parsePtr; /* Structure that was filled in by a
1.991 + * previous call to Tcl_ParseCommand. */
1.992 +{
1.993 + if (parsePtr->tokenPtr != parsePtr->staticTokens) {
1.994 + ckfree((char *) parsePtr->tokenPtr);
1.995 + parsePtr->tokenPtr = parsePtr->staticTokens;
1.996 + }
1.997 +}
1.998 +
1.999 +/*
1.1000 + *----------------------------------------------------------------------
1.1001 + *
1.1002 + * TclExpandTokenArray --
1.1003 + *
1.1004 + * This procedure is invoked when the current space for tokens in
1.1005 + * a Tcl_Parse structure fills up; it allocates memory to grow the
1.1006 + * token array
1.1007 + *
1.1008 + * Results:
1.1009 + * None.
1.1010 + *
1.1011 + * Side effects:
1.1012 + * Memory is allocated for a new larger token array; the memory
1.1013 + * for the old array is freed, if it had been dynamically allocated.
1.1014 + *
1.1015 + *----------------------------------------------------------------------
1.1016 + */
1.1017 +
1.1018 +void
1.1019 +TclExpandTokenArray(parsePtr)
1.1020 + Tcl_Parse *parsePtr; /* Parse structure whose token space
1.1021 + * has overflowed. */
1.1022 +{
1.1023 + int newCount;
1.1024 + Tcl_Token *newPtr;
1.1025 +
1.1026 + newCount = parsePtr->tokensAvailable*2;
1.1027 + newPtr = (Tcl_Token *) ckalloc((unsigned) (newCount * sizeof(Tcl_Token)));
1.1028 + memcpy((VOID *) newPtr, (VOID *) parsePtr->tokenPtr,
1.1029 + (size_t) (parsePtr->tokensAvailable * sizeof(Tcl_Token)));
1.1030 + if (parsePtr->tokenPtr != parsePtr->staticTokens) {
1.1031 + ckfree((char *) parsePtr->tokenPtr);
1.1032 + }
1.1033 + parsePtr->tokenPtr = newPtr;
1.1034 + parsePtr->tokensAvailable = newCount;
1.1035 +}
1.1036 +
1.1037 +/*
1.1038 + *----------------------------------------------------------------------
1.1039 + *
1.1040 + * Tcl_ParseVarName --
1.1041 + *
1.1042 + * Given a string starting with a $ sign, parse off a variable
1.1043 + * name and return information about the parse. No more than
1.1044 + * numBytes bytes will be scanned.
1.1045 + *
1.1046 + * Results:
1.1047 + * The return value is TCL_OK if the command was parsed
1.1048 + * successfully and TCL_ERROR otherwise. If an error occurs and
1.1049 + * interp isn't NULL then an error message is left in its result.
1.1050 + * On a successful return, tokenPtr and numTokens fields of
1.1051 + * parsePtr are filled in with information about the variable name
1.1052 + * that was parsed. The "size" field of the first new token gives
1.1053 + * the total number of bytes in the variable name. Other fields in
1.1054 + * parsePtr are undefined.
1.1055 + *
1.1056 + * Side effects:
1.1057 + * If there is insufficient space in parsePtr to hold all the
1.1058 + * information about the command, then additional space is
1.1059 + * malloc-ed. If the procedure returns TCL_OK then the caller must
1.1060 + * eventually invoke Tcl_FreeParse to release any additional space
1.1061 + * that was allocated.
1.1062 + *
1.1063 + *----------------------------------------------------------------------
1.1064 + */
1.1065 +
1.1066 +EXPORT_C int
1.1067 +Tcl_ParseVarName(interp, string, numBytes, parsePtr, append)
1.1068 + Tcl_Interp *interp; /* Interpreter to use for error reporting;
1.1069 + * if NULL, then no error message is
1.1070 + * provided. */
1.1071 + CONST char *string; /* String containing variable name. First
1.1072 + * character must be "$". */
1.1073 + register int numBytes; /* Total number of bytes in string. If < 0,
1.1074 + * the string consists of all bytes up to the
1.1075 + * first null character. */
1.1076 + Tcl_Parse *parsePtr; /* Structure to fill in with information
1.1077 + * about the variable name. */
1.1078 + int append; /* Non-zero means append tokens to existing
1.1079 + * information in parsePtr; zero means ignore
1.1080 + * existing tokens in parsePtr and reinitialize
1.1081 + * it. */
1.1082 +{
1.1083 + Tcl_Token *tokenPtr;
1.1084 + register CONST char *src;
1.1085 + unsigned char c;
1.1086 + int varIndex, offset;
1.1087 + Tcl_UniChar ch;
1.1088 + unsigned array;
1.1089 +
1.1090 + if ((numBytes == 0) || (string == NULL)) {
1.1091 + return TCL_ERROR;
1.1092 + }
1.1093 + if (numBytes < 0) {
1.1094 + numBytes = strlen(string);
1.1095 + }
1.1096 +
1.1097 + if (!append) {
1.1098 + parsePtr->numWords = 0;
1.1099 + parsePtr->tokenPtr = parsePtr->staticTokens;
1.1100 + parsePtr->numTokens = 0;
1.1101 + parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
1.1102 + parsePtr->string = string;
1.1103 + parsePtr->end = (string + numBytes);
1.1104 + parsePtr->interp = interp;
1.1105 + parsePtr->errorType = TCL_PARSE_SUCCESS;
1.1106 + parsePtr->incomplete = 0;
1.1107 + }
1.1108 +
1.1109 + /*
1.1110 + * Generate one token for the variable, an additional token for the
1.1111 + * name, plus any number of additional tokens for the index, if
1.1112 + * there is one.
1.1113 + */
1.1114 +
1.1115 + src = string;
1.1116 + if ((parsePtr->numTokens + 2) > parsePtr->tokensAvailable) {
1.1117 + TclExpandTokenArray(parsePtr);
1.1118 + }
1.1119 + tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
1.1120 + tokenPtr->type = TCL_TOKEN_VARIABLE;
1.1121 + tokenPtr->start = src;
1.1122 + varIndex = parsePtr->numTokens;
1.1123 + parsePtr->numTokens++;
1.1124 + tokenPtr++;
1.1125 + src++; numBytes--;
1.1126 + if (numBytes == 0) {
1.1127 + goto justADollarSign;
1.1128 + }
1.1129 + tokenPtr->type = TCL_TOKEN_TEXT;
1.1130 + tokenPtr->start = src;
1.1131 + tokenPtr->numComponents = 0;
1.1132 +
1.1133 + /*
1.1134 + * The name of the variable can have three forms:
1.1135 + * 1. The $ sign is followed by an open curly brace. Then
1.1136 + * the variable name is everything up to the next close
1.1137 + * curly brace, and the variable is a scalar variable.
1.1138 + * 2. The $ sign is not followed by an open curly brace. Then
1.1139 + * the variable name is everything up to the next
1.1140 + * character that isn't a letter, digit, or underscore.
1.1141 + * :: sequences are also considered part of the variable
1.1142 + * name, in order to support namespaces. If the following
1.1143 + * character is an open parenthesis, then the information
1.1144 + * between parentheses is the array element name.
1.1145 + * 3. The $ sign is followed by something that isn't a letter,
1.1146 + * digit, or underscore: in this case, there is no variable
1.1147 + * name and the token is just "$".
1.1148 + */
1.1149 +
1.1150 + if (*src == '{') {
1.1151 + src++; numBytes--;
1.1152 + tokenPtr->type = TCL_TOKEN_TEXT;
1.1153 + tokenPtr->start = src;
1.1154 + tokenPtr->numComponents = 0;
1.1155 +
1.1156 + while (numBytes && (*src != '}')) {
1.1157 + numBytes--; src++;
1.1158 + }
1.1159 + if (numBytes == 0) {
1.1160 + if (interp != NULL) {
1.1161 + Tcl_SetResult(interp, "missing close-brace for variable name",
1.1162 + TCL_STATIC);
1.1163 + }
1.1164 + parsePtr->errorType = TCL_PARSE_MISSING_VAR_BRACE;
1.1165 + parsePtr->term = tokenPtr->start-1;
1.1166 + parsePtr->incomplete = 1;
1.1167 + goto error;
1.1168 + }
1.1169 + tokenPtr->size = src - tokenPtr->start;
1.1170 + tokenPtr[-1].size = src - tokenPtr[-1].start;
1.1171 + parsePtr->numTokens++;
1.1172 + src++;
1.1173 + } else {
1.1174 + tokenPtr->type = TCL_TOKEN_TEXT;
1.1175 + tokenPtr->start = src;
1.1176 + tokenPtr->numComponents = 0;
1.1177 + while (numBytes) {
1.1178 + if (Tcl_UtfCharComplete(src, numBytes)) {
1.1179 + offset = Tcl_UtfToUniChar(src, &ch);
1.1180 + } else {
1.1181 + char utfBytes[TCL_UTF_MAX];
1.1182 + memcpy(utfBytes, src, (size_t) numBytes);
1.1183 + utfBytes[numBytes] = '\0';
1.1184 + offset = Tcl_UtfToUniChar(utfBytes, &ch);
1.1185 + }
1.1186 + c = UCHAR(ch);
1.1187 + if (isalnum(c) || (c == '_')) { /* INTL: ISO only, UCHAR. */
1.1188 + src += offset; numBytes -= offset;
1.1189 + continue;
1.1190 + }
1.1191 + if ((c == ':') && (numBytes != 1) && (src[1] == ':')) {
1.1192 + src += 2; numBytes -= 2;
1.1193 + while (numBytes && (*src == ':')) {
1.1194 + src++; numBytes--;
1.1195 + }
1.1196 + continue;
1.1197 + }
1.1198 + break;
1.1199 + }
1.1200 +
1.1201 + /*
1.1202 + * Support for empty array names here.
1.1203 + */
1.1204 + array = (numBytes && (*src == '('));
1.1205 + tokenPtr->size = src - tokenPtr->start;
1.1206 + if ((tokenPtr->size == 0) && !array) {
1.1207 + goto justADollarSign;
1.1208 + }
1.1209 + parsePtr->numTokens++;
1.1210 + if (array) {
1.1211 + /*
1.1212 + * This is a reference to an array element. Call
1.1213 + * ParseTokens recursively to parse the element name,
1.1214 + * since it could contain any number of substitutions.
1.1215 + */
1.1216 +
1.1217 + if (ParseTokens(src+1, numBytes-1, TYPE_CLOSE_PAREN, parsePtr)
1.1218 + != TCL_OK) {
1.1219 + goto error;
1.1220 + }
1.1221 + if ((parsePtr->term == (src + numBytes))
1.1222 + || (*parsePtr->term != ')')) {
1.1223 + if (parsePtr->interp != NULL) {
1.1224 + Tcl_SetResult(parsePtr->interp, "missing )",
1.1225 + TCL_STATIC);
1.1226 + }
1.1227 + parsePtr->errorType = TCL_PARSE_MISSING_PAREN;
1.1228 + parsePtr->term = src;
1.1229 + parsePtr->incomplete = 1;
1.1230 + goto error;
1.1231 + }
1.1232 + src = parsePtr->term + 1;
1.1233 + }
1.1234 + }
1.1235 + tokenPtr = &parsePtr->tokenPtr[varIndex];
1.1236 + tokenPtr->size = src - tokenPtr->start;
1.1237 + tokenPtr->numComponents = parsePtr->numTokens - (varIndex + 1);
1.1238 + return TCL_OK;
1.1239 +
1.1240 + /*
1.1241 + * The dollar sign isn't followed by a variable name.
1.1242 + * replace the TCL_TOKEN_VARIABLE token with a
1.1243 + * TCL_TOKEN_TEXT token for the dollar sign.
1.1244 + */
1.1245 +
1.1246 + justADollarSign:
1.1247 + tokenPtr = &parsePtr->tokenPtr[varIndex];
1.1248 + tokenPtr->type = TCL_TOKEN_TEXT;
1.1249 + tokenPtr->size = 1;
1.1250 + tokenPtr->numComponents = 0;
1.1251 + return TCL_OK;
1.1252 +
1.1253 + error:
1.1254 + Tcl_FreeParse(parsePtr);
1.1255 + return TCL_ERROR;
1.1256 +}
1.1257 +
1.1258 +/*
1.1259 + *----------------------------------------------------------------------
1.1260 + *
1.1261 + * Tcl_ParseVar --
1.1262 + *
1.1263 + * Given a string starting with a $ sign, parse off a variable
1.1264 + * name and return its value.
1.1265 + *
1.1266 + * Results:
1.1267 + * The return value is the contents of the variable given by
1.1268 + * the leading characters of string. If termPtr isn't NULL,
1.1269 + * *termPtr gets filled in with the address of the character
1.1270 + * just after the last one in the variable specifier. If the
1.1271 + * variable doesn't exist, then the return value is NULL and
1.1272 + * an error message will be left in interp's result.
1.1273 + *
1.1274 + * Side effects:
1.1275 + * None.
1.1276 + *
1.1277 + *----------------------------------------------------------------------
1.1278 + */
1.1279 +
1.1280 +EXPORT_C CONST char *
1.1281 +Tcl_ParseVar(interp, string, termPtr)
1.1282 + Tcl_Interp *interp; /* Context for looking up variable. */
1.1283 + register CONST char *string; /* String containing variable name.
1.1284 + * First character must be "$". */
1.1285 + CONST char **termPtr; /* If non-NULL, points to word to fill
1.1286 + * in with character just after last
1.1287 + * one in the variable specifier. */
1.1288 +
1.1289 +{
1.1290 + Tcl_Parse parse;
1.1291 + register Tcl_Obj *objPtr;
1.1292 + int code;
1.1293 +
1.1294 + if (Tcl_ParseVarName(interp, string, -1, &parse, 0) != TCL_OK) {
1.1295 + return NULL;
1.1296 + }
1.1297 +
1.1298 + if (termPtr != NULL) {
1.1299 + *termPtr = string + parse.tokenPtr->size;
1.1300 + }
1.1301 + if (parse.numTokens == 1) {
1.1302 + /*
1.1303 + * There isn't a variable name after all: the $ is just a $.
1.1304 + */
1.1305 +
1.1306 + return "$";
1.1307 + }
1.1308 +
1.1309 + code = Tcl_EvalTokensStandard(interp, parse.tokenPtr, parse.numTokens);
1.1310 + if (code != TCL_OK) {
1.1311 + return NULL;
1.1312 + }
1.1313 + objPtr = Tcl_GetObjResult(interp);
1.1314 +
1.1315 + /*
1.1316 + * At this point we should have an object containing the value of
1.1317 + * a variable. Just return the string from that object.
1.1318 + *
1.1319 + * This should have returned the object for the user to manage, but
1.1320 + * instead we have some weak reference to the string value in the
1.1321 + * object, which is why we make sure the object exists after resetting
1.1322 + * the result. This isn't ideal, but it's the best we can do with the
1.1323 + * current documented interface. -- hobbs
1.1324 + */
1.1325 +
1.1326 + if (!Tcl_IsShared(objPtr)) {
1.1327 + Tcl_IncrRefCount(objPtr);
1.1328 + }
1.1329 + Tcl_ResetResult(interp);
1.1330 + return TclGetString(objPtr);
1.1331 +}
1.1332 +
1.1333 +/*
1.1334 + *----------------------------------------------------------------------
1.1335 + *
1.1336 + * Tcl_ParseBraces --
1.1337 + *
1.1338 + * Given a string in braces such as a Tcl command argument or a string
1.1339 + * value in a Tcl expression, this procedure parses the string and
1.1340 + * returns information about the parse. No more than numBytes bytes
1.1341 + * will be scanned.
1.1342 + *
1.1343 + * Results:
1.1344 + * The return value is TCL_OK if the string was parsed successfully and
1.1345 + * TCL_ERROR otherwise. If an error occurs and interp isn't NULL then
1.1346 + * an error message is left in its result. On a successful return,
1.1347 + * tokenPtr and numTokens fields of parsePtr are filled in with
1.1348 + * information about the string that was parsed. Other fields in
1.1349 + * parsePtr are undefined. termPtr is set to point to the character
1.1350 + * just after the last one in the braced string.
1.1351 + *
1.1352 + * Side effects:
1.1353 + * If there is insufficient space in parsePtr to hold all the
1.1354 + * information about the command, then additional space is
1.1355 + * malloc-ed. If the procedure returns TCL_OK then the caller must
1.1356 + * eventually invoke Tcl_FreeParse to release any additional space
1.1357 + * that was allocated.
1.1358 + *
1.1359 + *----------------------------------------------------------------------
1.1360 + */
1.1361 +
1.1362 +EXPORT_C int
1.1363 +Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr)
1.1364 + Tcl_Interp *interp; /* Interpreter to use for error reporting;
1.1365 + * if NULL, then no error message is
1.1366 + * provided. */
1.1367 + CONST char *string; /* String containing the string in braces.
1.1368 + * The first character must be '{'. */
1.1369 + register int numBytes; /* Total number of bytes in string. If < 0,
1.1370 + * the string consists of all bytes up to
1.1371 + * the first null character. */
1.1372 + register Tcl_Parse *parsePtr;
1.1373 + /* Structure to fill in with information
1.1374 + * about the string. */
1.1375 + int append; /* Non-zero means append tokens to existing
1.1376 + * information in parsePtr; zero means
1.1377 + * ignore existing tokens in parsePtr and
1.1378 + * reinitialize it. */
1.1379 + CONST char **termPtr; /* If non-NULL, points to word in which to
1.1380 + * store a pointer to the character just
1.1381 + * after the terminating '}' if the parse
1.1382 + * was successful. */
1.1383 +
1.1384 +{
1.1385 + Tcl_Token *tokenPtr;
1.1386 + register CONST char *src;
1.1387 + int startIndex, level, length;
1.1388 +
1.1389 + if ((numBytes == 0) || (string == NULL)) {
1.1390 + return TCL_ERROR;
1.1391 + }
1.1392 + if (numBytes < 0) {
1.1393 + numBytes = strlen(string);
1.1394 + }
1.1395 +
1.1396 + if (!append) {
1.1397 + parsePtr->numWords = 0;
1.1398 + parsePtr->tokenPtr = parsePtr->staticTokens;
1.1399 + parsePtr->numTokens = 0;
1.1400 + parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
1.1401 + parsePtr->string = string;
1.1402 + parsePtr->end = (string + numBytes);
1.1403 + parsePtr->interp = interp;
1.1404 + parsePtr->errorType = TCL_PARSE_SUCCESS;
1.1405 + }
1.1406 +
1.1407 + src = string;
1.1408 + startIndex = parsePtr->numTokens;
1.1409 +
1.1410 + if (parsePtr->numTokens == parsePtr->tokensAvailable) {
1.1411 + TclExpandTokenArray(parsePtr);
1.1412 + }
1.1413 + tokenPtr = &parsePtr->tokenPtr[startIndex];
1.1414 + tokenPtr->type = TCL_TOKEN_TEXT;
1.1415 + tokenPtr->start = src+1;
1.1416 + tokenPtr->numComponents = 0;
1.1417 + level = 1;
1.1418 + while (1) {
1.1419 + while (++src, --numBytes) {
1.1420 + if (CHAR_TYPE(*src) != TYPE_NORMAL) {
1.1421 + break;
1.1422 + }
1.1423 + }
1.1424 + if (numBytes == 0) {
1.1425 + register int openBrace = 0;
1.1426 +
1.1427 + parsePtr->errorType = TCL_PARSE_MISSING_BRACE;
1.1428 + parsePtr->term = string;
1.1429 + parsePtr->incomplete = 1;
1.1430 + if (interp == NULL) {
1.1431 + /*
1.1432 + * Skip straight to the exit code since we have no
1.1433 + * interpreter to put error message in.
1.1434 + */
1.1435 + goto error;
1.1436 + }
1.1437 +
1.1438 + Tcl_SetResult(interp, "missing close-brace", TCL_STATIC);
1.1439 +
1.1440 + /*
1.1441 + * Guess if the problem is due to comments by searching
1.1442 + * the source string for a possible open brace within the
1.1443 + * context of a comment. Since we aren't performing a
1.1444 + * full Tcl parse, just look for an open brace preceded
1.1445 + * by a '<whitespace>#' on the same line.
1.1446 + */
1.1447 +
1.1448 + for (; src > string; src--) {
1.1449 + switch (*src) {
1.1450 + case '{':
1.1451 + openBrace = 1;
1.1452 + break;
1.1453 + case '\n':
1.1454 + openBrace = 0;
1.1455 + break;
1.1456 + case '#' :
1.1457 + if (openBrace && (isspace(UCHAR(src[-1])))) {
1.1458 + Tcl_AppendResult(interp,
1.1459 + ": possible unbalanced brace in comment",
1.1460 + (char *) NULL);
1.1461 + goto error;
1.1462 + }
1.1463 + break;
1.1464 + }
1.1465 + }
1.1466 +
1.1467 + error:
1.1468 + Tcl_FreeParse(parsePtr);
1.1469 + return TCL_ERROR;
1.1470 + }
1.1471 + switch (*src) {
1.1472 + case '{':
1.1473 + level++;
1.1474 + break;
1.1475 + case '}':
1.1476 + if (--level == 0) {
1.1477 +
1.1478 + /*
1.1479 + * Decide if we need to finish emitting a
1.1480 + * partially-finished token. There are 3 cases:
1.1481 + * {abc \newline xyz} or {xyz}
1.1482 + * - finish emitting "xyz" token
1.1483 + * {abc \newline}
1.1484 + * - don't emit token after \newline
1.1485 + * {} - finish emitting zero-sized token
1.1486 + *
1.1487 + * The last case ensures that there is a token
1.1488 + * (even if empty) that describes the braced string.
1.1489 + */
1.1490 +
1.1491 + if ((src != tokenPtr->start)
1.1492 + || (parsePtr->numTokens == startIndex)) {
1.1493 + tokenPtr->size = (src - tokenPtr->start);
1.1494 + parsePtr->numTokens++;
1.1495 + }
1.1496 + if (termPtr != NULL) {
1.1497 + *termPtr = src+1;
1.1498 + }
1.1499 + return TCL_OK;
1.1500 + }
1.1501 + break;
1.1502 + case '\\':
1.1503 + TclParseBackslash(src, numBytes, &length, NULL);
1.1504 + if ((length > 1) && (src[1] == '\n')) {
1.1505 + /*
1.1506 + * A backslash-newline sequence must be collapsed, even
1.1507 + * inside braces, so we have to split the word into
1.1508 + * multiple tokens so that the backslash-newline can be
1.1509 + * represented explicitly.
1.1510 + */
1.1511 +
1.1512 + if (numBytes == 2) {
1.1513 + parsePtr->incomplete = 1;
1.1514 + }
1.1515 + tokenPtr->size = (src - tokenPtr->start);
1.1516 + if (tokenPtr->size != 0) {
1.1517 + parsePtr->numTokens++;
1.1518 + }
1.1519 + if ((parsePtr->numTokens+1) >= parsePtr->tokensAvailable) {
1.1520 + TclExpandTokenArray(parsePtr);
1.1521 + }
1.1522 + tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
1.1523 + tokenPtr->type = TCL_TOKEN_BS;
1.1524 + tokenPtr->start = src;
1.1525 + tokenPtr->size = length;
1.1526 + tokenPtr->numComponents = 0;
1.1527 + parsePtr->numTokens++;
1.1528 +
1.1529 + src += length - 1;
1.1530 + numBytes -= length - 1;
1.1531 + tokenPtr++;
1.1532 + tokenPtr->type = TCL_TOKEN_TEXT;
1.1533 + tokenPtr->start = src + 1;
1.1534 + tokenPtr->numComponents = 0;
1.1535 + } else {
1.1536 + src += length - 1;
1.1537 + numBytes -= length - 1;
1.1538 + }
1.1539 + break;
1.1540 + }
1.1541 + }
1.1542 +}
1.1543 +
1.1544 +/*
1.1545 + *----------------------------------------------------------------------
1.1546 + *
1.1547 + * Tcl_ParseQuotedString --
1.1548 + *
1.1549 + * Given a double-quoted string such as a quoted Tcl command argument
1.1550 + * or a quoted value in a Tcl expression, this procedure parses the
1.1551 + * string and returns information about the parse. No more than
1.1552 + * numBytes bytes will be scanned.
1.1553 + *
1.1554 + * Results:
1.1555 + * The return value is TCL_OK if the string was parsed successfully and
1.1556 + * TCL_ERROR otherwise. If an error occurs and interp isn't NULL then
1.1557 + * an error message is left in its result. On a successful return,
1.1558 + * tokenPtr and numTokens fields of parsePtr are filled in with
1.1559 + * information about the string that was parsed. Other fields in
1.1560 + * parsePtr are undefined. termPtr is set to point to the character
1.1561 + * just after the quoted string's terminating close-quote.
1.1562 + *
1.1563 + * Side effects:
1.1564 + * If there is insufficient space in parsePtr to hold all the
1.1565 + * information about the command, then additional space is
1.1566 + * malloc-ed. If the procedure returns TCL_OK then the caller must
1.1567 + * eventually invoke Tcl_FreeParse to release any additional space
1.1568 + * that was allocated.
1.1569 + *
1.1570 + *----------------------------------------------------------------------
1.1571 + */
1.1572 +
1.1573 +EXPORT_C int
1.1574 +Tcl_ParseQuotedString(interp, string, numBytes, parsePtr, append, termPtr)
1.1575 + Tcl_Interp *interp; /* Interpreter to use for error reporting;
1.1576 + * if NULL, then no error message is
1.1577 + * provided. */
1.1578 + CONST char *string; /* String containing the quoted string.
1.1579 + * The first character must be '"'. */
1.1580 + register int numBytes; /* Total number of bytes in string. If < 0,
1.1581 + * the string consists of all bytes up to
1.1582 + * the first null character. */
1.1583 + register Tcl_Parse *parsePtr;
1.1584 + /* Structure to fill in with information
1.1585 + * about the string. */
1.1586 + int append; /* Non-zero means append tokens to existing
1.1587 + * information in parsePtr; zero means
1.1588 + * ignore existing tokens in parsePtr and
1.1589 + * reinitialize it. */
1.1590 + CONST char **termPtr; /* If non-NULL, points to word in which to
1.1591 + * store a pointer to the character just
1.1592 + * after the quoted string's terminating
1.1593 + * close-quote if the parse succeeds. */
1.1594 +{
1.1595 + if ((numBytes == 0) || (string == NULL)) {
1.1596 + return TCL_ERROR;
1.1597 + }
1.1598 + if (numBytes < 0) {
1.1599 + numBytes = strlen(string);
1.1600 + }
1.1601 +
1.1602 + if (!append) {
1.1603 + parsePtr->numWords = 0;
1.1604 + parsePtr->tokenPtr = parsePtr->staticTokens;
1.1605 + parsePtr->numTokens = 0;
1.1606 + parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
1.1607 + parsePtr->string = string;
1.1608 + parsePtr->end = (string + numBytes);
1.1609 + parsePtr->interp = interp;
1.1610 + parsePtr->errorType = TCL_PARSE_SUCCESS;
1.1611 + }
1.1612 +
1.1613 + if (ParseTokens(string+1, numBytes-1, TYPE_QUOTE, parsePtr) != TCL_OK) {
1.1614 + goto error;
1.1615 + }
1.1616 + if (*parsePtr->term != '"') {
1.1617 + if (interp != NULL) {
1.1618 + Tcl_SetResult(parsePtr->interp, "missing \"", TCL_STATIC);
1.1619 + }
1.1620 + parsePtr->errorType = TCL_PARSE_MISSING_QUOTE;
1.1621 + parsePtr->term = string;
1.1622 + parsePtr->incomplete = 1;
1.1623 + goto error;
1.1624 + }
1.1625 + if (termPtr != NULL) {
1.1626 + *termPtr = (parsePtr->term + 1);
1.1627 + }
1.1628 + return TCL_OK;
1.1629 +
1.1630 + error:
1.1631 + Tcl_FreeParse(parsePtr);
1.1632 + return TCL_ERROR;
1.1633 +}
1.1634 +
1.1635 +/*
1.1636 + *----------------------------------------------------------------------
1.1637 + *
1.1638 + * CommandComplete --
1.1639 + *
1.1640 + * This procedure is shared by TclCommandComplete and
1.1641 + * Tcl_ObjCommandcoComplete; it does all the real work of seeing
1.1642 + * whether a script is complete
1.1643 + *
1.1644 + * Results:
1.1645 + * 1 is returned if the script is complete, 0 if there are open
1.1646 + * delimiters such as " or (. 1 is also returned if there is a
1.1647 + * parse error in the script other than unmatched delimiters.
1.1648 + *
1.1649 + * Side effects:
1.1650 + * None.
1.1651 + *
1.1652 + *----------------------------------------------------------------------
1.1653 + */
1.1654 +
1.1655 +static int
1.1656 +CommandComplete(script, numBytes)
1.1657 + CONST char *script; /* Script to check. */
1.1658 + int numBytes; /* Number of bytes in script. */
1.1659 +{
1.1660 + Tcl_Parse parse;
1.1661 + CONST char *p, *end;
1.1662 + int result;
1.1663 +
1.1664 + p = script;
1.1665 + end = p + numBytes;
1.1666 + while (Tcl_ParseCommand((Tcl_Interp *) NULL, p, end - p, 0, &parse)
1.1667 + == TCL_OK) {
1.1668 + p = parse.commandStart + parse.commandSize;
1.1669 + if (p >= end) {
1.1670 + break;
1.1671 + }
1.1672 + Tcl_FreeParse(&parse);
1.1673 + }
1.1674 + if (parse.incomplete) {
1.1675 + result = 0;
1.1676 + } else {
1.1677 + result = 1;
1.1678 + }
1.1679 + Tcl_FreeParse(&parse);
1.1680 + return result;
1.1681 +}
1.1682 +
1.1683 +/*
1.1684 + *----------------------------------------------------------------------
1.1685 + *
1.1686 + * Tcl_CommandComplete --
1.1687 + *
1.1688 + * Given a partial or complete Tcl script, this procedure
1.1689 + * determines whether the script is complete in the sense
1.1690 + * of having matched braces and quotes and brackets.
1.1691 + *
1.1692 + * Results:
1.1693 + * 1 is returned if the script is complete, 0 otherwise.
1.1694 + * 1 is also returned if there is a parse error in the script
1.1695 + * other than unmatched delimiters.
1.1696 + *
1.1697 + * Side effects:
1.1698 + * None.
1.1699 + *
1.1700 + *----------------------------------------------------------------------
1.1701 + */
1.1702 +
1.1703 +EXPORT_C int
1.1704 +Tcl_CommandComplete(script)
1.1705 + CONST char *script; /* Script to check. */
1.1706 +{
1.1707 + return CommandComplete(script, (int) strlen(script));
1.1708 +}
1.1709 +
1.1710 +/*
1.1711 + *----------------------------------------------------------------------
1.1712 + *
1.1713 + * TclObjCommandComplete --
1.1714 + *
1.1715 + * Given a partial or complete Tcl command in a Tcl object, this
1.1716 + * procedure determines whether the command is complete in the sense of
1.1717 + * having matched braces and quotes and brackets.
1.1718 + *
1.1719 + * Results:
1.1720 + * 1 is returned if the command is complete, 0 otherwise.
1.1721 + *
1.1722 + * Side effects:
1.1723 + * None.
1.1724 + *
1.1725 + *----------------------------------------------------------------------
1.1726 + */
1.1727 +
1.1728 +int
1.1729 +TclObjCommandComplete(objPtr)
1.1730 + Tcl_Obj *objPtr; /* Points to object holding script
1.1731 + * to check. */
1.1732 +{
1.1733 + CONST char *script;
1.1734 + int length;
1.1735 +
1.1736 + script = Tcl_GetStringFromObj(objPtr, &length);
1.1737 + return CommandComplete(script, length);
1.1738 +}
1.1739 +
1.1740 +/*
1.1741 + *----------------------------------------------------------------------
1.1742 + *
1.1743 + * TclIsLocalScalar --
1.1744 + *
1.1745 + * Check to see if a given string is a legal scalar variable
1.1746 + * name with no namespace qualifiers or substitutions.
1.1747 + *
1.1748 + * Results:
1.1749 + * Returns 1 if the variable is a local scalar.
1.1750 + *
1.1751 + * Side effects:
1.1752 + * None.
1.1753 + *
1.1754 + *----------------------------------------------------------------------
1.1755 + */
1.1756 +
1.1757 +int
1.1758 +TclIsLocalScalar(src, len)
1.1759 + CONST char *src;
1.1760 + int len;
1.1761 +{
1.1762 + CONST char *p;
1.1763 + CONST char *lastChar = src + (len - 1);
1.1764 +
1.1765 + for (p = src; p <= lastChar; p++) {
1.1766 + if ((CHAR_TYPE(*p) != TYPE_NORMAL) &&
1.1767 + (CHAR_TYPE(*p) != TYPE_COMMAND_END)) {
1.1768 + /*
1.1769 + * TCL_COMMAND_END is returned for the last character
1.1770 + * of the string. By this point we know it isn't
1.1771 + * an array or namespace reference.
1.1772 + */
1.1773 +
1.1774 + return 0;
1.1775 + }
1.1776 + if (*p == '(') {
1.1777 + if (*lastChar == ')') { /* we have an array element */
1.1778 + return 0;
1.1779 + }
1.1780 + } else if (*p == ':') {
1.1781 + if ((p != lastChar) && *(p+1) == ':') { /* qualified name */
1.1782 + return 0;
1.1783 + }
1.1784 + }
1.1785 + }
1.1786 +
1.1787 + return 1;
1.1788 +}