cde/programs/dtdocbook/tcl/tclParse.c

   1 /*
   2  * CDE - Common Desktop Environment
   3  *
   4  * Copyright (c) 1993-2012, The Open Group. All rights reserved.
   5  *
   6  * These libraries and programs are free software; you can
   7  * redistribute them and/or modify them under the terms of the GNU
   8  * Lesser General Public License as published by the Free Software
   9  * Foundation; either version 2 of the License, or (at your option)
  10  * any later version.
  11  *
  12  * These libraries and programs are distributed in the hope that
  13  * they will be useful, but WITHOUT ANY WARRANTY; without even the
  14  * implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
  15  * PURPOSE. See the GNU Lesser General Public License for more
  16  * details.
  17  *
  18  * You should have received a copy of the GNU Lesser General Public
  19  * License along with these librararies and programs; if not, write
  20  * to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
  21  * Floor, Boston, MA 02110-1301 USA
  22  */
  23 /* $XConsortium: tclParse.c /main/2 1996/08/08 14:45:49 cde-hp $ */
  24 /*
  25  * tclParse.c --
  26  *
  27  *      This file contains a collection of procedures that are used
  28  *      to parse Tcl commands or parts of commands (like quoted
  29  *      strings or nested sub-commands).
  30  *
  31  * Copyright (c) 1987-1993 The Regents of the University of California.
  32  * Copyright (c) 1994-1996 Sun Microsystems, Inc.
  33  *
  34  * See the file "license.terms" for information on usage and redistribution
  35  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  36  *
  37  * SCCS: @(#) tclParse.c 1.50 96/03/02 14:46:55
  38  */
  39
  40 #include "tclInt.h"
  41 #include "tclPort.h"
  42
  43 /*
  44  * The following table assigns a type to each character.  Only types
  45  * meaningful to Tcl parsing are represented here.  The table is
  46  * designed to be referenced with either signed or unsigned characters,
  47  * so it has 384 entries.  The first 128 entries correspond to negative
  48  * character values, the next 256 correspond to positive character
  49  * values.  The last 128 entries are identical to the first 128.  The
  50  * table is always indexed with a 128-byte offset (the 128th entry
  51  * corresponds to a 0 character value).
  52  */
  53
  54 char tclTypeTable[] = {
  55     /*
  56      * Negative character values, from -128 to -1:
  57      */
  58
  59     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  60     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  61     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  62     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  63     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  64     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  65     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  66     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  67     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  68     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  69     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  70     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  71     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  72     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  73     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  74     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  75     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  76     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  77     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  78     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  79     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  80     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  81     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  82     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  83     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  84     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  85     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  86     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  87     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  88     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  89     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  90     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  91
  92     /*
  93      * Positive character values, from 0-127:
  94      */
  95
  96     TCL_COMMAND_END,   TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  97     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  98     TCL_NORMAL,        TCL_SPACE,         TCL_COMMAND_END,   TCL_SPACE,
  99     TCL_SPACE,         TCL_SPACE,         TCL_NORMAL,        TCL_NORMAL,
 100     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 101     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 102     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 103     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 104     TCL_SPACE,         TCL_NORMAL,        TCL_QUOTE,         TCL_NORMAL,
 105     TCL_DOLLAR,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 106     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 107     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 108     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 109     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 110     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_COMMAND_END,
 111     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 112     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 113     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 114     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 115     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 116     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 117     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 118     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_OPEN_BRACKET,
 119     TCL_BACKSLASH,     TCL_COMMAND_END,   TCL_NORMAL,        TCL_NORMAL,
 120     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 121     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 122     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 123     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 124     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 125     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 126     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_OPEN_BRACE,
 127     TCL_NORMAL,        TCL_CLOSE_BRACE,   TCL_NORMAL,        TCL_NORMAL,
 128
 129     /*
 130      * Large unsigned character values, from 128-255:
 131      */
 132
 133     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 134     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 135     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 136     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 137     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 138     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 139     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 140     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 141     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 142     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 143     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 144     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 145     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 146     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 147     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 148     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 149     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 150     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 151     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 152     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 153     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 154     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 155     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 156     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 157     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 158     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 159     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 160     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 161     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 162     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 163     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 164     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
 165 };
 166
 167 /*
 168  * Function prototypes for procedures local to this file:
 169  */
 170
 171 static char *   QuoteEnd _ANSI_ARGS_((char *string, int term));
 172 static char *   ScriptEnd _ANSI_ARGS_((char *p, int nested));
 173 static char *   VarNameEnd _ANSI_ARGS_((char *string));
 174 \f
 175 /*
 176  *----------------------------------------------------------------------
 177  *
 178  * Tcl_Backslash --
 179  *
 180  *      Figure out how to handle a backslash sequence.
 181  *
 182  * Results:
 183  *      The return value is the character that should be substituted
 184  *      in place of the backslash sequence that starts at src.  If
 185  *      readPtr isn't NULL then it is filled in with a count of the
 186  *      number of characters in the backslash sequence.
 187  *
 188  * Side effects:
 189  *      None.
 190  *
 191  *----------------------------------------------------------------------
 192  */
 193
 194 char
 195 Tcl_Backslash(src, readPtr)
 196     char *src;                  /* Points to the backslash character of
 197                                  * a backslash sequence. */
 198     int *readPtr;               /* Fill in with number of characters read
 199                                  * from src, unless NULL. */
 200 {
 201     register char *p = src+1;
 202     char result;
 203     int count;
 204
 205     count = 2;
 206
 207     switch (*p) {
 208         case 'a':
 209             result = 0x7;       /* Don't say '\a' here, since some compilers */
 210             break;              /* don't support it. */
 211         case 'b':
 212             result = '\b';
 213             break;
 214         case 'f':
 215             result = '\f';
 216             break;
 217         case 'n':
 218             result = '\n';
 219             break;
 220         case 'r':
 221             result = '\r';
 222             break;
 223         case 't':
 224             result = '\t';
 225             break;
 226         case 'v':
 227             result = '\v';
 228             break;
 229         case 'x':
 230             if (isxdigit(UCHAR(p[1]))) {
 231                 char *end;
 232
 233                 result = (char) strtoul(p+1, &end, 16);
 234                 count = end - src;
 235             } else {
 236                 count = 2;
 237                 result = 'x';
 238             }
 239             break;
 240         case '\n':
 241             do {
 242                 p++;
 243             } while ((*p == ' ') || (*p == '\t'));
 244             result = ' ';
 245             count = p - src;
 246             break;
 247         case 0:
 248             result = '\\';
 249             count = 1;
 250             break;
 251         default:
 252             if (isdigit(UCHAR(*p))) {
 253                 result = (char)(*p - '0');
 254                 p++;
 255                 if (!isdigit(UCHAR(*p))) {
 256                     break;
 257                 }
 258                 count = 3;
 259                 result = (char)((result << 3) + (*p - '0'));
 260                 p++;
 261                 if (!isdigit(UCHAR(*p))) {
 262                     break;
 263                 }
 264                 count = 4;
 265                 result = (char)((result << 3) + (*p - '0'));
 266                 break;
 267             }
 268             result = *p;
 269             count = 2;
 270             break;
 271     }
 272
 273     if (readPtr != NULL) {
 274         *readPtr = count;
 275     }
 276     return result;
 277 }
 278 \f
 279 /*
 280  *--------------------------------------------------------------
 281  *
 282  * TclParseQuotes --
 283  *
 284  *      This procedure parses a double-quoted string such as a
 285  *      quoted Tcl command argument or a quoted value in a Tcl
 286  *      expression.  This procedure is also used to parse array
 287  *      element names within parentheses, or anything else that
 288  *      needs all the substitutions that happen in quotes.
 289  *
 290  * Results:
 291  *      The return value is a standard Tcl result, which is
 292  *      TCL_OK unless there was an error while parsing the
 293  *      quoted string.  If an error occurs then interp->result
 294  *      contains a standard error message.  *TermPtr is filled
 295  *      in with the address of the character just after the
 296  *      last one successfully processed;  this is usually the
 297  *      character just after the matching close-quote.  The
 298  *      fully-substituted contents of the quotes are stored in
 299  *      standard fashion in *pvPtr, null-terminated with
 300  *      pvPtr->next pointing to the terminating null character.
 301  *
 302  * Side effects:
 303  *      The buffer space in pvPtr may be enlarged by calling its
 304  *      expandProc.
 305  *
 306  *--------------------------------------------------------------
 307  */
 308
 309 int
 310 TclParseQuotes(interp, string, termChar, flags, termPtr, pvPtr)
 311     Tcl_Interp *interp;         /* Interpreter to use for nested command
 312                                  * evaluations and error messages. */
 313     char *string;               /* Character just after opening double-
 314                                  * quote. */
 315     int termChar;               /* Character that terminates "quoted" string
 316                                  * (usually double-quote, but sometimes
 317                                  * right-paren or something else). */
 318     int flags;                  /* Flags to pass to nested Tcl_Eval calls. */
 319     char **termPtr;             /* Store address of terminating character
 320                                  * here. */
 321     ParseValue *pvPtr;          /* Information about where to place
 322                                  * fully-substituted result of parse. */
 323 {
 324     register char *src, *dst, c;
 325
 326     src = string;
 327     dst = pvPtr->next;
 328
 329     while (1) {
 330         if (dst == pvPtr->end) {
 331             /*
 332              * Target buffer space is about to run out.  Make more space.
 333              */
 334
 335             pvPtr->next = dst;
 336             (*pvPtr->expandProc)(pvPtr, 1);
 337             dst = pvPtr->next;
 338         }
 339
 340         c = *src;
 341         src++;
 342         if (c == termChar) {
 343             *dst = '\0';
 344             pvPtr->next = dst;
 345             *termPtr = src;
 346             return TCL_OK;
 347         } else if (CHAR_TYPE(c) == TCL_NORMAL) {
 348             copy:
 349             *dst = c;
 350             dst++;
 351             continue;
 352         } else if (c == '$') {
 353             int length;
 354             char *value;
 355
 356             value = Tcl_ParseVar(interp, src-1, termPtr);
 357             if (value == NULL) {
 358                 return TCL_ERROR;
 359             }
 360             src = *termPtr;
 361             length = strlen(value);
 362             if ((pvPtr->end - dst) <= length) {
 363                 pvPtr->next = dst;
 364                 (*pvPtr->expandProc)(pvPtr, length);
 365                 dst = pvPtr->next;
 366             }
 367             strcpy(dst, value);
 368             dst += length;
 369             continue;
 370         } else if (c == '[') {
 371             int result;
 372
 373             pvPtr->next = dst;
 374             result = TclParseNestedCmd(interp, src, flags, termPtr, pvPtr);
 375             if (result != TCL_OK) {
 376                 return result;
 377             }
 378             src = *termPtr;
 379             dst = pvPtr->next;
 380             continue;
 381         } else if (c == '\\') {
 382             int numRead;
 383
 384             src--;
 385             *dst = Tcl_Backslash(src, &numRead);
 386             dst++;
 387             src += numRead;
 388             continue;
 389         } else if (c == '\0') {
 390             Tcl_ResetResult(interp);
 391             sprintf(interp->result, "missing %c", termChar);
 392             *termPtr = string-1;
 393             return TCL_ERROR;
 394         } else {
 395             goto copy;
 396         }
 397     }
 398 }
 399 \f
 400 /*
 401  *--------------------------------------------------------------
 402  *
 403  * TclParseNestedCmd --
 404  *
 405  *      This procedure parses a nested Tcl command between
 406  *      brackets, returning the result of the command.
 407  *
 408  * Results:
 409  *      The return value is a standard Tcl result, which is
 410  *      TCL_OK unless there was an error while executing the
 411  *      nested command.  If an error occurs then interp->result
 412  *      contains a standard error message.  *TermPtr is filled
 413  *      in with the address of the character just after the
 414  *      last one processed;  this is usually the character just
 415  *      after the matching close-bracket, or the null character
 416  *      at the end of the string if the close-bracket was missing
 417  *      (a missing close bracket is an error).  The result returned
 418  *      by the command is stored in standard fashion in *pvPtr,
 419  *      null-terminated, with pvPtr->next pointing to the null
 420  *      character.
 421  *
 422  * Side effects:
 423  *      The storage space at *pvPtr may be expanded.
 424  *
 425  *--------------------------------------------------------------
 426  */
 427
 428 int
 429 TclParseNestedCmd(interp, string, flags, termPtr, pvPtr)
 430     Tcl_Interp *interp;         /* Interpreter to use for nested command
 431                                  * evaluations and error messages. */
 432     char *string;               /* Character just after opening bracket. */
 433     int flags;                  /* Flags to pass to nested Tcl_Eval. */
 434     char **termPtr;             /* Store address of terminating character
 435                                  * here. */
 436     register ParseValue *pvPtr; /* Information about where to place
 437                                  * result of command. */
 438 {
 439     int result, length, shortfall;
 440     Interp *iPtr = (Interp *) interp;
 441
 442     iPtr->evalFlags = flags | TCL_BRACKET_TERM;
 443     result = Tcl_Eval(interp, string);
 444     *termPtr = iPtr->termPtr;
 445     if (result != TCL_OK) {
 446         /*
 447          * The increment below results in slightly cleaner message in
 448          * the errorInfo variable (the close-bracket will appear).
 449          */
 450
 451         if (**termPtr == ']') {
 452             *termPtr += 1;
 453         }
 454         return result;
 455     }
 456     (*termPtr) += 1;
 457     length = strlen(iPtr->result);
 458     shortfall = length + 1 - (pvPtr->end - pvPtr->next);
 459     if (shortfall > 0) {
 460         (*pvPtr->expandProc)(pvPtr, shortfall);
 461     }
 462     strcpy(pvPtr->next, iPtr->result);
 463     pvPtr->next += length;
 464     Tcl_FreeResult(iPtr);
 465     iPtr->result = iPtr->resultSpace;
 466     iPtr->resultSpace[0] = '\0';
 467     return TCL_OK;
 468 }
 469 \f
 470 /*
 471  *--------------------------------------------------------------
 472  *
 473  * TclParseBraces --
 474  *
 475  *      This procedure scans the information between matching
 476  *      curly braces.
 477  *
 478  * Results:
 479  *      The return value is a standard Tcl result, which is
 480  *      TCL_OK unless there was an error while parsing string.
 481  *      If an error occurs then interp->result contains a
 482  *      standard error message.  *TermPtr is filled
 483  *      in with the address of the character just after the
 484  *      last one successfully processed;  this is usually the
 485  *      character just after the matching close-brace.  The
 486  *      information between curly braces is stored in standard
 487  *      fashion in *pvPtr, null-terminated with pvPtr->next
 488  *      pointing to the terminating null character.
 489  *
 490  * Side effects:
 491  *      The storage space at *pvPtr may be expanded.
 492  *
 493  *--------------------------------------------------------------
 494  */
 495
 496 int
 497 TclParseBraces(interp, string, termPtr, pvPtr)
 498     Tcl_Interp *interp;         /* Interpreter to use for nested command
 499                                  * evaluations and error messages. */
 500     char *string;               /* Character just after opening bracket. */
 501     char **termPtr;             /* Store address of terminating character
 502                                  * here. */
 503     register ParseValue *pvPtr; /* Information about where to place
 504                                  * result of command. */
 505 {
 506     int level;
 507     register char *src, *dst, *end;
 508     register char c;
 509
 510     src = string;
 511     dst = pvPtr->next;
 512     end = pvPtr->end;
 513     level = 1;
 514
 515     /*
 516      * Copy the characters one at a time to the result area, stopping
 517      * when the matching close-brace is found.
 518      */
 519
 520     while (1) {
 521         c = *src;
 522         src++;
 523         if (dst == end) {
 524             pvPtr->next = dst;
 525             (*pvPtr->expandProc)(pvPtr, 20);
 526             dst = pvPtr->next;
 527             end = pvPtr->end;
 528         }
 529         *dst = c;
 530         dst++;
 531         if (CHAR_TYPE(c) == TCL_NORMAL) {
 532             continue;
 533         } else if (c == '{') {
 534             level++;
 535         } else if (c == '}') {
 536             level--;
 537             if (level == 0) {
 538                 dst--;                  /* Don't copy the last close brace. */
 539                 break;
 540             }
 541         } else if (c == '\\') {
 542             int count;
 543
 544             /*
 545              * Must always squish out backslash-newlines, even when in
 546              * braces.  This is needed so that this sequence can appear
 547              * anywhere in a command, such as the middle of an expression.
 548              */
 549
 550             if (*src == '\n') {
 551                 dst[-1] = Tcl_Backslash(src-1, &count);
 552                 src += count - 1;
 553             } else {
 554                 (void) Tcl_Backslash(src-1, &count);
 555                 while (count > 1) {
 556                     if (dst == end) {
 557                         pvPtr->next = dst;
 558                         (*pvPtr->expandProc)(pvPtr, 20);
 559                         dst = pvPtr->next;
 560                         end = pvPtr->end;
 561                     }
 562                     *dst = *src;
 563                     dst++;
 564                     src++;
 565                     count--;
 566                 }
 567             }
 568         } else if (c == '\0') {
 569             Tcl_SetResult(interp, "missing close-brace", TCL_STATIC);
 570             *termPtr = string-1;
 571             return TCL_ERROR;
 572         }
 573     }
 574
 575     *dst = '\0';
 576     pvPtr->next = dst;
 577     *termPtr = src;
 578     return TCL_OK;
 579 }
 580 \f
 581 /*
 582  *--------------------------------------------------------------
 583  *
 584  * TclParseWords --
 585  *
 586  *      This procedure parses one or more words from a command
 587  *      string and creates argv-style pointers to fully-substituted
 588  *      copies of those words.
 589  *
 590  * Results:
 591  *      The return value is a standard Tcl result.
 592  *
 593  *      *argcPtr is modified to hold a count of the number of words
 594  *      successfully parsed, which may be 0.  At most maxWords words
 595  *      will be parsed.  If 0 <= *argcPtr < maxWords then it
 596  *      means that a command separator was seen.  If *argcPtr
 597  *      is maxWords then it means that a command separator was
 598  *      not seen yet.
 599  *
 600  *      *TermPtr is filled in with the address of the character
 601  *      just after the last one successfully processed in the
 602  *      last word.  This is either the command terminator (if
 603  *      *argcPtr < maxWords), the character just after the last
 604  *      one in a word (if *argcPtr is maxWords), or the vicinity
 605  *      of an error (if the result is not TCL_OK).
 606  *
 607  *      The pointers at *argv are filled in with pointers to the
 608  *      fully-substituted words, and the actual contents of the
 609  *      words are copied to the buffer at pvPtr.
 610  *
 611  *      If an error occurrs then an error message is left in
 612  *      interp->result and the information at *argv, *argcPtr,
 613  *      and *pvPtr may be incomplete.
 614  *
 615  * Side effects:
 616  *      The buffer space in pvPtr may be enlarged by calling its
 617  *      expandProc.
 618  *
 619  *--------------------------------------------------------------
 620  */
 621
 622 int
 623 TclParseWords(interp, string, flags, maxWords, termPtr, argcPtr, argv, pvPtr)
 624     Tcl_Interp *interp;         /* Interpreter to use for nested command
 625                                  * evaluations and error messages. */
 626     char *string;               /* First character of word. */
 627     int flags;                  /* Flags to control parsing (same values as
 628                                  * passed to Tcl_Eval). */
 629     int maxWords;               /* Maximum number of words to parse. */
 630     char **termPtr;             /* Store address of terminating character
 631                                  * here. */
 632     int *argcPtr;               /* Filled in with actual number of words
 633                                  * parsed. */
 634     char **argv;                /* Store addresses of individual words here. */
 635     register ParseValue *pvPtr; /* Information about where to place
 636                                  * fully-substituted word. */
 637 {
 638     register char *src, *dst;
 639     register char c;
 640     int type, result, argc;
 641     char *oldBuffer;            /* Used to detect when pvPtr's buffer gets
 642                                  * reallocated, so we can adjust all of the
 643                                  * argv pointers. */
 644
 645     src = string;
 646     oldBuffer = pvPtr->buffer;
 647     dst = pvPtr->next;
 648     for (argc = 0; argc < maxWords; argc++) {
 649         argv[argc] = dst;
 650
 651         /*
 652          * Skip leading space.
 653          */
 654
 655         skipSpace:
 656         c = *src;
 657         type = CHAR_TYPE(c);
 658         while (type == TCL_SPACE) {
 659             src++;
 660             c = *src;
 661             type = CHAR_TYPE(c);
 662         }
 663
 664         /*
 665          * Handle the normal case (i.e. no leading double-quote or brace).
 666          */
 667
 668         if (type == TCL_NORMAL) {
 669             normalArg:
 670             while (1) {
 671                 if (dst == pvPtr->end) {
 672                     /*
 673                      * Target buffer space is about to run out.  Make
 674                      * more space.
 675                      */
 676
 677                     pvPtr->next = dst;
 678                     (*pvPtr->expandProc)(pvPtr, 1);
 679                     dst = pvPtr->next;
 680                 }
 681
 682                 if (type == TCL_NORMAL) {
 683                     copy:
 684                     *dst = c;
 685                     dst++;
 686                     src++;
 687                 } else if (type == TCL_SPACE) {
 688                     goto wordEnd;
 689                 } else if (type == TCL_DOLLAR) {
 690                     int length;
 691                     char *value;
 692
 693                     value = Tcl_ParseVar(interp, src, termPtr);
 694                     if (value == NULL) {
 695                         return TCL_ERROR;
 696                     }
 697                     src = *termPtr;
 698                     length = strlen(value);
 699                     if ((pvPtr->end - dst) <= length) {
 700                         pvPtr->next = dst;
 701                         (*pvPtr->expandProc)(pvPtr, length);
 702                         dst = pvPtr->next;
 703                     }
 704                     strcpy(dst, value);
 705                     dst += length;
 706                 } else if (type == TCL_COMMAND_END) {
 707                     if ((c == ']') && !(flags & TCL_BRACKET_TERM)) {
 708                         goto copy;
 709                     }
 710
 711                     /*
 712                      * End of command;  simulate a word-end first, so
 713                      * that the end-of-command can be processed as the
 714                      * first thing in a new word.
 715                      */
 716
 717                     goto wordEnd;
 718                 } else if (type == TCL_OPEN_BRACKET) {
 719                     pvPtr->next = dst;
 720                     result = TclParseNestedCmd(interp, src+1, flags, termPtr,
 721                             pvPtr);
 722                     if (result != TCL_OK) {
 723                         return result;
 724                     }
 725                     src = *termPtr;
 726                     dst = pvPtr->next;
 727                 } else if (type == TCL_BACKSLASH) {
 728                     int numRead;
 729
 730                     *dst = Tcl_Backslash(src, &numRead);
 731
 732                     /*
 733                      * The following special check allows a backslash-newline
 734                      * to be treated as a word-separator, as if the backslash
 735                      * and newline had been collapsed before command parsing
 736                      * began.
 737                      */
 738
 739                     if (src[1] == '\n') {
 740                         src += numRead;
 741                         goto wordEnd;
 742                     }
 743                     src += numRead;
 744                     dst++;
 745                 } else {
 746                     goto copy;
 747                 }
 748                 c = *src;
 749                 type = CHAR_TYPE(c);
 750             }
 751         } else {
 752
 753             /*
 754              * Check for the end of the command.
 755              */
 756
 757             if (type == TCL_COMMAND_END) {
 758                 if (flags & TCL_BRACKET_TERM) {
 759                     if (c == '\0') {
 760                         Tcl_SetResult(interp, "missing close-bracket",
 761                                 TCL_STATIC);
 762                         return TCL_ERROR;
 763                     }
 764                 } else {
 765                     if (c == ']') {
 766                         goto normalArg;
 767                     }
 768                 }
 769                 goto done;
 770             }
 771
 772             /*
 773              * Now handle the special cases: open braces, double-quotes,
 774              * and backslash-newline.
 775              */
 776
 777             pvPtr->next = dst;
 778             if (type == TCL_QUOTE) {
 779                 result = TclParseQuotes(interp, src+1, '"', flags,
 780                         termPtr, pvPtr);
 781             } else if (type == TCL_OPEN_BRACE) {
 782                 result = TclParseBraces(interp, src+1, termPtr, pvPtr);
 783             } else if ((type == TCL_BACKSLASH) && (src[1] == '\n')) {
 784                 /*
 785                  * This code is needed so that a backslash-newline at the
 786                  * very beginning of a word is treated as part of the white
 787                  * space between words and not as a space within the word.
 788                  */
 789
 790                 src += 2;
 791                 goto skipSpace;
 792             } else {
 793                 goto normalArg;
 794             }
 795             if (result != TCL_OK) {
 796                 return result;
 797             }
 798
 799             /*
 800              * Back from quotes or braces;  make sure that the terminating
 801              * character was the end of the word.
 802              */
 803
 804             c = **termPtr;
 805             if ((c == '\\') && ((*termPtr)[1] == '\n')) {
 806                 /*
 807                  * Line is continued on next line;  the backslash-newline
 808                  * sequence turns into space, which is OK.  No need to do
 809                  * anything here.
 810                  */
 811             } else {
 812                 type = CHAR_TYPE(c);
 813                 if ((type != TCL_SPACE) && (type != TCL_COMMAND_END)) {
 814                     if (*src == '"') {
 815                         Tcl_SetResult(interp,
 816                                 "extra characters after close-quote",
 817                                 TCL_STATIC);
 818                     } else {
 819                         Tcl_SetResult(interp,
 820                                 "extra characters after close-brace",
 821                                 TCL_STATIC);
 822                     }
 823                     return TCL_ERROR;
 824                 }
 825             }
 826             src = *termPtr;
 827             dst = pvPtr->next;
 828         }
 829
 830         /*
 831          * We're at the end of a word, so add a null terminator.  Then
 832          * see if the buffer was re-allocated during this word.  If so,
 833          * update all of the argv pointers.
 834          */
 835
 836         wordEnd:
 837         *dst = '\0';
 838         dst++;
 839         if (oldBuffer != pvPtr->buffer) {
 840             int i;
 841
 842             for (i = 0; i <= argc; i++) {
 843                 argv[i] = pvPtr->buffer + (argv[i] - oldBuffer);
 844             }
 845             oldBuffer = pvPtr->buffer;
 846         }
 847     }
 848
 849     done:
 850     pvPtr->next = dst;
 851     *termPtr = src;
 852     *argcPtr = argc;
 853     return TCL_OK;
 854 }
 855 \f
 856 /*
 857  *--------------------------------------------------------------
 858  *
 859  * TclExpandParseValue --
 860  *
 861  *      This procedure is commonly used as the value of the
 862  *      expandProc in a ParseValue.  It uses malloc to allocate
 863  *      more space for the result of a parse.
 864  *
 865  * Results:
 866  *      The buffer space in *pvPtr is reallocated to something
 867  *      larger, and if pvPtr->clientData is non-zero the old
 868  *      buffer is freed.  Information is copied from the old
 869  *      buffer to the new one.
 870  *
 871  * Side effects:
 872  *      None.
 873  *
 874  *--------------------------------------------------------------
 875  */
 876
 877 void
 878 TclExpandParseValue(pvPtr, needed)
 879     register ParseValue *pvPtr;         /* Information about buffer that
 880                                          * must be expanded.  If the clientData
 881                                          * in the structure is non-zero, it
 882                                          * means that the current buffer is
 883                                          * dynamically allocated. */
 884     int needed;                         /* Minimum amount of additional space
 885                                          * to allocate. */
 886 {
 887     int newSpace;
 888     char *new;
 889
 890     /*
 891      * Either double the size of the buffer or add enough new space
 892      * to meet the demand, whichever produces a larger new buffer.
 893      */
 894
 895     newSpace = (pvPtr->end - pvPtr->buffer) + 1;
 896     if (newSpace < needed) {
 897         newSpace += needed;
 898     } else {
 899         newSpace += newSpace;
 900     }
 901     new = (char *) ckalloc((unsigned) newSpace);
 902
 903     /*
 904      * Copy from old buffer to new, free old buffer if needed, and
 905      * mark new buffer as malloc-ed.
 906      */
 907
 908     memcpy((VOID *) new, (VOID *) pvPtr->buffer,
 909             (size_t) (pvPtr->next - pvPtr->buffer));
 910     pvPtr->next = new + (pvPtr->next - pvPtr->buffer);
 911     if (pvPtr->clientData != 0) {
 912         ckfree(pvPtr->buffer);
 913     }
 914     pvPtr->buffer = new;
 915     pvPtr->end = new + newSpace - 1;
 916     pvPtr->clientData = (ClientData) 1;
 917 }
 918 \f
 919 /*
 920  *----------------------------------------------------------------------
 921  *
 922  * TclWordEnd --
 923  *
 924  *      Given a pointer into a Tcl command, find the end of the next
 925  *      word of the command.
 926  *
 927  * Results:
 928  *      The return value is a pointer to the last character that's part
 929  *      of the word pointed to by "start".  If the word doesn't end
 930  *      properly within the string then the return value is the address
 931  *      of the null character at the end of the string.
 932  *
 933  * Side effects:
 934  *      None.
 935  *
 936  *----------------------------------------------------------------------
 937  */
 938
 939 char *
 940 TclWordEnd(start, nested, semiPtr)
 941     char *start;                /* Beginning of a word of a Tcl command. */
 942     int nested;                 /* Zero means this is a top-level command.
 943                                  * One means this is a nested command (close
 944                                  * bracket is a word terminator). */
 945     int *semiPtr;               /* Set to 1 if word ends with a command-
 946                                  * terminating semi-colon, zero otherwise.
 947                                  * If NULL then ignored. */
 948 {
 949     register char *p;
 950     int count;
 951
 952     if (semiPtr != NULL) {
 953         *semiPtr = 0;
 954     }
 955
 956     /*
 957      * Skip leading white space (backslash-newline must be treated like
 958      * white-space, except that it better not be the last thing in the
 959      * command).
 960      */
 961
 962     for (p = start; ; p++) {
 963         if (isspace(UCHAR(*p))) {
 964             continue;
 965         }
 966         if ((p[0] == '\\') && (p[1] == '\n')) {
 967             if (p[2] == 0) {
 968                 return p+2;
 969             }
 970             continue;
 971         }
 972         break;
 973     }
 974
 975     /*
 976      * Handle words beginning with a double-quote or a brace.
 977      */
 978
 979     if (*p == '"') {
 980         p = QuoteEnd(p+1, '"');
 981         if (*p == 0) {
 982             return p;
 983         }
 984         p++;
 985     } else if (*p == '{') {
 986         int braces = 1;
 987         while (braces != 0) {
 988             p++;
 989             while (*p == '\\') {
 990                 (void) Tcl_Backslash(p, &count);
 991                 p += count;
 992             }
 993             if (*p == '}') {
 994                 braces--;
 995             } else if (*p == '{') {
 996                 braces++;
 997             } else if (*p == 0) {
 998                 return p;
 999             }
1000         }
1001         p++;
1002     }
1003
1004     /*
1005      * Handle words that don't start with a brace or double-quote.
1006      * This code is also invoked if the word starts with a brace or
1007      * double-quote and there is garbage after the closing brace or
1008      * quote.  This is an error as far as Tcl_Eval is concerned, but
1009      * for here the garbage is treated as part of the word.
1010      */
1011
1012     while (1) {
1013         if (*p == '[') {
1014             p = ScriptEnd(p+1, 1);
1015             if (*p == 0) {
1016                 return p;
1017             }
1018             p++;
1019         } else if (*p == '\\') {
1020             if (p[1] == '\n') {
1021                 /*
1022                  * Backslash-newline:  it maps to a space character
1023                  * that is a word separator, so the word ends just before
1024                  * the backslash.
1025                  */
1026
1027                 return p-1;
1028             }
1029             (void) Tcl_Backslash(p, &count);
1030             p += count;
1031         } else if (*p == '$') {
1032             p = VarNameEnd(p);
1033             if (*p == 0) {
1034                 return p;
1035             }
1036             p++;
1037         } else if (*p == ';') {
1038             /*
1039              * Include the semi-colon in the word that is returned.
1040              */
1041
1042             if (semiPtr != NULL) {
1043                 *semiPtr = 1;
1044             }
1045             return p;
1046         } else if (isspace(UCHAR(*p))) {
1047             return p-1;
1048         } else if ((*p == ']') && nested) {
1049             return p-1;
1050         } else if (*p == 0) {
1051             if (nested) {
1052                 /*
1053                  * Nested commands can't end because of the end of the
1054                  * string.
1055                  */
1056                 return p;
1057             }
1058             return p-1;
1059         } else {
1060             p++;
1061         }
1062     }
1063 }
1064 \f
1065 /*
1066  *----------------------------------------------------------------------
1067  *
1068  * QuoteEnd --
1069  *
1070  *      Given a pointer to a string that obeys the parsing conventions
1071  *      for quoted things in Tcl, find the end of that quoted thing.
1072  *      The actual thing may be a quoted argument or a parenthesized
1073  *      index name.
1074  *
1075  * Results:
1076  *      The return value is a pointer to the last character that is
1077  *      part of the quoted string (i.e the character that's equal to
1078  *      term).  If the quoted string doesn't terminate properly then
1079  *      the return value is a pointer to the null character at the
1080  *      end of the string.
1081  *
1082  * Side effects:
1083  *      None.
1084  *
1085  *----------------------------------------------------------------------
1086  */
1087
1088 static char *
1089 QuoteEnd(string, term)
1090     char *string;               /* Pointer to character just after opening
1091                                  * "quote". */
1092     int term;                   /* This character will terminate the
1093                                  * quoted string (e.g. '"' or ')'). */
1094 {
1095     register char *p = string;
1096     int count;
1097
1098     while (*p != term) {
1099         if (*p == '\\') {
1100             (void) Tcl_Backslash(p, &count);
1101             p += count;
1102         } else if (*p == '[') {
1103             for (p++; *p != ']'; p++) {
1104                 p = TclWordEnd(p, 1, (int *) NULL);
1105                 if (*p == 0) {
1106                     return p;
1107                 }
1108             }
1109             p++;
1110         } else if (*p == '$') {
1111             p = VarNameEnd(p);
1112             if (*p == 0) {
1113                 return p;
1114             }
1115             p++;
1116         } else if (*p == 0) {
1117             return p;
1118         } else {
1119             p++;
1120         }
1121     }
1122     return p-1;
1123 }
1124 \f
1125 /*
1126  *----------------------------------------------------------------------
1127  *
1128  * VarNameEnd --
1129  *
1130  *      Given a pointer to a variable reference using $-notation, find
1131  *      the end of the variable name spec.
1132  *
1133  * Results:
1134  *      The return value is a pointer to the last character that
1135  *      is part of the variable name.  If the variable name doesn't
1136  *      terminate properly then the return value is a pointer to the
1137  *      null character at the end of the string.
1138  *
1139  * Side effects:
1140  *      None.
1141  *
1142  *----------------------------------------------------------------------
1143  */
1144
1145 static char *
1146 VarNameEnd(string)
1147     char *string;               /* Pointer to dollar-sign character. */
1148 {
1149     register char *p = string+1;
1150
1151     if (*p == '{') {
1152         for (p++; (*p != '}') && (*p != 0); p++) {
1153             /* Empty loop body. */
1154         }
1155         return p;
1156     }
1157     while (isalnum(UCHAR(*p)) || (*p == '_')) {
1158         p++;
1159     }
1160     if ((*p == '(') && (p != string+1)) {
1161         return QuoteEnd(p+1, ')');
1162     }
1163     return p-1;
1164 }
1165
1166 \f
1167 /*
1168  *----------------------------------------------------------------------
1169  *
1170  * ScriptEnd --
1171  *
1172  *      Given a pointer to the beginning of a Tcl script, find the end of
1173  *      the script.
1174  *
1175  * Results:
1176  *      The return value is a pointer to the last character that's part
1177  *      of the script pointed to by "p".  If the command doesn't end
1178  *      properly within the string then the return value is the address
1179  *      of the null character at the end of the string.
1180  *
1181  * Side effects:
1182  *      None.
1183  *
1184  *----------------------------------------------------------------------
1185  */
1186
1187 static char *
1188 ScriptEnd(p, nested)
1189     char *p;                    /* Script to check. */
1190     int nested;                 /* Zero means this is a top-level command.
1191                                  * One means this is a nested command (the
1192                                  * last character of the script must be
1193                                  * an unquoted ]). */
1194 {
1195     int commentOK = 1;
1196     int length;
1197
1198     while (1) {
1199         while (isspace(UCHAR(*p))) {
1200             if (*p == '\n') {
1201                 commentOK = 1;
1202             }
1203             p++;
1204         }
1205         if ((*p == '#') && commentOK) {
1206             do {
1207                 if (*p == '\\') {
1208                     /*
1209                      * If the script ends with backslash-newline, then
1210                      * this command isn't complete.
1211                      */
1212
1213                     if ((p[1] == '\n') && (p[2] == 0)) {
1214                         return p+2;
1215                     }
1216                     Tcl_Backslash(p, &length);
1217                     p += length;
1218                 } else {
1219                     p++;
1220                 }
1221             } while ((*p != 0) && (*p != '\n'));
1222             continue;
1223         }
1224         p = TclWordEnd(p, nested, &commentOK);
1225         if (*p == 0) {
1226             return p;
1227         }
1228         p++;
1229         if (nested) {
1230             if (*p == ']') {
1231                 return p;
1232             }
1233         } else {
1234             if (*p == 0) {
1235                 return p-1;
1236             }
1237         }
1238     }
1239 }
1240 \f
1241 /*
1242  *----------------------------------------------------------------------
1243  *
1244  * Tcl_ParseVar --
1245  *
1246  *      Given a string starting with a $ sign, parse off a variable
1247  *      name and return its value.
1248  *
1249  * Results:
1250  *      The return value is the contents of the variable given by
1251  *      the leading characters of string.  If termPtr isn't NULL,
1252  *      *termPtr gets filled in with the address of the character
1253  *      just after the last one in the variable specifier.  If the
1254  *      variable doesn't exist, then the return value is NULL and
1255  *      an error message will be left in interp->result.
1256  *
1257  * Side effects:
1258  *      None.
1259  *
1260  *----------------------------------------------------------------------
1261  */
1262
1263 char *
1264 Tcl_ParseVar(interp, string, termPtr)
1265     Tcl_Interp *interp;                 /* Context for looking up variable. */
1266     register char *string;              /* String containing variable name.
1267                                          * First character must be "$". */
1268     char **termPtr;                     /* If non-NULL, points to word to fill
1269                                          * in with character just after last
1270                                          * one in the variable specifier. */
1271
1272 {
1273     char *name1, *name1End, c, *result;
1274     register char *name2;
1275 #define NUM_CHARS 200
1276     char copyStorage[NUM_CHARS];
1277     ParseValue pv;
1278
1279     /*
1280      * There are three cases:
1281      * 1. The $ sign is followed by an open curly brace.  Then the variable
1282      *    name is everything up to the next close curly brace, and the
1283      *    variable is a scalar variable.
1284      * 2. The $ sign is not followed by an open curly brace.  Then the
1285      *    variable name is everything up to the next character that isn't
1286      *    a letter, digit, or underscore.  If the following character is an
1287      *    open parenthesis, then the information between parentheses is
1288      *    the array element name, which can include any of the substitutions
1289      *    permissible between quotes.
1290      * 3. The $ sign is followed by something that isn't a letter, digit,
1291      *    or underscore:  in this case, there is no variable name, and "$"
1292      *    is returned.
1293      */
1294
1295     name2 = NULL;
1296     string++;
1297     if (*string == '{') {
1298         string++;
1299         name1 = string;
1300         while (*string != '}') {
1301             if (*string == 0) {
1302                 Tcl_SetResult(interp, "missing close-brace for variable name",
1303                         TCL_STATIC);
1304                 if (termPtr != 0) {
1305                     *termPtr = string;
1306                 }
1307                 return NULL;
1308             }
1309             string++;
1310         }
1311         name1End = string;
1312         string++;
1313     } else {
1314         name1 = string;
1315         while (isalnum(UCHAR(*string)) || (*string == '_')) {
1316             string++;
1317         }
1318         if (string == name1) {
1319             if (termPtr != 0) {
1320                 *termPtr = string;
1321             }
1322             return "$";
1323         }
1324         name1End = string;
1325         if (*string == '(') {
1326             char *end;
1327
1328             /*
1329              * Perform substitutions on the array element name, just as
1330              * is done for quotes.
1331              */
1332
1333             pv.buffer = pv.next = copyStorage;
1334             pv.end = copyStorage + NUM_CHARS - 1;
1335             pv.expandProc = TclExpandParseValue;
1336             pv.clientData = (ClientData) NULL;
1337             if (TclParseQuotes(interp, string+1, ')', 0, &end, &pv)
1338                     != TCL_OK) {
1339                 char msg[200];
1340                 int length;
1341
1342                 length = string-name1;
1343                 if (length > 100) {
1344                     length = 100;
1345                 }
1346                 sprintf(msg, "\n    (parsing index for array \"%.*s\")",
1347                         length, name1);
1348                 Tcl_AddErrorInfo(interp, msg);
1349                 result = NULL;
1350                 name2 = pv.buffer;
1351                 if (termPtr != 0) {
1352                     *termPtr = end;
1353                 }
1354                 goto done;
1355             }
1356             Tcl_ResetResult(interp);
1357             string = end;
1358             name2 = pv.buffer;
1359         }
1360     }
1361     if (termPtr != 0) {
1362         *termPtr = string;
1363     }
1364
1365     if (((Interp *) interp)->noEval) {
1366         return "";
1367     }
1368     c = *name1End;
1369     *name1End = 0;
1370     result = Tcl_GetVar2(interp, name1, name2, TCL_LEAVE_ERR_MSG);
1371     *name1End = c;
1372
1373     done:
1374     if ((name2 != NULL) && (pv.buffer != copyStorage)) {
1375         ckfree(pv.buffer);
1376     }
1377     return result;
1378 }
1379 \f
1380 /*
1381  *----------------------------------------------------------------------
1382  *
1383  * Tcl_CommandComplete --
1384  *
1385  *      Given a partial or complete Tcl command, this procedure
1386  *      determines whether the command is complete in the sense
1387  *      of having matched braces and quotes and brackets.
1388  *
1389  * Results:
1390  *      1 is returned if the command is complete, 0 otherwise.
1391  *
1392  * Side effects:
1393  *      None.
1394  *
1395  *----------------------------------------------------------------------
1396  */
1397
1398 int
1399 Tcl_CommandComplete(cmd)
1400     char *cmd;                  /* Command to check. */
1401 {
1402     char *p;
1403
1404     if (*cmd == 0) {
1405         return 1;
1406     }
1407     p = ScriptEnd(cmd, 0);
1408     return (*p != 0);
1409 }