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