home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tcl8.0 / generic / tclParse.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-08-15  |  23.6 KB  |  939 lines  |  [TEXT/CWIE]
  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-1997 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.56 97/07/29 18:40:03
  15.  */
  16.  
  17. #include "tclInt.h"
  18. #include "tclPort.h"
  19.  
  20. /*
  21.  * Function prototypes for procedures local to this file:
  22.  */
  23.  
  24. static char *    QuoteEnd _ANSI_ARGS_((char *string, char *lastChar,
  25.             int term));
  26. static char *    ScriptEnd _ANSI_ARGS_((char *p, char *lastChar,
  27.             int nested));
  28. static char *    VarNameEnd _ANSI_ARGS_((char *string,  char *lastChar));
  29.  
  30. /*
  31.  *--------------------------------------------------------------
  32.  *
  33.  * TclParseQuotes --
  34.  *
  35.  *    This procedure parses a double-quoted string such as a
  36.  *    quoted Tcl command argument or a quoted value in a Tcl
  37.  *    expression.  This procedure is also used to parse array
  38.  *    element names within parentheses, or anything else that
  39.  *    needs all the substitutions that happen in quotes.
  40.  *
  41.  * Results:
  42.  *    The return value is a standard Tcl result, which is
  43.  *    TCL_OK unless there was an error while parsing the
  44.  *    quoted string.  If an error occurs then interp->result
  45.  *    contains a standard error message.  *TermPtr is filled
  46.  *    in with the address of the character just after the
  47.  *    last one successfully processed;  this is usually the
  48.  *    character just after the matching close-quote.  The
  49.  *    fully-substituted contents of the quotes are stored in
  50.  *    standard fashion in *pvPtr, null-terminated with
  51.  *    pvPtr->next pointing to the terminating null character.
  52.  *
  53.  * Side effects:
  54.  *    The buffer space in pvPtr may be enlarged by calling its
  55.  *    expandProc.
  56.  *
  57.  *--------------------------------------------------------------
  58.  */
  59.  
  60. int
  61. TclParseQuotes(interp, string, termChar, flags, termPtr, pvPtr)
  62.     Tcl_Interp *interp;        /* Interpreter to use for nested command
  63.                  * evaluations and error messages. */
  64.     char *string;        /* Character just after opening double-
  65.                  * quote. */
  66.     int termChar;        /* Character that terminates "quoted" string
  67.                  * (usually double-quote, but sometimes
  68.                  * right-paren or something else). */
  69.     int flags;            /* Flags to pass to nested Tcl_Eval calls. */
  70.     char **termPtr;        /* Store address of terminating character
  71.                  * here. */
  72.     ParseValue *pvPtr;        /* Information about where to place
  73.                  * fully-substituted result of parse. */
  74. {
  75.     register char *src, *dst, c;
  76.     char *lastChar = string + strlen(string);
  77.  
  78.     src = string;
  79.     dst = pvPtr->next;
  80.  
  81.     while (1) {
  82.     if (dst == pvPtr->end) {
  83.         /*
  84.          * Target buffer space is about to run out.  Make more space.
  85.          */
  86.  
  87.         pvPtr->next = dst;
  88.         (*pvPtr->expandProc)(pvPtr, 1);
  89.         dst = pvPtr->next;
  90.     }
  91.  
  92.     c = *src;
  93.     src++;
  94.     if (c == termChar) {
  95.         *dst = '\0';
  96.         pvPtr->next = dst;
  97.         *termPtr = src;
  98.         return TCL_OK;
  99.     } else if (CHAR_TYPE(src-1, lastChar) == TCL_NORMAL) {
  100.         copy:
  101.         *dst = c;
  102.         dst++;
  103.         continue;
  104.     } else if (c == '$') {
  105.         int length;
  106.         char *value;
  107.  
  108.         value = Tcl_ParseVar(interp, src-1, termPtr);
  109.         if (value == NULL) {
  110.         return TCL_ERROR;
  111.         }
  112.         src = *termPtr;
  113.         length = strlen(value);
  114.         if ((pvPtr->end - dst) <= length) {
  115.         pvPtr->next = dst;
  116.         (*pvPtr->expandProc)(pvPtr, length);
  117.         dst = pvPtr->next;
  118.         }
  119.         strcpy(dst, value);
  120.         dst += length;
  121.         continue;
  122.     } else if (c == '[') {
  123.         int result;
  124.  
  125.         pvPtr->next = dst;
  126.         result = TclParseNestedCmd(interp, src, flags, termPtr, pvPtr);
  127.         if (result != TCL_OK) {
  128.         return result;
  129.         }
  130.         src = *termPtr;
  131.         dst = pvPtr->next;
  132.         continue;
  133.     } else if (c == '\\') {
  134.         int numRead;
  135.  
  136.         src--;
  137.         *dst = Tcl_Backslash(src, &numRead);
  138.         dst++;
  139.         src += numRead;
  140.         continue;
  141.     } else if (c == '\0') {
  142.         char buf[30];
  143.         
  144.         Tcl_ResetResult(interp);
  145.         sprintf(buf, "missing %c", termChar);
  146.         Tcl_SetResult(interp, buf, TCL_VOLATILE);
  147.         *termPtr = string-1;
  148.         return TCL_ERROR;
  149.     } else {
  150.         goto copy;
  151.     }
  152.     }
  153. }
  154.  
  155. /*
  156.  *--------------------------------------------------------------
  157.  *
  158.  * TclParseNestedCmd --
  159.  *
  160.  *    This procedure parses a nested Tcl command between
  161.  *    brackets, returning the result of the command.
  162.  *
  163.  * Results:
  164.  *    The return value is a standard Tcl result, which is
  165.  *    TCL_OK unless there was an error while executing the
  166.  *    nested command.  If an error occurs then interp->result
  167.  *    contains a standard error message.  *TermPtr is filled
  168.  *    in with the address of the character just after the
  169.  *    last one processed;  this is usually the character just
  170.  *    after the matching close-bracket, or the null character
  171.  *    at the end of the string if the close-bracket was missing
  172.  *    (a missing close bracket is an error).  The result returned
  173.  *    by the command is stored in standard fashion in *pvPtr,
  174.  *    null-terminated, with pvPtr->next pointing to the null
  175.  *    character.
  176.  *
  177.  * Side effects:
  178.  *    The storage space at *pvPtr may be expanded.
  179.  *
  180.  *--------------------------------------------------------------
  181.  */
  182.  
  183. int
  184. TclParseNestedCmd(interp, string, flags, termPtr, pvPtr)
  185.     Tcl_Interp *interp;        /* Interpreter to use for nested command
  186.                  * evaluations and error messages. */
  187.     char *string;        /* Character just after opening bracket. */
  188.     int flags;            /* Flags to pass to nested Tcl_Eval. */
  189.     char **termPtr;        /* Store address of terminating character
  190.                  * here. */
  191.     register ParseValue *pvPtr;    /* Information about where to place
  192.                  * result of command. */
  193. {
  194.     int result, length, shortfall;
  195.     Interp *iPtr = (Interp *) interp;
  196.  
  197.     iPtr->evalFlags = flags | TCL_BRACKET_TERM;
  198.     result = Tcl_Eval(interp, string);
  199.     *termPtr = (string + iPtr->termOffset);
  200.     if (result != TCL_OK) {
  201.     /*
  202.      * The increment below results in slightly cleaner message in
  203.      * the errorInfo variable (the close-bracket will appear).
  204.      */
  205.  
  206.     if (**termPtr == ']') {
  207.         *termPtr += 1;
  208.     }
  209.     return result;
  210.     }
  211.     (*termPtr) += 1;
  212.     length = strlen(iPtr->result);
  213.     shortfall = length + 1 - (pvPtr->end - pvPtr->next);
  214.     if (shortfall > 0) {
  215.     (*pvPtr->expandProc)(pvPtr, shortfall);
  216.     }
  217.     strcpy(pvPtr->next, iPtr->result);
  218.     pvPtr->next += length;
  219.     
  220.     Tcl_FreeResult(interp);
  221.     iPtr->result = iPtr->resultSpace;
  222.     iPtr->resultSpace[0] = '\0';
  223.     return TCL_OK;
  224. }
  225.  
  226. /*
  227.  *--------------------------------------------------------------
  228.  *
  229.  * TclParseBraces --
  230.  *
  231.  *    This procedure scans the information between matching
  232.  *    curly braces.
  233.  *
  234.  * Results:
  235.  *    The return value is a standard Tcl result, which is
  236.  *    TCL_OK unless there was an error while parsing string.
  237.  *    If an error occurs then interp->result contains a
  238.  *    standard error message.  *TermPtr is filled
  239.  *    in with the address of the character just after the
  240.  *    last one successfully processed;  this is usually the
  241.  *    character just after the matching close-brace.  The
  242.  *    information between curly braces is stored in standard
  243.  *    fashion in *pvPtr, null-terminated with pvPtr->next
  244.  *    pointing to the terminating null character.
  245.  *
  246.  * Side effects:
  247.  *    The storage space at *pvPtr may be expanded.
  248.  *
  249.  *--------------------------------------------------------------
  250.  */
  251.  
  252. int
  253. TclParseBraces(interp, string, termPtr, pvPtr)
  254.     Tcl_Interp *interp;        /* Interpreter to use for nested command
  255.                  * evaluations and error messages. */
  256.     char *string;        /* Character just after opening bracket. */
  257.     char **termPtr;        /* Store address of terminating character
  258.                  * here. */
  259.     register ParseValue *pvPtr;    /* Information about where to place
  260.                  * result of command. */
  261. {
  262.     int level;
  263.     register char *src, *dst, *end;
  264.     register char c;
  265.     char *lastChar = string + strlen(string);
  266.  
  267.     src = string;
  268.     dst = pvPtr->next;
  269.     end = pvPtr->end;
  270.     level = 1;
  271.  
  272.     /*
  273.      * Copy the characters one at a time to the result area, stopping
  274.      * when the matching close-brace is found.
  275.      */
  276.  
  277.     while (1) {
  278.     c = *src;
  279.     src++;
  280.     if (dst == end) {
  281.         pvPtr->next = dst;
  282.         (*pvPtr->expandProc)(pvPtr, 20);
  283.         dst = pvPtr->next;
  284.         end = pvPtr->end;
  285.     }
  286.     *dst = c;
  287.     dst++;
  288.     if (CHAR_TYPE(src-1, lastChar) == TCL_NORMAL) {
  289.         continue;
  290.     } else if (c == '{') {
  291.         level++;
  292.     } else if (c == '}') {
  293.         level--;
  294.         if (level == 0) {
  295.         dst--;            /* Don't copy the last close brace. */
  296.         break;
  297.         }
  298.     } else if (c == '\\') {
  299.         int count;
  300.  
  301.         /*
  302.          * Must always squish out backslash-newlines, even when in
  303.          * braces.  This is needed so that this sequence can appear
  304.          * anywhere in a command, such as the middle of an expression.
  305.          */
  306.  
  307.         if (*src == '\n') {
  308.         dst[-1] = Tcl_Backslash(src-1, &count);
  309.         src += count - 1;
  310.         } else {
  311.         (void) Tcl_Backslash(src-1, &count);
  312.         while (count > 1) {
  313.                     if (dst == end) {
  314.                         pvPtr->next = dst;
  315.                         (*pvPtr->expandProc)(pvPtr, 20);
  316.                         dst = pvPtr->next;
  317.                         end = pvPtr->end;
  318.                     }
  319.             *dst = *src;
  320.             dst++;
  321.             src++;
  322.             count--;
  323.         }
  324.         }
  325.     } else if (c == '\0') {
  326.         Tcl_SetResult(interp, "missing close-brace", TCL_STATIC);
  327.         *termPtr = string-1;
  328.         return TCL_ERROR;
  329.     }
  330.     }
  331.  
  332.     *dst = '\0';
  333.     pvPtr->next = dst;
  334.     *termPtr = src;
  335.     return TCL_OK;
  336. }
  337.  
  338. /*
  339.  *--------------------------------------------------------------
  340.  *
  341.  * TclExpandParseValue --
  342.  *
  343.  *    This procedure is commonly used as the value of the
  344.  *    expandProc in a ParseValue.  It uses malloc to allocate
  345.  *    more space for the result of a parse.
  346.  *
  347.  * Results:
  348.  *    The buffer space in *pvPtr is reallocated to something
  349.  *    larger, and if pvPtr->clientData is non-zero the old
  350.  *    buffer is freed.  Information is copied from the old
  351.  *    buffer to the new one.
  352.  *
  353.  * Side effects:
  354.  *    None.
  355.  *
  356.  *--------------------------------------------------------------
  357.  */
  358.  
  359. void
  360. TclExpandParseValue(pvPtr, needed)
  361.     register ParseValue *pvPtr;        /* Information about buffer that
  362.                      * must be expanded.  If the clientData
  363.                      * in the structure is non-zero, it
  364.                      * means that the current buffer is
  365.                      * dynamically allocated. */
  366.     int needed;                /* Minimum amount of additional space
  367.                      * to allocate. */
  368. {
  369.     int newSpace;
  370.     char *new;
  371.  
  372.     /*
  373.      * Either double the size of the buffer or add enough new space
  374.      * to meet the demand, whichever produces a larger new buffer.
  375.      */
  376.  
  377.     newSpace = (pvPtr->end - pvPtr->buffer) + 1;
  378.     if (newSpace < needed) {
  379.     newSpace += needed;
  380.     } else {
  381.     newSpace += newSpace;
  382.     }
  383.     new = (char *) ckalloc((unsigned) newSpace);
  384.  
  385.     /*
  386.      * Copy from old buffer to new, free old buffer if needed, and
  387.      * mark new buffer as malloc-ed.
  388.      */
  389.  
  390.     memcpy((VOID *) new, (VOID *) pvPtr->buffer,
  391.         (size_t) (pvPtr->next - pvPtr->buffer));
  392.     pvPtr->next = new + (pvPtr->next - pvPtr->buffer);
  393.     if (pvPtr->clientData != 0) {
  394.     ckfree(pvPtr->buffer);
  395.     }
  396.     pvPtr->buffer = new;
  397.     pvPtr->end = new + newSpace - 1;
  398.     pvPtr->clientData = (ClientData) 1;
  399. }
  400.  
  401. /*
  402.  *----------------------------------------------------------------------
  403.  *
  404.  * TclWordEnd --
  405.  *
  406.  *    Given a pointer into a Tcl command, find the end of the next
  407.  *    word of the command.
  408.  *
  409.  * Results:
  410.  *    The return value is a pointer to the last character that's part
  411.  *    of the word pointed to by "start".  If the word doesn't end
  412.  *    properly within the string then the return value is the address
  413.  *    of the null character at the end of the string.
  414.  *
  415.  * Side effects:
  416.  *    None.
  417.  *
  418.  *----------------------------------------------------------------------
  419.  */
  420.  
  421. char *
  422. TclWordEnd(start, lastChar, nested, semiPtr)
  423.     char *start;        /* Beginning of a word of a Tcl command. */
  424.     char *lastChar;        /* Terminating character in string. */
  425.     int nested;            /* Zero means this is a top-level command.
  426.                  * One means this is a nested command (close
  427.                  * bracket is a word terminator). */
  428.     int *semiPtr;        /* Set to 1 if word ends with a command-
  429.                  * terminating semi-colon, zero otherwise.
  430.                  * If NULL then ignored. */
  431. {
  432.     register char *p;
  433.     int count;
  434.  
  435.     if (semiPtr != NULL) {
  436.     *semiPtr = 0;
  437.     }
  438.  
  439.     /*
  440.      * Skip leading white space (backslash-newline must be treated like
  441.      * white-space, except that it better not be the last thing in the
  442.      * command).
  443.      */
  444.  
  445.     for (p = start; ; p++) {
  446.     if (isspace(UCHAR(*p))) {
  447.         continue;
  448.     }
  449.     if ((p[0] == '\\') && (p[1] == '\n')) {
  450.         if (p+2 == lastChar) {
  451.         return p+2;
  452.         }
  453.         continue;
  454.     }
  455.     break;
  456.     }
  457.  
  458.     /*
  459.      * Handle words beginning with a double-quote or a brace.
  460.      */
  461.  
  462.     if (*p == '"') {
  463.     p = QuoteEnd(p+1, lastChar, '"');
  464.     if (p == lastChar) {
  465.         return p;
  466.     }
  467.     p++;
  468.     } else if (*p == '{') {
  469.     int braces = 1;
  470.     while (braces != 0) {
  471.         p++;
  472.         while (*p == '\\') {
  473.         (void) Tcl_Backslash(p, &count);
  474.         p += count;
  475.         }
  476.         if (*p == '}') {
  477.         braces--;
  478.         } else if (*p == '{') {
  479.         braces++;
  480.         } else if (p == lastChar) {
  481.         return p;
  482.         }
  483.     }
  484.     p++;
  485.     }
  486.  
  487.     /*
  488.      * Handle words that don't start with a brace or double-quote.
  489.      * This code is also invoked if the word starts with a brace or
  490.      * double-quote and there is garbage after the closing brace or
  491.      * quote.  This is an error as far as Tcl_Eval is concerned, but
  492.      * for here the garbage is treated as part of the word.
  493.      */
  494.  
  495.     while (1) {
  496.     if (*p == '[') {
  497.         p = ScriptEnd(p+1, lastChar, 1);
  498.         if (p == lastChar) {
  499.         return p;
  500.         }
  501.         p++;
  502.     } else if (*p == '\\') {
  503.         if (p[1] == '\n') {
  504.         /*
  505.          * Backslash-newline:  it maps to a space character
  506.          * that is a word separator, so the word ends just before
  507.          * the backslash.
  508.          */
  509.  
  510.         return p-1;
  511.         }
  512.         (void) Tcl_Backslash(p, &count);
  513.         p += count;
  514.     } else if (*p == '$') {
  515.         p = VarNameEnd(p, lastChar);
  516.         if (p == lastChar) {
  517.         return p;
  518.         }
  519.         p++;
  520.     } else if (*p == ';') {
  521.         /*
  522.          * Include the semi-colon in the word that is returned.
  523.          */
  524.  
  525.         if (semiPtr != NULL) {
  526.         *semiPtr = 1;
  527.         }
  528.         return p;
  529.     } else if (isspace(UCHAR(*p))) {
  530.         return p-1;
  531.     } else if ((*p == ']') && nested) {
  532.         return p-1;
  533.     } else if (p == lastChar) {
  534.         if (nested) {
  535.         /*
  536.          * Nested commands can't end because of the end of the
  537.          * string.
  538.          */
  539.         return p;
  540.         }
  541.         return p-1;
  542.     } else {
  543.         p++;
  544.     }
  545.     }
  546. }
  547.  
  548. /*
  549.  *----------------------------------------------------------------------
  550.  *
  551.  * QuoteEnd --
  552.  *
  553.  *    Given a pointer to a string that obeys the parsing conventions
  554.  *    for quoted things in Tcl, find the end of that quoted thing.
  555.  *    The actual thing may be a quoted argument or a parenthesized
  556.  *    index name.
  557.  *
  558.  * Results:
  559.  *    The return value is a pointer to the last character that is
  560.  *    part of the quoted string (i.e the character that's equal to
  561.  *    term).  If the quoted string doesn't terminate properly then
  562.  *    the return value is a pointer to the null character at the
  563.  *    end of the string.
  564.  *
  565.  * Side effects:
  566.  *    None.
  567.  *
  568.  *----------------------------------------------------------------------
  569.  */
  570.  
  571. static char *
  572. QuoteEnd(string, lastChar, term)
  573.     char *string;        /* Pointer to character just after opening
  574.                  * "quote". */
  575.     char *lastChar;        /* Terminating character in string. */
  576.     int term;            /* This character will terminate the
  577.                  * quoted string (e.g. '"' or ')'). */
  578. {
  579.     register char *p = string;
  580.     int count;
  581.  
  582.     while (*p != term) {
  583.     if (*p == '\\') {
  584.         (void) Tcl_Backslash(p, &count);
  585.         p += count;
  586.     } else if (*p == '[') {
  587.         for (p++; *p != ']'; p++) {
  588.         p = TclWordEnd(p, lastChar, 1, (int *) NULL);
  589.         if (*p == 0) {
  590.             return p;
  591.         }
  592.         }
  593.         p++;
  594.     } else if (*p == '$') {
  595.         p = VarNameEnd(p, lastChar);
  596.         if (*p == 0) {
  597.         return p;
  598.         }
  599.         p++;
  600.     } else if (p == lastChar) {
  601.         return p;
  602.     } else {
  603.         p++;
  604.     }
  605.     }
  606.     return p-1;
  607. }
  608.  
  609. /*
  610.  *----------------------------------------------------------------------
  611.  *
  612.  * VarNameEnd --
  613.  *
  614.  *    Given a pointer to a variable reference using $-notation, find
  615.  *    the end of the variable name spec.
  616.  *
  617.  * Results:
  618.  *    The return value is a pointer to the last character that
  619.  *    is part of the variable name.  If the variable name doesn't
  620.  *    terminate properly then the return value is a pointer to the
  621.  *    null character at the end of the string.
  622.  *
  623.  * Side effects:
  624.  *    None.
  625.  *
  626.  *----------------------------------------------------------------------
  627.  */
  628.  
  629. static char *
  630. VarNameEnd(string, lastChar)
  631.     char *string;        /* Pointer to dollar-sign character. */
  632.     char *lastChar;        /* Terminating character in string. */
  633. {
  634.     register char *p = string+1;
  635.  
  636.     if (*p == '{') {
  637.     for (p++; (*p != '}') && (p != lastChar); p++) {
  638.         /* Empty loop body. */
  639.     }
  640.     return p;
  641.     }
  642.     while (isalnum(UCHAR(*p)) || (*p == '_')) {
  643.     p++;
  644.     }
  645.     if ((*p == '(') && (p != string+1)) {
  646.     return QuoteEnd(p+1, lastChar, ')');
  647.     }
  648.     return p-1;
  649. }
  650.  
  651.  
  652. /*
  653.  *----------------------------------------------------------------------
  654.  *
  655.  * ScriptEnd --
  656.  *
  657.  *    Given a pointer to the beginning of a Tcl script, find the end of
  658.  *    the script.
  659.  *
  660.  * Results:
  661.  *    The return value is a pointer to the last character that's part
  662.  *    of the script pointed to by "p".  If the command doesn't end
  663.  *    properly within the string then the return value is the address
  664.  *    of the null character at the end of the string.
  665.  *
  666.  * Side effects:
  667.  *    None.
  668.  *
  669.  *----------------------------------------------------------------------
  670.  */
  671.  
  672. static char *
  673. ScriptEnd(p, lastChar, nested)
  674.     char *p;            /* Script to check. */
  675.     char *lastChar;        /* Terminating character in string. */
  676.     int nested;            /* Zero means this is a top-level command.
  677.                  * One means this is a nested command (the
  678.                  * last character of the script must be
  679.                  * an unquoted ]). */
  680. {
  681.     int commentOK = 1;
  682.     int length;
  683.  
  684.     while (1) {
  685.     while (isspace(UCHAR(*p))) {
  686.         if (*p == '\n') {
  687.         commentOK = 1;
  688.         }
  689.         p++;
  690.     }
  691.     if ((*p == '#') && commentOK) {
  692.         do {
  693.         if (*p == '\\') {
  694.             /*
  695.              * If the script ends with backslash-newline, then
  696.              * this command isn't complete.
  697.              */
  698.  
  699.             if ((p[1] == '\n') && (p+2 == lastChar)) {
  700.             return p+2;
  701.             }
  702.             Tcl_Backslash(p, &length);
  703.             p += length;
  704.         } else {
  705.             p++;
  706.         }
  707.         } while ((p != lastChar) && (*p != '\n'));
  708.         continue;
  709.     }
  710.     p = TclWordEnd(p, lastChar, nested, &commentOK);
  711.     if (p == lastChar) {
  712.         return p;
  713.     }
  714.     p++;
  715.     if (nested) {
  716.         if (*p == ']') {
  717.         return p;
  718.         }
  719.     } else {
  720.         if (p == lastChar) {
  721.         return p-1;
  722.         }
  723.     }
  724.     }
  725. }
  726.  
  727. /*
  728.  *----------------------------------------------------------------------
  729.  *
  730.  * Tcl_ParseVar --
  731.  *
  732.  *    Given a string starting with a $ sign, parse off a variable
  733.  *    name and return its value.
  734.  *
  735.  * Results:
  736.  *    The return value is the contents of the variable given by
  737.  *    the leading characters of string.  If termPtr isn't NULL,
  738.  *    *termPtr gets filled in with the address of the character
  739.  *    just after the last one in the variable specifier.  If the
  740.  *    variable doesn't exist, then the return value is NULL and
  741.  *    an error message will be left in interp->result.
  742.  *
  743.  * Side effects:
  744.  *    None.
  745.  *
  746.  *----------------------------------------------------------------------
  747.  */
  748.  
  749. char *
  750. Tcl_ParseVar(interp, string, termPtr)
  751.     Tcl_Interp *interp;            /* Context for looking up variable. */
  752.     register char *string;        /* String containing variable name.
  753.                      * First character must be "$". */
  754.     char **termPtr;            /* If non-NULL, points to word to fill
  755.                      * in with character just after last
  756.                      * one in the variable specifier. */
  757.  
  758. {
  759.     char *name1, *name1End, c, *result;
  760.     register char *name2;
  761. #define NUM_CHARS 200
  762.     char copyStorage[NUM_CHARS];
  763.     ParseValue pv;
  764.  
  765.     /*
  766.      * There are three cases:
  767.      * 1. The $ sign is followed by an open curly brace.  Then the variable
  768.      *    name is everything up to the next close curly brace, and the
  769.      *    variable is a scalar variable.
  770.      * 2. The $ sign is not followed by an open curly brace.  Then the
  771.      *    variable name is everything up to the next character that isn't
  772.      *    a letter, digit, or underscore, or a "::" namespace separator.
  773.      *    If the following character is an open parenthesis, then the
  774.      *    information between parentheses is the array element name, which
  775.      *    can include any of the substitutions permissible between quotes.
  776.      * 3. The $ sign is followed by something that isn't a letter, digit,
  777.      *    underscore, or a "::" namespace separator: in this case,
  778.      *    there is no variable name, and "$" is returned.
  779.      */
  780.  
  781.     name2 = NULL;
  782.     string++;
  783.     if (*string == '{') {
  784.     string++;
  785.     name1 = string;
  786.     while (*string != '}') {
  787.         if (*string == 0) {
  788.         Tcl_SetResult(interp, "missing close-brace for variable name",
  789.             TCL_STATIC);
  790.         if (termPtr != 0) {
  791.             *termPtr = string;
  792.         }
  793.         return NULL;
  794.         }
  795.         string++;
  796.     }
  797.     name1End = string;
  798.     string++;
  799.     } else {
  800.     name1 = string;
  801.     while (isalnum(UCHAR(*string)) || (*string == '_')
  802.             || (*string == ':')) {
  803.         if (*string == ':') {
  804.         if (*(string+1) == ':') {
  805.                     string += 2;  /* skip over the initial :: */
  806.             while (*string == ':') {
  807.             string++; /* skip over a subsequent : */
  808.             }
  809.         } else {
  810.             break;      /* : by itself */
  811.                 }
  812.         } else {
  813.         string++;
  814.         }
  815.     }
  816.     if (string == name1) {
  817.         if (termPtr != 0) {
  818.         *termPtr = string;
  819.         }
  820.         return "$";
  821.     }
  822.     name1End = string;
  823.     if (*string == '(') {
  824.         char *end;
  825.  
  826.         /*
  827.          * Perform substitutions on the array element name, just as
  828.          * is done for quotes.
  829.          */
  830.  
  831.         pv.buffer = pv.next = copyStorage;
  832.         pv.end = copyStorage + NUM_CHARS - 1;
  833.         pv.expandProc = TclExpandParseValue;
  834.         pv.clientData = (ClientData) NULL;
  835.         if (TclParseQuotes(interp, string+1, ')', 0, &end, &pv)
  836.             != TCL_OK) {
  837.         char msg[200];
  838.         int length;
  839.  
  840.         length = string-name1;
  841.         if (length > 100) {
  842.             length = 100;
  843.         }
  844.         sprintf(msg, "\n    (parsing index for array \"%.*s\")",
  845.             length, name1);
  846.         Tcl_AddErrorInfo(interp, msg);
  847.         result = NULL;
  848.         name2 = pv.buffer;
  849.         if (termPtr != 0) {
  850.             *termPtr = end;
  851.         }
  852.         goto done;
  853.         }
  854.         Tcl_ResetResult(interp);
  855.         string = end;
  856.         name2 = pv.buffer;
  857.     }
  858.     }
  859.     if (termPtr != 0) {
  860.     *termPtr = string;
  861.     }
  862.  
  863.     c = *name1End;
  864.     *name1End = 0;
  865.     result = Tcl_GetVar2(interp, name1, name2, TCL_LEAVE_ERR_MSG);
  866.     *name1End = c;
  867.  
  868.     done:
  869.     if ((name2 != NULL) && (pv.buffer != copyStorage)) {
  870.     ckfree(pv.buffer);
  871.     }
  872.     return result;
  873. }
  874.  
  875. /*
  876.  *----------------------------------------------------------------------
  877.  *
  878.  * Tcl_CommandComplete --
  879.  *
  880.  *    Given a partial or complete Tcl command, this procedure
  881.  *    determines whether the command is complete in the sense
  882.  *    of having matched braces and quotes and brackets.
  883.  *
  884.  * Results:
  885.  *    1 is returned if the command is complete, 0 otherwise.
  886.  *
  887.  * Side effects:
  888.  *    None.
  889.  *
  890.  *----------------------------------------------------------------------
  891.  */
  892.  
  893. int
  894. Tcl_CommandComplete(cmd)
  895.     char *cmd;            /* Command to check. */
  896. {
  897.     char *p;
  898.  
  899.     if (*cmd == 0) {
  900.     return 1;
  901.     }
  902.     p = ScriptEnd(cmd, cmd+strlen(cmd), 0);
  903.     return (*p != 0);
  904. }
  905.  
  906. /*
  907.  *----------------------------------------------------------------------
  908.  *
  909.  * TclObjCommandComplete --
  910.  *
  911.  *    Given a partial or complete Tcl command in a Tcl object, this
  912.  *    procedure determines whether the command is complete in the sense of
  913.  *    having matched braces and quotes and brackets.
  914.  *
  915.  * Results:
  916.  *    1 is returned if the command is complete, 0 otherwise.
  917.  *
  918.  * Side effects:
  919.  *    None.
  920.  *
  921.  *----------------------------------------------------------------------
  922.  */
  923.  
  924. int
  925. TclObjCommandComplete(cmdPtr)
  926.     Tcl_Obj *cmdPtr;            /* Points to object holding command
  927.                      * to check. */
  928. {
  929.     char *cmd, *p;
  930.     int length;
  931.  
  932.     cmd = Tcl_GetStringFromObj(cmdPtr, &length);
  933.     if (length == 0) {
  934.     return 1;
  935.     }
  936.     p = ScriptEnd(cmd, cmd+length, /*nested*/ 0);
  937.     return (*p != 0);
  938. }
  939.