home *** CD-ROM | disk | FTP | other *** search
/ ARM Club 3 / TheARMClub_PDCD3.iso / hensa / programming / tcl / tclsrc / c / tclParse < prev    next >
Encoding:
Text File  |  1996-01-28  |  36.8 KB  |  1,323 lines

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