user/tinytcl/tclParse.c

   1 /*
   2  * vi:ts=8
   3  *
   4  * tclParse.c --
   5  *
   6  *      This file contains a collection of procedures that are used
   7  *      to parse Tcl commands or parts of commands (like quoted
   8  *      strings or nested sub-commands).
   9  *
  10  * Copyright 1991 Regents of the University of California.
  11  * Permission to use, copy, modify, and distribute this
  12  * software and its documentation for any purpose and without
  13  * fee is hereby granted, provided that the above copyright
  14  * notice appear in all copies.  The University of California
  15  * makes no representations about the suitability of this
  16  * software for any purpose.  It is provided "as is" without
  17  * express or implied warranty.
  18  *
  19  * $Id: tclParse.c,v 1.1.1.1 2001/04/29 20:35:00 karll Exp $
  20  */
  21
  22 #include "tclInt.h"
  23
  24 /*
  25  * The following table assigns a type to each character.  Only types
  26  * meaningful to Tcl parsing are represented here.  The table indexes
  27  * all 256 characters, with the negative ones first, then the positive
  28  * ones.
  29  */
  30
  31 char tclTypeTable[] = {
  32     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  33     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  34     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  35     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  36     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  37     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  38     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  39     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  40     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  41     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  42     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  43     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  44     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  45     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  46     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  47     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  48     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  49     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  50     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  51     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  52     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  53     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  54     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  55     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  56     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  57     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  58     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  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_COMMAND_END,   TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  65     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  66     TCL_NORMAL,        TCL_SPACE,         TCL_COMMAND_END,   TCL_SPACE,
  67     TCL_SPACE,         TCL_SPACE,         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_SPACE,         TCL_NORMAL,        TCL_QUOTE,         TCL_NORMAL,
  73     TCL_DOLLAR,        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_COMMAND_END,
  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_OPEN_BRACKET,
  87     TCL_BACKSLASH,     TCL_COMMAND_END,   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     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  92     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  93     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,
  94     TCL_NORMAL,        TCL_NORMAL,        TCL_NORMAL,        TCL_OPEN_BRACE,
  95     TCL_NORMAL,        TCL_CLOSE_BRACE,   TCL_NORMAL,        TCL_NORMAL,
  96 };
  97
  98 /*
  99  * Function prototypes for procedures local to this file:
 100  */
 101
 102 static char *   QuoteEnd _ANSI_ARGS_((char *string, int term));
 103 static char *   VarNameEnd _ANSI_ARGS_((char *string));
 104 \f
 105 /*
 106  *----------------------------------------------------------------------
 107  *
 108  * Tcl_Backslash --
 109  *
 110  *      Figure out how to handle a backslash sequence.
 111  *
 112  * Results:
 113  *      The return value is the character that should be substituted
 114  *      in place of the backslash sequence that starts at src, or 0
 115  *      if the backslash sequence should be replace by nothing (e.g.
 116  *      backslash followed by newline).  If readPtr isn't NULL then
 117  *      it is filled in with a count of the number of characters in
 118  *      the backslash sequence.  Note:  if the backslash isn't followed
 119  *      by characters that are understood here, then the backslash
 120  *      sequence is only considered to be one character long, and it
 121  *      is replaced by a backslash char.
 122  *
 123  * Side effects:
 124  *      None.
 125  *
 126  *----------------------------------------------------------------------
 127  */
 128
 129 char
 130 Tcl_Backslash(src, readPtr)
 131     CONST char *src;                    /* Points to the backslash character of
 132                                  * a backslash sequence. */
 133     int *readPtr;               /* Fill in with number of characters read
 134                                  * from src, unless NULL. */
 135 {
 136     register CONST char *p = src+1;
 137     char result;
 138     int count;
 139
 140     count = 2;
 141
 142     switch (*p) {
 143         case 'b':
 144             result = '\b';
 145             break;
 146         case 'e':
 147             result = 033;
 148             break;
 149         case 'f':
 150             result = '\f';
 151             break;
 152         case 'n':
 153             result = '\n';
 154             break;
 155         case 'r':
 156             result = '\r';
 157             break;
 158         case 't':
 159             result = '\t';
 160             break;
 161         case 'v':
 162             result = '\v';
 163             break;
 164         case 'C':
 165             p++;
 166             if (isspace(*p) || (*p == 0)) {
 167                 result = 'C';
 168                 count = 1;
 169                 break;
 170             }
 171             count = 3;
 172             if (*p == 'M') {
 173                 p++;
 174                 if (isspace(*p) || (*p == 0)) {
 175                     result = 'M' & 037;
 176                     break;
 177                 }
 178                 count = 4;
 179                 result = (*p & 037) | '\200';
 180                 break;
 181             }
 182             count = 3;
 183             result = *p & 037;
 184             break;
 185         case 'M':
 186             p++;
 187             if (isspace(*p) || (*p == 0)) {
 188                 result = 'M';
 189                 count = 1;
 190                 break;
 191             }
 192             count = 3;
 193             result = *p + '\200';
 194             break;
 195         case '}':
 196         case '{':
 197         case ']':
 198         case '[':
 199         case '$':
 200         case ' ':
 201         case ';':
 202         case '"':
 203         case '\\':
 204             result = *p;
 205             break;
 206         case '\n':
 207             result = 0;
 208             break;
 209         default:
 210             if (isdigit(*p)) {
 211                 result = *p - '0';
 212                 p++;
 213                 if (!isdigit(*p)) {
 214                     break;
 215                 }
 216                 count = 3;
 217                 result = (result << 3) + (*p - '0');
 218                 p++;
 219                 if (!isdigit(*p)) {
 220                     break;
 221                 }
 222                 count = 4;
 223                 result = (result << 3) + (*p - '0');
 224                 break;
 225             }
 226             result = '\\';
 227             count = 1;
 228             break;
 229     }
 230
 231     if (readPtr != NULL) {
 232         *readPtr = count;
 233     }
 234     return result;
 235 }
 236 \f
 237 /*
 238  *--------------------------------------------------------------
 239  *
 240  * TclParseQuotes --
 241  *
 242  *      This procedure parses a double-quoted string such as a
 243  *      quoted Tcl command argument or a quoted value in a Tcl
 244  *      expression.  This procedure is also used to parse array
 245  *      element names within parentheses, or anything else that
 246  *      needs all the substitutions that happen in quotes.
 247  *
 248  * Results:
 249  *      The return value is a standard Tcl result, which is
 250  *      TCL_OK unless there was an error while parsing the
 251  *      quoted string.  If an error occurs then interp->result
 252  *      contains a standard error message.  *TermPtr is filled
 253  *      in with the address of the character just after the
 254  *      last one successfully processed;  this is usually the
 255  *      character just after the matching close-quote.  The
 256  *      fully-substituted contents of the quotes are stored in
 257  *      standard fashion in *pvPtr, null-terminated with
 258  *      pvPtr->next pointing to the terminating null character.
 259  *
 260  * Side effects:
 261  *      The buffer space in pvPtr may be enlarged by calling its
 262  *      expandProc.
 263  *
 264  *--------------------------------------------------------------
 265  */
 266
 267 int
 268 TclParseQuotes(interp, string, termChar, flags, termPtr, pvPtr)
 269     Tcl_Interp *interp;         /* Interpreter to use for nested command
 270                                  * evaluations and error messages. */
 271     char *string;               /* Character just after opening double-
 272                                  * quote. */
 273     int termChar;               /* Character that terminates "quoted" string
 274                                  * (usually double-quote, but sometimes
 275                                  * right-paren or something else). */
 276     int flags;                  /* Flags to pass to nested Tcl_Eval calls. */
 277     char **termPtr;             /* Store address of terminating character
 278                                  * here. */
 279     ParseValue *pvPtr;          /* Information about where to place
 280                                  * fully-substituted result of parse. */
 281 {
 282     register char *src, *dst;
 283     int c;
 284
 285     src = string;
 286     dst = pvPtr->next;
 287
 288     while (1) {
 289         if (dst == pvPtr->end) {
 290             /*
 291              * Target buffer space is about to run out.  Make more space.
 292              */
 293
 294             pvPtr->next = dst;
 295             (*pvPtr->expandProc)(pvPtr, 1);
 296             dst = pvPtr->next;
 297         }
 298
 299         c = *src;
 300         src++;
 301         if (c == termChar) {
 302             *dst = '\0';
 303             pvPtr->next = dst;
 304             *termPtr = src;
 305             return TCL_OK;
 306         } else if (CHAR_TYPE(c) == TCL_NORMAL) {
 307             copy:
 308             *dst = c;
 309             dst++;
 310             continue;
 311         } else if (c == '$') {
 312             int length;
 313             char *value;
 314
 315             value = Tcl_ParseVar(interp, src-1, termPtr);
 316             if (value == NULL) {
 317                 return TCL_ERROR;
 318             }
 319             src = *termPtr;
 320             length = strlen(value);
 321             if ((pvPtr->end - dst) <= length) {
 322                 pvPtr->next = dst;
 323                 (*pvPtr->expandProc)(pvPtr, length);
 324                 dst = pvPtr->next;
 325             }
 326             strcpy(dst, value);
 327             dst += length;
 328             continue;
 329         } else if (c == '[') {
 330             int result;
 331
 332             pvPtr->next = dst;
 333             result = TclParseNestedCmd(interp, src, flags, termPtr, pvPtr);
 334             if (result != TCL_OK) {
 335                 return result;
 336             }
 337             src = *termPtr;
 338             dst = pvPtr->next;
 339             continue;
 340         } else if (c == '\\') {
 341             int numRead;
 342
 343             src--;
 344             *dst = Tcl_Backslash(src, &numRead);
 345             if (*dst != 0) {
 346                 dst++;
 347             }
 348             src += numRead;
 349             continue;
 350         } else if (c == '\0') {
 351             Tcl_ResetResult(interp);
 352             sprintf(interp->result, "missing %c", termChar);
 353             *termPtr = string-1;
 354             return TCL_ERROR;
 355         } else {
 356             goto copy;
 357         }
 358     }
 359 }
 360 \f
 361 /*
 362  *--------------------------------------------------------------
 363  *
 364  * TclParseNestedCmd --
 365  *
 366  *      This procedure parses a nested Tcl command between
 367  *      brackets, returning the result of the command.
 368  *
 369  * Results:
 370  *      The return value is a standard Tcl result, which is
 371  *      TCL_OK unless there was an error while executing the
 372  *      nested command.  If an error occurs then interp->result
 373  *      contains a standard error message.  *TermPtr is filled
 374  *      in with the address of the character just after the
 375  *      last one processed;  this is usually the character just
 376  *      after the matching close-bracket, or the null character
 377  *      at the end of the string if the close-bracket was missing
 378  *      (a missing close bracket is an error).  The result returned
 379  *      by the command is stored in standard fashion in *pvPtr,
 380  *      null-terminated, with pvPtr->next pointing to the null
 381  *      character.
 382  *
 383  * Side effects:
 384  *      The storage space at *pvPtr may be expanded.
 385  *
 386  *--------------------------------------------------------------
 387  */
 388
 389 int
 390 TclParseNestedCmd(interp, string, flags, termPtr, pvPtr)
 391     Tcl_Interp *interp;         /* Interpreter to use for nested command
 392                                  * evaluations and error messages. */
 393     char *string;               /* Character just after opening bracket. */
 394     int flags;                  /* Flags to pass to nested Tcl_Eval. */
 395     char **termPtr;             /* Store address of terminating character
 396                                  * here. */
 397     register ParseValue *pvPtr; /* Information about where to place
 398                                  * result of command. */
 399 {
 400     int result, length, shortfall;
 401     Interp *iPtr = (Interp *) interp;
 402
 403     result = Tcl_Eval(interp, string, flags | TCL_BRACKET_TERM, termPtr);
 404     if (result != TCL_OK) {
 405         /*
 406          * The increment below results in slightly cleaner message in
 407          * the errorInfo variable (the close-bracket will appear).
 408          */
 409
 410         if (**termPtr == ']') {
 411             *termPtr += 1;
 412         }
 413         return result;
 414     }
 415     (*termPtr) += 1;
 416     length = strlen(iPtr->result);
 417     shortfall = length + 1 - (pvPtr->end - pvPtr->next);
 418     if (shortfall > 0) {
 419         (*pvPtr->expandProc)(pvPtr, shortfall);
 420     }
 421     strcpy(pvPtr->next, iPtr->result);
 422     pvPtr->next += length;
 423     Tcl_FreeResult(iPtr);
 424     iPtr->result = iPtr->resultSpace;
 425     iPtr->resultSpace[0] = '\0';
 426     return TCL_OK;
 427 }
 428 \f
 429 /*
 430  *--------------------------------------------------------------
 431  *
 432  * TclParseBraces --
 433  *
 434  *      This procedure scans the information between matching
 435  *      curly braces.
 436  *
 437  * Results:
 438  *      The return value is a standard Tcl result, which is
 439  *      TCL_OK unless there was an error while parsing string.
 440  *      If an error occurs then interp->result contains a
 441  *      standard error message.  *TermPtr is filled
 442  *      in with the address of the character just after the
 443  *      last one successfully processed;  this is usually the
 444  *      character just after the matching close-brace.  The
 445  *      information between curly braces is stored in standard
 446  *      fashion in *pvPtr, null-terminated with pvPtr->next
 447  *      pointing to the terminating null character.
 448  *
 449  * Side effects:
 450  *      The storage space at *pvPtr may be expanded.
 451  *
 452  *--------------------------------------------------------------
 453  */
 454
 455 int
 456 TclParseBraces(interp, string, termPtr, pvPtr)
 457     Tcl_Interp *interp;         /* Interpreter to use for nested command
 458                                  * evaluations and error messages. */
 459     char *string;               /* Character just after opening bracket. */
 460     char **termPtr;             /* Store address of terminating character
 461                                  * here. */
 462     register ParseValue *pvPtr; /* Information about where to place
 463                                  * result of command. */
 464 {
 465     int level;
 466     register char *src, *dst, *end;
 467     register int c;
 468
 469     src = string;
 470     dst = pvPtr->next;
 471     end = pvPtr->end;
 472     level = 1;
 473
 474     /*
 475      * Copy the characters one at a time to the result area, stopping
 476      * when the matching close-brace is found.
 477      */
 478
 479     while (1) {
 480         c = *src;
 481         src++;
 482         if (dst == end) {
 483             pvPtr->next = dst;
 484             (*pvPtr->expandProc)(pvPtr, 20);
 485             dst = pvPtr->next;
 486             end = pvPtr->end;
 487         }
 488         *dst = c;
 489         dst++;
 490         if (CHAR_TYPE(c) == TCL_NORMAL) {
 491             continue;
 492         } else if (c == '{') {
 493             level++;
 494         } else if (c == '}') {
 495             level--;
 496             if (level == 0) {
 497                 dst--;                  /* Don't copy the last close brace. */
 498                 break;
 499             }
 500         } else if (c == '\\') {
 501             int count;
 502
 503             /*
 504              * Must always squish out backslash-newlines, even when in
 505              * braces.  This is needed so that this sequence can appear
 506              * anywhere in a command, such as the middle of an expression.
 507              */
 508
 509             if (*src == '\n') {
 510                 dst--;
 511                 src++;
 512             } else {
 513                 (void) Tcl_Backslash(src-1, &count);
 514                 while (count > 1) {
 515                     if (dst == end) {
 516                         pvPtr->next = dst;
 517                         (*pvPtr->expandProc)(pvPtr, 20);
 518                         dst = pvPtr->next;
 519                         end = pvPtr->end;
 520                     }
 521                     *dst = *src;
 522                     dst++;
 523                     src++;
 524                     count--;
 525                 }
 526             }
 527         } else if (c == '\0') {
 528             Tcl_SetResult(interp, "missing close-brace", TCL_STATIC);
 529             *termPtr = string-1;
 530             return TCL_ERROR;
 531         }
 532     }
 533
 534     *dst = '\0';
 535     pvPtr->next = dst;
 536     *termPtr = src;
 537     return TCL_OK;
 538 }
 539 \f
 540 /*
 541  *--------------------------------------------------------------
 542  *
 543  * TclParseWords --
 544  *
 545  *      This procedure parses one or more words from a command
 546  *      string and creates argv-style pointers to fully-substituted
 547  *      copies of those words.
 548  *
 549  * Results:
 550  *      The return value is a standard Tcl result.
 551  *
 552  *      *argcPtr is modified to hold a count of the number of words
 553  *      successfully parsed, which may be 0.  At most maxWords words
 554  *      will be parsed.  If 0 <= *argcPtr < maxWords then it
 555  *      means that a command separator was seen.  If *argcPtr
 556  *      is maxWords then it means that a command separator was
 557  *      not seen yet.
 558  *
 559  *      *TermPtr is filled in with the address of the character
 560  *      just after the last one successfully processed in the
 561  *      last word.  This is either the command terminator (if
 562  *      *argcPtr < maxWords), the character just after the last
 563  *      one in a word (if *argcPtr is maxWords), or the vicinity
 564  *      of an error (if the result is not TCL_OK).
 565  *
 566  *      The pointers at *argv are filled in with pointers to the
 567  *      fully-substituted words, and the actual contents of the
 568  *      words are copied to the buffer at pvPtr.
 569  *
 570  *      If an error occurrs then an error message is left in
 571  *      interp->result and the information at *argv, *argcPtr,
 572  *      and *pvPtr may be incomplete.
 573  *
 574  * Side effects:
 575  *      The buffer space in pvPtr may be enlarged by calling its
 576  *      expandProc.
 577  *
 578  *--------------------------------------------------------------
 579  */
 580
 581 int
 582 TclParseWords(interp, string, flags, maxWords, termPtr, argcPtr, argv, pvPtr)
 583     Tcl_Interp *interp;         /* Interpreter to use for nested command
 584                                  * evaluations and error messages. */
 585     char *string;               /* First character of word. */
 586     int flags;                  /* Flags to control parsing (same values as
 587                                  * passed to Tcl_Eval). */
 588     int maxWords;               /* Maximum number of words to parse. */
 589     char **termPtr;             /* Store address of terminating character
 590                                  * here. */
 591     int *argcPtr;               /* Filled in with actual number of words
 592                                  * parsed. */
 593     char **argv;                /* Store addresses of individual words here. */
 594     register ParseValue *pvPtr; /* Information about where to place
 595                                  * fully-substituted word. */
 596 {
 597     register char *src, *dst;
 598     register int c;
 599     int type, result, argc;
 600     char *oldBuffer;            /* Used to detect when pvPtr's buffer gets
 601                                  * reallocated, so we can adjust all of the
 602                                  * argv pointers. */
 603
 604     src = string;
 605     oldBuffer = pvPtr->buffer;
 606     dst = pvPtr->next;
 607     for (argc = 0; argc < maxWords; argc++) {
 608         argv[argc] = dst;
 609
 610         /*
 611          * Skip leading space.
 612          */
 613
 614         skipSpace:
 615         c = *src;
 616         type = CHAR_TYPE(c);
 617         while (type == TCL_SPACE) {
 618             src++;
 619             c = *src;
 620             type = CHAR_TYPE(c);
 621         }
 622
 623         /*
 624          * Handle the normal case (i.e. no leading double-quote or brace).
 625          */
 626
 627         if (type == TCL_NORMAL) {
 628             normalArg:
 629             while (1) {
 630                 if (dst == pvPtr->end) {
 631                     /*
 632                      * Target buffer space is about to run out.  Make
 633                      * more space.
 634                      */
 635
 636                     pvPtr->next = dst;
 637                     (*pvPtr->expandProc)(pvPtr, 1);
 638                     dst = pvPtr->next;
 639                 }
 640
 641                 if (type == TCL_NORMAL) {
 642                     copy:
 643                     *dst = c;
 644                     dst++;
 645                     src++;
 646                 } else if (type == TCL_SPACE) {
 647                     goto wordEnd;
 648                 } else if (type == TCL_DOLLAR) {
 649                     int length;
 650                     char *value;
 651
 652                     value = Tcl_ParseVar(interp, src, termPtr);
 653                     if (value == NULL) {
 654                         return TCL_ERROR;
 655                     }
 656                     src = *termPtr;
 657                     length = strlen(value);
 658                     if ((pvPtr->end - dst) <= length) {
 659                         pvPtr->next = dst;
 660                         (*pvPtr->expandProc)(pvPtr, length);
 661                         dst = pvPtr->next;
 662                     }
 663                     strcpy(dst, value);
 664                     dst += length;
 665                 } else if (type == TCL_COMMAND_END) {
 666                     if ((c == ']') && !(flags & TCL_BRACKET_TERM)) {
 667                         goto copy;
 668                     }
 669
 670                     /*
 671                      * End of command;  simulate a word-end first, so
 672                      * that the end-of-command can be processed as the
 673                      * first thing in a new word.
 674                      */
 675
 676                     goto wordEnd;
 677                 } else if (type == TCL_OPEN_BRACKET) {
 678                     pvPtr->next = dst;
 679                     result = TclParseNestedCmd(interp, src+1, flags, termPtr,
 680                             pvPtr);
 681                     if (result != TCL_OK) {
 682                         return result;
 683                     }
 684                     src = *termPtr;
 685                     dst = pvPtr->next;
 686                 } else if (type == TCL_BACKSLASH) {
 687                     int numRead;
 688
 689                     *dst = Tcl_Backslash(src, &numRead);
 690                     if (*dst != 0) {
 691                         dst++;
 692                     }
 693                     src += numRead;
 694                 } else {
 695                     goto copy;
 696                 }
 697                 c = *src;
 698                 type = CHAR_TYPE(c);
 699             }
 700         } else {
 701
 702             /*
 703              * Check for the end of the command.
 704              */
 705
 706             if (type == TCL_COMMAND_END) {
 707                 if (flags & TCL_BRACKET_TERM) {
 708                     if (c == '\0') {
 709                         Tcl_SetResult(interp, "missing close-bracket",
 710                                 TCL_STATIC);
 711                         return TCL_ERROR;
 712                     }
 713                 } else {
 714                     if (c == ']') {
 715                         goto normalArg;
 716                     }
 717                 }
 718                 goto done;
 719             }
 720
 721             /*
 722              * Now handle the special cases: open braces, double-quotes,
 723              * and backslash-newline.
 724              */
 725
 726             pvPtr->next = dst;
 727             if (type == TCL_QUOTE) {
 728                 result = TclParseQuotes(interp, src+1, '"', flags,
 729                         termPtr, pvPtr);
 730             } else if (type == TCL_OPEN_BRACE) {
 731                 result = TclParseBraces(interp, src+1, termPtr, pvPtr);
 732             } else if ((type == TCL_BACKSLASH) && (src[1] == '\n')) {
 733                 src += 2;
 734                 goto skipSpace;
 735             } else {
 736                 goto normalArg;
 737             }
 738             if (result != TCL_OK) {
 739                 return result;
 740             }
 741
 742             /*
 743              * Back from quotes or braces;  make sure that the terminating
 744              * character was the end of the word.  Have to be careful here
 745              * to handle continuation lines (i.e. lines ending in backslash).
 746              */
 747
 748             c = **termPtr;
 749             if ((c == '\\') && ((*termPtr)[1] == '\n')) {
 750                 c = (*termPtr)[2];
 751             }
 752             type = CHAR_TYPE(c);
 753             if ((type != TCL_SPACE) && (type != TCL_COMMAND_END)) {
 754                 if (*src == '"') {
 755                     Tcl_SetResult(interp, "extra characters after close-quote",
 756                             TCL_STATIC);
 757                 } else {
 758                     Tcl_SetResult(interp, "extra characters after close-brace",
 759                             TCL_STATIC);
 760                 }
 761                 return TCL_ERROR;
 762             }
 763             src = *termPtr;
 764             dst = pvPtr->next;
 765
 766         }
 767
 768         /*
 769          * We're at the end of a word, so add a null terminator.  Then
 770          * see if the buffer was re-allocated during this word.  If so,
 771          * update all of the argv pointers.
 772          */
 773
 774         wordEnd:
 775         *dst = '\0';
 776         dst++;
 777         if (oldBuffer != pvPtr->buffer) {
 778             int i;
 779
 780             for (i = 0; i <= argc; i++) {
 781                 argv[i] = pvPtr->buffer + (argv[i] - oldBuffer);
 782             }
 783             oldBuffer = pvPtr->buffer;
 784         }
 785     }
 786
 787     done:
 788     pvPtr->next = dst;
 789     *termPtr = src;
 790     *argcPtr = argc;
 791     return TCL_OK;
 792 }
 793 \f
 794 /*
 795  *--------------------------------------------------------------
 796  *
 797  * TclExpandParseValue --
 798  *
 799  *      This procedure is commonly used as the value of the
 800  *      expandProc in a ParseValue.  It uses malloc to allocate
 801  *      more space for the result of a parse.
 802  *
 803  * Results:
 804  *      The buffer space in *pvPtr is reallocated to something
 805  *      larger, and if pvPtr->clientData is non-zero the old
 806  *      buffer is freed.  Information is copied from the old
 807  *      buffer to the new one.
 808  *
 809  * Side effects:
 810  *      None.
 811  *
 812  *--------------------------------------------------------------
 813  */
 814
 815 void
 816 TclExpandParseValue(pvPtr, needed)
 817     register ParseValue *pvPtr;         /* Information about buffer that
 818                                          * must be expanded.  If the clientData
 819                                          * in the structure is non-zero, it
 820                                          * means that the current buffer is
 821                                          * dynamically allocated. */
 822     int needed;                         /* Minimum amount of additional space
 823                                          * to allocate. */
 824 {
 825     int newSpace;
 826     char *new;
 827
 828     /*
 829      * Either double the size of the buffer or add enough new space
 830      * to meet the demand, whichever produces a larger new buffer.
 831      */
 832
 833     newSpace = (pvPtr->end - pvPtr->buffer) + 1;
 834     if (newSpace < needed) {
 835         newSpace += needed;
 836     } else {
 837         newSpace += newSpace;
 838     }
 839     new = (char *) ckalloc((unsigned) newSpace);
 840
 841     /*
 842      * Copy from old buffer to new, free old buffer if needed, and
 843      * mark new buffer as malloc-ed.
 844      */
 845
 846     memcpy((VOID *) new, (VOID *) pvPtr->buffer, pvPtr->next - pvPtr->buffer);
 847     pvPtr->next = new + (pvPtr->next - pvPtr->buffer);
 848     if (pvPtr->clientData != 0) {
 849         ckfree(pvPtr->buffer);
 850     }
 851     pvPtr->buffer = new;
 852     pvPtr->end = new + newSpace - 1;
 853     pvPtr->clientData = (ClientData) 1;
 854 }
 855 \f
 856 /*
 857  *----------------------------------------------------------------------
 858  *
 859  * TclWordEnd --
 860  *
 861  *      Given a pointer into a Tcl command, find the end of the next
 862  *      word of the command.
 863  *
 864  * Results:
 865  *      The return value is a pointer to the last character that's part
 866  *      of the word pointed to by "start".  If the word doesn't end
 867  *      properly within the string then the return value is the address
 868  *      of the null character at the end of the string.
 869  *
 870  * Side effects:
 871  *      None.
 872  *
 873  *----------------------------------------------------------------------
 874  */
 875
 876 char *
 877 TclWordEnd(start, nested)
 878     char *start;                /* Beginning of a word of a Tcl command. */
 879     int nested;                 /* Zero means this is a top-level command.
 880                                  * One means this is a nested command (close
 881                                  * brace is a word terminator). */
 882 {
 883     register char *p;
 884     int count;
 885
 886     p = start;
 887     while (isspace(*p)) {
 888         p++;
 889     }
 890
 891     /*
 892      * Handle words beginning with a double-quote or a brace.
 893      */
 894
 895     if (*p == '"') {
 896         p = QuoteEnd(p+1, '"');
 897         if (*p == 0) {
 898             return p;
 899         }
 900         p++;
 901     } else if (*p == '{') {
 902         int braces = 1;
 903         while (braces != 0) {
 904             p++;
 905             while (*p == '\\') {
 906                 (void) Tcl_Backslash(p, &count);
 907                 p += count;
 908             }
 909             if (*p == '}') {
 910                 braces--;
 911             } else if (*p == '{') {
 912                 braces++;
 913             } else if (*p == 0) {
 914                 return p;
 915             }
 916         }
 917         p++;
 918     }
 919
 920     /*
 921      * Handle words that don't start with a brace or double-quote.
 922      * This code is also invoked if the word starts with a brace or
 923      * double-quote and there is garbage after the closing brace or
 924      * quote.  This is an error as far as Tcl_Eval is concerned, but
 925      * for here the garbage is treated as part of the word.
 926      */
 927
 928     while (1) {
 929         if (*p == '[') {
 930             for (p++; *p != ']'; p++) {
 931                 p = TclWordEnd(p, 1);
 932                 if (*p == 0) {
 933                     return p;
 934                 }
 935             }
 936             p++;
 937         } else if (*p == '\\') {
 938             (void) Tcl_Backslash(p, &count);
 939             p += count;
 940             if ((*p == 0) && (count == 2) && (p[-1] == '\n')) {
 941                 return p;
 942             }
 943         } else if (*p == '$') {
 944             p = VarNameEnd(p);
 945             if (*p == 0) {
 946                 return p;
 947             }
 948             p++;
 949         } else if (*p == ';') {
 950             /*
 951              * Include the semi-colon in the word that is returned.
 952              */
 953
 954             return p;
 955         } else if (isspace(*p)) {
 956             return p-1;
 957         } else if ((*p == ']') && nested) {
 958             return p-1;
 959         } else if (*p == 0) {
 960             if (nested) {
 961                 /*
 962                  * Nested commands can't end because of the end of the
 963                  * string.
 964                  */
 965                 return p;
 966             }
 967             return p-1;
 968         } else {
 969             p++;
 970         }
 971     }
 972 }
 973 \f
 974 /*
 975  *----------------------------------------------------------------------
 976  *
 977  * QuoteEnd --
 978  *
 979  *      Given a pointer to a string that obeys the parsing conventions
 980  *      for quoted things in Tcl, find the end of that quoted thing.
 981  *      The actual thing may be a quoted argument or a parenthesized
 982  *      index name.
 983  *
 984  * Results:
 985  *      The return value is a pointer to the last character that is
 986  *      part of the quoted string (i.e the character that's equal to
 987  *      term).  If the quoted string doesn't terminate properly then
 988  *      the return value is a pointer to the null character at the
 989  *      end of the string.
 990  *
 991  * Side effects:
 992  *      None.
 993  *
 994  *----------------------------------------------------------------------
 995  */
 996
 997 static char *
 998 QuoteEnd(string, term)
 999     char *string;               /* Pointer to character just after opening
1000                                  * "quote". */
1001     int term;                   /* This character will terminate the
1002                                  * quoted string (e.g. '"' or ')'). */
1003 {
1004     register char *p = string;
1005     int count;
1006
1007     while (*p != term) {
1008         if (*p == '\\') {
1009             (void) Tcl_Backslash(p, &count);
1010             p += count;
1011         } else if (*p == '[') {
1012             for (p++; *p != ']'; p++) {
1013                 p = TclWordEnd(p, 1);
1014                 if (*p == 0) {
1015                     return p;
1016                 }
1017             }
1018             p++;
1019         } else if (*p == '$') {
1020             p = VarNameEnd(p);
1021             if (*p == 0) {
1022                 return p;
1023             }
1024             p++;
1025         } else if (*p == 0) {
1026             return p;
1027         } else {
1028             p++;
1029         }
1030     }
1031     return p-1;
1032 }
1033 \f
1034 /*
1035  *----------------------------------------------------------------------
1036  *
1037  * VarNameEnd --
1038  *
1039  *      Given a pointer to a variable reference using $-notation, find
1040  *      the end of the variable name spec.
1041  *
1042  * Results:
1043  *      The return value is a pointer to the last character that
1044  *      is part of the variable name.  If the variable name doesn't
1045  *      terminate properly then the return value is a pointer to the
1046  *      null character at the end of the string.
1047  *
1048  * Side effects:
1049  *      None.
1050  *
1051  *----------------------------------------------------------------------
1052  */
1053
1054 static char *
1055 VarNameEnd(string)
1056     char *string;               /* Pointer to dollar-sign character. */
1057 {
1058     register char *p = string+1;
1059
1060     if (*p == '{') {
1061         for (p++; (*p != '}') && (*p != 0); p++) {
1062             /* Empty loop body. */
1063         }
1064         return p;
1065     }
1066     /* Two leading colons are OK */
1067     if (p[0] == ':' && p[1] == ':') {
1068         p += 2;
1069     }
1070     while (isalnum(*p) || (*p == '_')) {
1071         p++;
1072     }
1073     if ((*p == '(') && (p != string+1)) {
1074         return QuoteEnd(p+1, ')');
1075     }
1076     return p-1;
1077 }
1078 \f
1079 /*
1080  *----------------------------------------------------------------------
1081  *
1082  * Tcl_ParseVar --
1083  *
1084  *      Given a string starting with a $ sign, parse off a variable
1085  *      name and return its value.
1086  *
1087  * Results:
1088  *      The return value is the contents of the variable given by
1089  *      the leading characters of string.  If termPtr isn't NULL,
1090  *      *termPtr gets filled in with the address of the character
1091  *      just after the last one in the variable specifier.  If the
1092  *      variable doesn't exist, then the return value is NULL and
1093  *      an error message will be left in interp->result.
1094  *
1095  * Side effects:
1096  *      None.
1097  *
1098  *----------------------------------------------------------------------
1099  */
1100
1101 char *
1102 Tcl_ParseVar(interp, string, termPtr)
1103     Tcl_Interp *interp;                 /* Context for looking up variable. */
1104     register char *string;              /* String containing variable name.
1105                                          * First character must be "$". */
1106     char **termPtr;                     /* If non-NULL, points to word to fill
1107                                          * in with character just after last
1108                                          * one in the variable specifier. */
1109
1110 {
1111     char *name1, *name1End, c, *result;
1112     register char *name2;
1113 #define NUM_CHARS 200
1114     char copyStorage[NUM_CHARS];
1115     ParseValue pv;
1116
1117     /*
1118      * There are three cases:
1119      * 1. The $ sign is followed by an open curly brace.  Then the variable
1120      *    name is everything up to the next close curly brace, and the
1121      *    variable is a scalar variable.
1122      * 2. The $ sign is not followed by an open curly brace.  Then the
1123      *    variable name is everything up to the next character that isn't
1124      *    a letter, digit, or underscore.  If the following character is an
1125      *    open parenthesis, then the information between parentheses is
1126      *    the array element name, which can include any of the substitutions
1127      *    permissible between quotes.
1128      * 3. The $ sign is followed by something that isn't a letter, digit, colon
1129      *    or underscore:  in this case, there is no variable name, and "$"
1130      *    is returned.
1131      */
1132
1133     name2 = NULL;
1134     string++;
1135     if (*string == '{') {
1136         string++;
1137         name1 = string;
1138         while (*string != '}') {
1139             if (*string == 0) {
1140                 Tcl_SetResult(interp, "missing close-brace for variable name",
1141                         TCL_STATIC);
1142                 if (termPtr != 0) {
1143                     *termPtr = string;
1144                 }
1145                 return NULL;
1146             }
1147             string++;
1148         }
1149         name1End = string;
1150         string++;
1151     } else {
1152         name1 = string;
1153         /* Two leading colons are OK */
1154         if (string[0] == ':' && string[1] == ':') {
1155             string += 2;
1156         }
1157         while (isalnum(*string) || (*string == '_')) {
1158             string++;
1159         }
1160         if (string == name1) {
1161             if (termPtr != 0) {
1162                 *termPtr = string;
1163             }
1164             return "$";
1165         }
1166         name1End = string;
1167         if (*string == '(') {
1168             char *end;
1169
1170             /*
1171              * Perform substitutions on the array element name, just as
1172              * is done for quotes.
1173              */
1174
1175             pv.buffer = pv.next = copyStorage;
1176             pv.end = copyStorage + NUM_CHARS - 1;
1177             pv.expandProc = TclExpandParseValue;
1178             pv.clientData = (ClientData) NULL;
1179             if (TclParseQuotes(interp, string+1, ')', 0, &end, &pv)
1180                     != TCL_OK) {
1181                 char msg[100];
1182                 sprintf(msg, "\n    (parsing index for array \"%.*s\")",
1183                         (int)(string-name1), name1);
1184                 Tcl_AddErrorInfo(interp, msg);
1185                 result = NULL;
1186                 name2 = pv.buffer;
1187                 if (termPtr != 0) {
1188                     *termPtr = end;
1189                 }
1190                 goto done;
1191             }
1192             string = end;
1193             name2 = pv.buffer;
1194         }
1195     }
1196     if (termPtr != 0) {
1197         *termPtr = string;
1198     }
1199
1200     if (((Interp *) interp)->noEval) {
1201         return "";
1202     }
1203     c = *name1End;
1204     *name1End = 0;
1205     result = Tcl_GetVar2(interp, name1, name2, TCL_LEAVE_ERR_MSG);
1206     *name1End = c;
1207
1208     done:
1209     if ((name2 != NULL) && (pv.buffer != copyStorage)) {
1210         ckfree(pv.buffer);
1211     }
1212     return result;
1213 }