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