开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Windows编程 > 通讯编程 > 查看源码
tclParse.c
资源名称：ns-allinone-2.33.tar.gz　[点击查看]
上传用户：rrhhcc
上传日期：2015-12-11
资源大小：54129k
文件大小：55k
源码类别：

通讯编程

开发平台：

Visual C++

tclParse.c：源码内容
  1. /* 
  2.  * tclParse.c --
  3.  *
  4.  * This file contains procedures that parse Tcl scripts.  They
  5.  * do so in a general-purpose fashion that can be used for many
  6.  * different purposes, including compilation, direct execution,
  7.  * code analysis, etc.  
  8.  *
  9.  * Copyright (c) 1997 Sun Microsystems, Inc.
  10.  * Copyright (c) 1998-2000 Ajuba Solutions.
  11.  * Contributions from Don Porter, NIST, 2002. (not subject to US copyright)
  12.  *
  13.  * See the file "license.terms" for information on usage and redistribution
  14.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  15.  *
  16.  * RCS: @(#) $Id: tclParse.c,v 1.25.2.3 2007/10/15 13:29:19 msofer Exp $
  17.  */
  19. #include "tclInt.h"
  20. #include "tclPort.h"
  22. /*
  23.  * The following table provides parsing information about each possible
  24.  * 8-bit character.  The table is designed to be referenced with either
  25.  * signed or unsigned characters, so it has 384 entries.  The first 128
  26.  * entries correspond to negative character values, the next 256 correspond
  27.  * to positive character values.  The last 128 entries are identical to the
  28.  * first 128.  The table is always indexed with a 128-byte offset (the 128th
  29.  * entry corresponds to a character value of 0).
  30.  *
  31.  * The macro CHAR_TYPE is used to index into the table and return
  32.  * information about its character argument.  The following return
  33.  * values are defined.
  34.  *
  35.  * TYPE_NORMAL -        All characters that don't have special significance
  36.  *                      to the Tcl parser.
  37.  * TYPE_SPACE -         The character is a whitespace character other
  38.  *                      than newline.
  39.  * TYPE_COMMAND_END -   Character is newline or semicolon.
  40.  * TYPE_SUBS -          Character begins a substitution or has other
  41.  *                      special meaning in ParseTokens: backslash, dollar
  42.  *                      sign, or open bracket.
  43.  * TYPE_QUOTE -         Character is a double quote.
  44.  * TYPE_CLOSE_PAREN -   Character is a right parenthesis.
  45.  * TYPE_CLOSE_BRACK -   Character is a right square bracket.
  46.  * TYPE_BRACE -         Character is a curly brace (either left or right).
  47.  */
  49. #define TYPE_NORMAL             0
  50. #define TYPE_SPACE              0x1
  51. #define TYPE_COMMAND_END        0x2
  52. #define TYPE_SUBS               0x4
  53. #define TYPE_QUOTE              0x8
  54. #define TYPE_CLOSE_PAREN        0x10
  55. #define TYPE_CLOSE_BRACK        0x20
  56. #define TYPE_BRACE              0x40
  58. #define CHAR_TYPE(c) (charTypeTable+128)[(int)(c)]
  60. static CONST char charTypeTable[] = {
  61.     /*
  62.      * Negative character values, from -128 to -1:
  63.      */
  65.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  66.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  67.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  68.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  69.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  70.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  71.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  72.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  73.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  74.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  75.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  76.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  77.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  78.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  79.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  80.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  81.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  82.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  83.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  84.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  85.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  86.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  87.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  88.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  89.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  90.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  91.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  92.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  93.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  94.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  95.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  96.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  98.     /*
  99.      * Positive character values, from 0-127:
  100.      */
  102.     TYPE_SUBS,        TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  103.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  104.     TYPE_NORMAL,      TYPE_SPACE,       TYPE_COMMAND_END, TYPE_SPACE,
  105.     TYPE_SPACE,       TYPE_SPACE,       TYPE_NORMAL,      TYPE_NORMAL,
  106.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  107.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  108.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  109.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  110.     TYPE_SPACE,       TYPE_NORMAL,      TYPE_QUOTE,       TYPE_NORMAL,
  111.     TYPE_SUBS,        TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  112.     TYPE_NORMAL,      TYPE_CLOSE_PAREN, TYPE_NORMAL,      TYPE_NORMAL,
  113.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  114.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  115.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  116.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_COMMAND_END,
  117.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  118.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  119.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  120.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  121.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  122.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  123.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  124.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_SUBS,
  125.     TYPE_SUBS,        TYPE_CLOSE_BRACK, TYPE_NORMAL,      TYPE_NORMAL,
  126.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  127.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  128.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  129.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  130.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  131.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  132.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_BRACE,
  133.     TYPE_NORMAL,      TYPE_BRACE,       TYPE_NORMAL,      TYPE_NORMAL,
  135.     /*
  136.      * Large unsigned character values, from 128-255:
  137.      */
  139.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  140.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  141.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  142.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  143.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  144.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  145.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  146.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  147.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  148.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  149.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  150.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  151.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  152.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  153.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  154.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  155.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  156.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  157.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  158.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  159.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  160.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  161.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  162.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  163.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  164.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  165.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  166.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  167.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  168.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  169.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  170.     TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
  171. };
  173. /*
  174.  * Prototypes for local procedures defined in this file:
  175.  */
  177. static int CommandComplete _ANSI_ARGS_((CONST char *script,
  178.     int numBytes));
  179. static int ParseComment _ANSI_ARGS_((CONST char *src, int numBytes,
  180.     Tcl_Parse *parsePtr));
  181. static int ParseTokens _ANSI_ARGS_((CONST char *src, int numBytes,
  182.     int mask, Tcl_Parse *parsePtr));
  184. /*
  185.  *----------------------------------------------------------------------
  186.  *
  187.  * Tcl_ParseCommand --
  188.  *
  189.  * Given a string, this procedure parses the first Tcl command
  190.  * in the string and returns information about the structure of
  191.  * the command.
  192.  *
  193.  * Results:
  194.  * The return value is TCL_OK if the command was parsed
  195.  * successfully and TCL_ERROR otherwise.  If an error occurs
  196.  * and interp isn't NULL then an error message is left in
  197.  * its result.  On a successful return, parsePtr is filled in
  198.  * with information about the command that was parsed.
  199.  *
  200.  * Side effects:
  201.  * If there is insufficient space in parsePtr to hold all the
  202.  * information about the command, then additional space is
  203.  * malloc-ed.  If the procedure returns TCL_OK then the caller must
  204.  * eventually invoke Tcl_FreeParse to release any additional space
  205.  * that was allocated.
  206.  *
  207.  *----------------------------------------------------------------------
  208.  */
  210. int
  211. Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr)
  212.     Tcl_Interp *interp; /* Interpreter to use for error reporting;
  213.  * if NULL, then no error message is
  214.  * provided. */
  215.     CONST char *string; /* First character of string containing
  216.  * one or more Tcl commands. */
  217.     register int numBytes; /* Total number of bytes in string.  If < 0,
  218.  * the script consists of all bytes up to 
  219.  * the first null character. */
  220.     int nested; /* Non-zero means this is a nested command:
  221.  * close bracket should be considered
  222.  * a command terminator. If zero, then close
  223.  * bracket has no special meaning. */
  224.     register Tcl_Parse *parsePtr;
  225.      /* Structure to fill in with information
  226.  * about the parsed command; any previous
  227.  * information in the structure is
  228.  * ignored. */
  229. {
  230.     register CONST char *src; /* Points to current character
  231.  * in the command. */
  232.     char type; /* Result returned by CHAR_TYPE(*src). */
  233.     Tcl_Token *tokenPtr; /* Pointer to token being filled in. */
  234.     int wordIndex; /* Index of word token for current word. */
  235.     int terminators; /* CHAR_TYPE bits that indicate the end
  236.  * of a command. */
  237.     CONST char *termPtr; /* Set by Tcl_ParseBraces/QuotedString to
  238.  * point to char after terminating one. */
  239.     int scanned;
  240.     
  241.     if ((string == NULL) && (numBytes!=0)) {
  242. if (interp != NULL) {
  243.     Tcl_SetResult(interp, "can't parse a NULL pointer", TCL_STATIC);
  244. }
  245. return TCL_ERROR;
  246.     }
  247.     if (numBytes < 0) {
  248. numBytes = strlen(string);
  249.     }
  250.     parsePtr->commentStart = NULL;
  251.     parsePtr->commentSize = 0;
  252.     parsePtr->commandStart = NULL;
  253.     parsePtr->commandSize = 0;
  254.     parsePtr->numWords = 0;
  255.     parsePtr->tokenPtr = parsePtr->staticTokens;
  256.     parsePtr->numTokens = 0;
  257.     parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
  258.     parsePtr->string = string;
  259.     parsePtr->end = string + numBytes;
  260.     parsePtr->term = parsePtr->end;
  261.     parsePtr->interp = interp;
  262.     parsePtr->incomplete = 0;
  263.     parsePtr->errorType = TCL_PARSE_SUCCESS;
  264.     if (nested != 0) {
  265. terminators = TYPE_COMMAND_END | TYPE_CLOSE_BRACK;
  266.     } else {
  267. terminators = TYPE_COMMAND_END;
  268.     }
  270.     /*
  271.      * Parse any leading space and comments before the first word of the
  272.      * command.
  273.      */
  275.     scanned = ParseComment(string, numBytes, parsePtr);
  276.     src = (string + scanned); numBytes -= scanned;
  277.     if (numBytes == 0) {
  278. if (nested) {
  279.     parsePtr->incomplete = nested;
  280. }
  281.     }
  283.     /*
  284.      * The following loop parses the words of the command, one word
  285.      * in each iteration through the loop.
  286.      */
  288.     parsePtr->commandStart = src;
  289.     while (1) {
  290. /*
  291.  * Create the token for the word.
  292.  */
  294. if (parsePtr->numTokens == parsePtr->tokensAvailable) {
  295.     TclExpandTokenArray(parsePtr);
  296. }
  297. wordIndex = parsePtr->numTokens;
  298. tokenPtr = &parsePtr->tokenPtr[wordIndex];
  299. tokenPtr->type = TCL_TOKEN_WORD;
  301. /*
  302.  * Skip white space before the word. Also skip a backslash-newline
  303.  * sequence: it should be treated just like white space.
  304.  */
  306. scanned = TclParseWhiteSpace(src, numBytes, parsePtr, &type);
  307. src += scanned; numBytes -= scanned;
  308. if (numBytes == 0) {
  309.     parsePtr->term = src;
  310.     break;
  311. }
  312. if ((type & terminators) != 0) {
  313.     parsePtr->term = src;
  314.     src++;
  315.     break;
  316. }
  317. tokenPtr->start = src;
  318. parsePtr->numTokens++;
  319. parsePtr->numWords++;
  321. /*
  322.  * At this point the word can have one of three forms: something
  323.  * enclosed in quotes, something enclosed in braces, or an
  324.  * unquoted word (anything else).
  325.  */
  327. if (*src == '"') {
  328.     if (Tcl_ParseQuotedString(interp, src, numBytes,
  329.     parsePtr, 1, &termPtr) != TCL_OK) {
  330. goto error;
  331.     }
  332.     src = termPtr; numBytes = parsePtr->end - src;
  333. } else if (*src == '{') {
  334.     if (Tcl_ParseBraces(interp, src, numBytes,
  335.     parsePtr, 1, &termPtr) != TCL_OK) {
  336. goto error;
  337.     }
  338.     src = termPtr; numBytes = parsePtr->end - src;
  339. } else {
  340.     /*
  341.      * This is an unquoted word.  Call ParseTokens and let it do
  342.      * all of the work.
  343.      */
  345.     if (ParseTokens(src, numBytes, TYPE_SPACE|terminators,
  346.     parsePtr) != TCL_OK) {
  347. goto error;
  348.     }
  349.     src = parsePtr->term; numBytes = parsePtr->end - src;
  350. }
  352. /*
  353.  * Finish filling in the token for the word and check for the
  354.  * special case of a word consisting of a single range of
  355.  * literal text.
  356.  */
  358. tokenPtr = &parsePtr->tokenPtr[wordIndex];
  359. tokenPtr->size = src - tokenPtr->start;
  360. tokenPtr->numComponents = parsePtr->numTokens - (wordIndex + 1);
  361. if ((tokenPtr->numComponents == 1)
  362. && (tokenPtr[1].type == TCL_TOKEN_TEXT)) {
  363.     tokenPtr->type = TCL_TOKEN_SIMPLE_WORD;
  364. }
  366. /*
  367.  * Do two additional checks: (a) make sure we're really at the
  368.  * end of a word (there might have been garbage left after a
  369.  * quoted or braced word), and (b) check for the end of the
  370.  * command.
  371.  */
  373. scanned = TclParseWhiteSpace(src, numBytes, parsePtr, &type);
  374. if (scanned) {
  375.     src += scanned; numBytes -= scanned;
  376.     continue;
  377. }
  379. if (numBytes == 0) {
  380.     parsePtr->term = src;
  381.     break;
  382. }
  383. if ((type & terminators) != 0) {
  384.     parsePtr->term = src;
  385.     src++; 
  386.     break;
  387. }
  388. if (src[-1] == '"') { 
  389.     if (interp != NULL) {
  390. Tcl_SetResult(interp, "extra characters after close-quote",
  391. TCL_STATIC);
  392.     }
  393.     parsePtr->errorType = TCL_PARSE_QUOTE_EXTRA;
  394. } else {
  395.     if (interp != NULL) {
  396. Tcl_SetResult(interp, "extra characters after close-brace",
  397. TCL_STATIC);
  398.     }
  399.     parsePtr->errorType = TCL_PARSE_BRACE_EXTRA;
  400. }
  401. parsePtr->term = src;
  402. goto error;
  403.     }
  405.     parsePtr->commandSize = src - parsePtr->commandStart;
  406.     return TCL_OK;
  408.     error:
  409.     Tcl_FreeParse(parsePtr);
  410.     if (parsePtr->commandStart == NULL) {
  411. parsePtr->commandStart = string;
  412.     }
  413.     parsePtr->commandSize = parsePtr->end - parsePtr->commandStart;
  414.     return TCL_ERROR;
  415. }
  417. /*
  418.  *----------------------------------------------------------------------
  419.  *
  420.  * TclParseWhiteSpace --
  421.  *
  422.  * Scans up to numBytes bytes starting at src, consuming white
  423.  * space as defined by Tcl's parsing rules.  
  424.  *
  425.  * Results:
  426.  * Returns the number of bytes recognized as white space.  Records
  427.  * at parsePtr, information about the parse.  Records at typePtr
  428.  * the character type of the non-whitespace character that terminated
  429.  * the scan.
  430.  *
  431.  * Side effects:
  432.  * None.
  433.  *
  434.  *----------------------------------------------------------------------
  435.  */
  436. int
  437. TclParseWhiteSpace(src, numBytes, parsePtr, typePtr)
  438.     CONST char *src; /* First character to parse. */
  439.     register int numBytes; /* Max number of bytes to scan. */
  440.     Tcl_Parse *parsePtr; /* Information about parse in progress.
  441.  * Updated if parsing indicates
  442.  * an incomplete command. */
  443.     char *typePtr; /* Points to location to store character
  444.  * type of character that ends run
  445.  * of whitespace */
  446. {
  447.     register char type = TYPE_NORMAL;
  448.     register CONST char *p = src;
  450.     while (1) {
  451. while (numBytes && ((type = CHAR_TYPE(*p)) & TYPE_SPACE)) {
  452.     numBytes--; p++;
  453. }
  454. if (numBytes && (type & TYPE_SUBS)) {
  455.     if (*p != '\') {
  456. break;
  457.     }
  458.     if (--numBytes == 0) {
  459. break;
  460.     }
  461.     if (p[1] != 'n') {
  462. break;
  463.     }
  464.     p+=2;
  465.     if (--numBytes == 0) {
  466. parsePtr->incomplete = 1;
  467. break;
  468.     }
  469.     continue;
  470. }
  471. break;
  472.     }
  473.     *typePtr = type;
  474.     return (p - src);
  475. }
  477. /*
  478.  *----------------------------------------------------------------------
  479.  *
  480.  * TclParseHex --
  481.  *
  482.  * Scans a hexadecimal number as a Tcl_UniChar value.
  483.  * (e.g., for parsing x and u escape sequences).
  484.  * At most numBytes bytes are scanned.
  485.  *
  486.  * Results:
  487.  * The numeric value is stored in *resultPtr.
  488.  * Returns the number of bytes consumed.
  489.  *
  490.  * Notes:
  491.  * Relies on the following properties of the ASCII
  492.  * character set, with which UTF-8 is compatible:
  493.  *
  494.  * The digits '0' .. '9' and the letters 'A' .. 'Z' and 'a' .. 'z' 
  495.  * occupy consecutive code points, and '0' < 'A' < 'a'.
  496.  *
  497.  *----------------------------------------------------------------------
  498.  */
  499. int
  500. TclParseHex(src, numBytes, resultPtr)
  501.     CONST char *src; /* First character to parse. */
  502.     int numBytes; /* Max number of byes to scan */
  503.     Tcl_UniChar *resultPtr; /* Points to storage provided by
  504.  * caller where the Tcl_UniChar
  505.  * resulting from the conversion is
  506.  * to be written. */
  507. {
  508.     Tcl_UniChar result = 0;
  509.     register CONST char *p = src;
  511.     while (numBytes--) {
  512. unsigned char digit = UCHAR(*p);
  514. if (!isxdigit(digit))
  515.     break;
  517. ++p;
  518. result <<= 4;
  520. if (digit >= 'a') {
  521.     result |= (10 + digit - 'a');
  522. } else if (digit >= 'A') {
  523.     result |= (10 + digit - 'A');
  524. } else {
  525.     result |= (digit - '0');
  526. }
  527.     }
  529.     *resultPtr = result;
  530.     return (p - src);
  531. }
  533. /*
  534.  *----------------------------------------------------------------------
  535.  *
  536.  * TclParseBackslash --
  537.  *
  538.  * Scans up to numBytes bytes starting at src, consuming a
  539.  * backslash sequence as defined by Tcl's parsing rules.  
  540.  *
  541.  * Results:
  542.  *  Records at readPtr the number of bytes making up the backslash
  543.  *  sequence.  Records at dst the UTF-8 encoded equivalent of
  544.  *  that backslash sequence.  Returns the number of bytes written
  545.  *  to dst, at most TCL_UTF_MAX.  Either readPtr or dst may be
  546.  *  NULL, if the results are not needed, but the return value is
  547.  *  the same either way.
  548.  *
  549.  * Side effects:
  550.  *  None.
  551.  *
  552.  *----------------------------------------------------------------------
  553.  */
  554. int
  555. TclParseBackslash(src, numBytes, readPtr, dst)
  556.     CONST char * src; /* Points to the backslash character of a
  557.  * a backslash sequence */
  558.     int numBytes; /* Max number of bytes to scan */
  559.     int *readPtr; /* NULL, or points to storage where the
  560.  * number of bytes scanned should be written. */
  561.     char *dst; /* NULL, or points to buffer where the UTF-8
  562.  * encoding of the backslash sequence is to be
  563.  * written.  At most TCL_UTF_MAX bytes will be
  564.  * written there. */
  565. {
  566.     register CONST char *p = src+1;
  567.     Tcl_UniChar result;
  568.     int count;
  569.     char buf[TCL_UTF_MAX];
  571.     if (numBytes == 0) {
  572. if (readPtr != NULL) {
  573.     *readPtr = 0;
  574. }
  575. return 0;
  576.     }
  578.     if (dst == NULL) {
  579.         dst = buf;
  580.     }
  582.     if (numBytes == 1) {
  583. /* Can only scan the backslash.  Return it. */
  584. result = '\';
  585. count = 1;
  586. goto done;
  587.     }
  589.     count = 2;
  590.     switch (*p) {
  591.         /*
  592.          * Note: in the conversions below, use absolute values (e.g.,
  593.          * 0xa) rather than symbolic values (e.g. n) that get converted
  594.          * by the compiler.  It's possible that compilers on some
  595.          * platforms will do the symbolic conversions differently, which
  596.          * could result in non-portable Tcl scripts.
  597.          */
  599.         case 'a':
  600.             result = 0x7;
  601.             break;
  602.         case 'b':
  603.             result = 0x8;
  604.             break;
  605.         case 'f':
  606.             result = 0xc;
  607.             break;
  608.         case 'n':
  609.             result = 0xa;
  610.             break;
  611.         case 'r':
  612.             result = 0xd;
  613.             break;
  614.         case 't':
  615.             result = 0x9;
  616.             break;
  617.         case 'v':
  618.             result = 0xb;
  619.             break;
  620.         case 'x':
  621.     count += TclParseHex(p+1, numBytes-1, &result);
  622.     if (count == 2) {
  623. /* No hexadigits -> This is just "x". */
  624. result = 'x';
  625.     } else {
  626. /* Keep only the last byte (2 hex digits) */
  627. result = (unsigned char) result;
  628.     }
  629.             break;
  630.         case 'u':
  631.     count += TclParseHex(p+1, (numBytes > 5) ? 4 : numBytes-1, &result);
  632.     if (count == 2) {
  633. /* No hexadigits -> This is just "u". */
  634. result = 'u';
  635.     }
  636.             break;
  637.         case 'n':
  638.             count--;
  639.             do {
  640.                 p++; count++;
  641.             } while ((count < numBytes) && ((*p == ' ') || (*p == 't')));
  642.             result = ' ';
  643.             break;
  644.         case 0:
  645.             result = '\';
  646.             count = 1;
  647.             break;
  648.         default:
  649.             /*
  650.              * Check for an octal number oo?o?
  651.              */
  652.             if (isdigit(UCHAR(*p)) && (UCHAR(*p) < '8')) { /* INTL: digit */
  653.                 result = (unsigned char)(*p - '0');
  654.                 p++;
  655.                 if ((numBytes == 2) || !isdigit(UCHAR(*p)) /* INTL: digit */
  656. || (UCHAR(*p) >= '8')) { 
  657.                     break;
  658.                 }
  659.                 count = 3;
  660.                 result = (unsigned char)((result << 3) + (*p - '0'));
  661.                 p++;
  662.                 if ((numBytes == 3) || !isdigit(UCHAR(*p)) /* INTL: digit */
  663. || (UCHAR(*p) >= '8')) {
  664.                     break;
  665.                 }
  666.                 count = 4;
  667.                 result = (unsigned char)((result << 3) + (*p - '0'));
  668.                 break;
  669.             }
  670.             /*
  671.              * We have to convert here in case the user has put a
  672.              * backslash in front of a multi-byte utf-8 character.
  673.              * While this means nothing special, we shouldn't break up
  674.              * a correct utf-8 character. [Bug #217987] test subst-3.2
  675.              */
  676.     if (Tcl_UtfCharComplete(p, numBytes - 1)) {
  677.         count = Tcl_UtfToUniChar(p, &result) + 1; /* +1 for '' */
  678.     } else {
  679. char utfBytes[TCL_UTF_MAX];
  680. memcpy(utfBytes, p, (size_t) (numBytes - 1));
  681. utfBytes[numBytes - 1] = '';
  682.         count = Tcl_UtfToUniChar(utfBytes, &result) + 1;
  683.     }
  684.             break;
  685.     }
  687.     done:
  688.     if (readPtr != NULL) {
  689.         *readPtr = count;
  690.     }
  691.     return Tcl_UniCharToUtf((int) result, dst);
  692. }
  694. /*
  695.  *----------------------------------------------------------------------
  696.  *
  697.  * ParseComment --
  698.  *
  699.  * Scans up to numBytes bytes starting at src, consuming a
  700.  * Tcl comment as defined by Tcl's parsing rules.  
  701.  *
  702.  * Results:
  703.  *  Records in parsePtr information about the parse.  Returns the
  704.  *  number of bytes consumed.
  705.  *
  706.  * Side effects:
  707.  *  None.
  708.  *
  709.  *----------------------------------------------------------------------
  710.  */
  711. static int
  712. ParseComment(src, numBytes, parsePtr)
  713.     CONST char *src; /* First character to parse. */
  714.     register int numBytes; /* Max number of bytes to scan. */
  715.     Tcl_Parse *parsePtr; /* Information about parse in progress.
  716.  * Updated if parsing indicates
  717.  * an incomplete command. */
  718. {
  719.     register CONST char *p = src;
  720.     while (numBytes) {
  721. char type;
  722. int scanned;
  723. do {
  724.     scanned = TclParseWhiteSpace(p, numBytes, parsePtr, &type);
  725.     p += scanned; numBytes -= scanned;
  726. } while (numBytes && (*p == 'n') && (p++,numBytes--));
  727. if ((numBytes == 0) || (*p != '#')) {
  728.     break;
  729. }
  730. if (parsePtr->commentStart == NULL) {
  731.     parsePtr->commentStart = p;
  732. }
  733. while (numBytes) {
  734.     if (*p == '\') {
  735. scanned = TclParseWhiteSpace(p, numBytes, parsePtr, &type);
  736. if (scanned) {
  737.     p += scanned; numBytes -= scanned;
  738. } else {
  739.     /*
  740.      * General backslash substitution in comments isn't
  741.      * part of the formal spec, but test parse-15.47
  742.      * and history indicate that it has been the de facto
  743.      * rule.  Don't change it now.
  744.      */
  745.     TclParseBackslash(p, numBytes, &scanned, NULL);
  746.     p += scanned; numBytes -= scanned;
  747. }
  748.     } else {
  749. p++; numBytes--;
  750. if (p[-1] == 'n') {
  751.     break;
  752. }
  753.     }
  754. }
  755. parsePtr->commentSize = p - parsePtr->commentStart;
  756.     }
  757.     return (p - src);
  758. }
  760. /*
  761.  *----------------------------------------------------------------------
  762.  *
  763.  * ParseTokens --
  764.  *
  765.  * This procedure forms the heart of the Tcl parser.  It parses one
  766.  * or more tokens from a string, up to a termination point
  767.  * specified by the caller.  This procedure is used to parse
  768.  * unquoted command words (those not in quotes or braces), words in
  769.  * quotes, and array indices for variables.  No more than numBytes
  770.  * bytes will be scanned.
  771.  *
  772.  * Results:
  773.  * Tokens are added to parsePtr and parsePtr->term is filled in
  774.  * with the address of the character that terminated the parse (the
  775.  * first one whose CHAR_TYPE matched mask or the character at
  776.  * parsePtr->end).  The return value is TCL_OK if the parse
  777.  * completed successfully and TCL_ERROR otherwise.  If a parse
  778.  * error occurs and parsePtr->interp isn't NULL, then an error
  779.  * message is left in the interpreter's result.
  780.  *
  781.  * Side effects:
  782.  * None.
  783.  *
  784.  *----------------------------------------------------------------------
  785.  */
  787. static int
  788. ParseTokens(src, numBytes, mask, parsePtr)
  789.     register CONST char *src; /* First character to parse. */
  790.     register int numBytes; /* Max number of bytes to scan. */
  791.     int mask; /* Specifies when to stop parsing.  The
  792.  * parse stops at the first unquoted
  793.  * character whose CHAR_TYPE contains
  794.  * any of the bits in mask. */
  795.     Tcl_Parse *parsePtr; /* Information about parse in progress.
  796.  * Updated with additional tokens and
  797.  * termination information. */
  798. {
  799.     char type; 
  800.     int originalTokens, varToken;
  801.     Tcl_Token *tokenPtr;
  802.     Tcl_Parse nested;
  804.     /*
  805.      * Each iteration through the following loop adds one token of
  806.      * type TCL_TOKEN_TEXT, TCL_TOKEN_BS, TCL_TOKEN_COMMAND, or
  807.      * TCL_TOKEN_VARIABLE to parsePtr.  For TCL_TOKEN_VARIABLE tokens,
  808.      * additional tokens are added for the parsed variable name.
  809.      */
  811.     originalTokens = parsePtr->numTokens;
  812.     while (numBytes && !((type = CHAR_TYPE(*src)) & mask)) {
  813. if (parsePtr->numTokens == parsePtr->tokensAvailable) {
  814.     TclExpandTokenArray(parsePtr);
  815. }
  816. tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
  817. tokenPtr->start = src;
  818. tokenPtr->numComponents = 0;
  820. if ((type & TYPE_SUBS) == 0) {
  821.     /*
  822.      * This is a simple range of characters.  Scan to find the end
  823.      * of the range.
  824.      */
  826.     while ((++src, --numBytes) 
  827.     && !(CHAR_TYPE(*src) & (mask | TYPE_SUBS))) {
  828. /* empty loop */
  829.     }
  830.     tokenPtr->type = TCL_TOKEN_TEXT;
  831.     tokenPtr->size = src - tokenPtr->start;
  832.     parsePtr->numTokens++;
  833. } else if (*src == '$') {
  834.     /*
  835.      * This is a variable reference.  Call Tcl_ParseVarName to do
  836.      * all the dirty work of parsing the name.
  837.      */
  839.     varToken = parsePtr->numTokens;
  840.     if (Tcl_ParseVarName(parsePtr->interp, src, numBytes,
  841.     parsePtr, 1) != TCL_OK) {
  842. return TCL_ERROR;
  843.     }
  844.     src += parsePtr->tokenPtr[varToken].size;
  845.     numBytes -= parsePtr->tokenPtr[varToken].size;
  846. } else if (*src == '[') {
  847.     /*
  848.      * Command substitution.  Call Tcl_ParseCommand recursively
  849.      * (and repeatedly) to parse the nested command(s), then
  850.      * throw away the parse information.
  851.      */
  853.     src++; numBytes--;
  854.     while (1) {
  855. if (Tcl_ParseCommand(parsePtr->interp, src,
  856. numBytes, 1, &nested) != TCL_OK) {
  857.     parsePtr->errorType = nested.errorType;
  858.     parsePtr->term = nested.term;
  859.     parsePtr->incomplete = nested.incomplete;
  860.     return TCL_ERROR;
  861. }
  862. src = nested.commandStart + nested.commandSize;
  863. numBytes = parsePtr->end - src;
  865. /*
  866.  * This is equivalent to Tcl_FreeParse(&nested), but
  867.  * presumably inlined here for sake of runtime optimization
  868.  */
  870. if (nested.tokenPtr != nested.staticTokens) {
  871.     ckfree((char *) nested.tokenPtr);
  872. }
  874. /*
  875.  * Check for the closing ']' that ends the command
  876.  * substitution.  It must have been the last character of
  877.  * the parsed command.
  878.  */
  880. if ((nested.term < parsePtr->end) && (*nested.term == ']')
  881. && !nested.incomplete) {
  882.     break;
  883. }
  884. if (numBytes == 0) {
  885.     if (parsePtr->interp != NULL) {
  886. Tcl_SetResult(parsePtr->interp,
  887.     "missing close-bracket", TCL_STATIC);
  888.     }
  889.     parsePtr->errorType = TCL_PARSE_MISSING_BRACKET;
  890.     parsePtr->term = tokenPtr->start;
  891.     parsePtr->incomplete = 1;
  892.     return TCL_ERROR;
  893. }
  894.     }
  895.     tokenPtr->type = TCL_TOKEN_COMMAND;
  896.     tokenPtr->size = src - tokenPtr->start;
  897.     parsePtr->numTokens++;
  898. } else if (*src == '\') {
  899.     /*
  900.      * Backslash substitution.
  901.      */
  902.     TclParseBackslash(src, numBytes, &tokenPtr->size, NULL);
  904.     if (tokenPtr->size == 1) {
  905. /* Just a backslash, due to end of string */
  906. tokenPtr->type = TCL_TOKEN_TEXT;
  907. parsePtr->numTokens++;
  908. src++; numBytes--;
  909. continue;
  910.     }
  912.     if (src[1] == 'n') {
  913. if (numBytes == 2) {
  914.     parsePtr->incomplete = 1;
  915. }
  917. /*
  918.  * Note: backslash-newline is special in that it is
  919.  * treated the same as a space character would be.  This
  920.  * means that it could terminate the token.
  921.  */
  923. if (mask & TYPE_SPACE) {
  924.     if (parsePtr->numTokens == originalTokens) {
  925. goto finishToken;
  926.     }
  927.     break;
  928. }
  929.     }
  931.     tokenPtr->type = TCL_TOKEN_BS;
  932.     parsePtr->numTokens++;
  933.     src += tokenPtr->size;
  934.     numBytes -= tokenPtr->size;
  935. } else if (*src == 0) {
  936.     tokenPtr->type = TCL_TOKEN_TEXT;
  937.     tokenPtr->size = 1;
  938.     parsePtr->numTokens++;
  939.     src++; numBytes--;
  940. } else {
  941.     panic("ParseTokens encountered unknown character");
  942. }
  943.     }
  944.     if (parsePtr->numTokens == originalTokens) {
  945. /*
  946.  * There was nothing in this range of text.  Add an empty token
  947.  * for the empty range, so that there is always at least one
  948.  * token added.
  949.  */
  950. if (parsePtr->numTokens == parsePtr->tokensAvailable) {
  951.     TclExpandTokenArray(parsePtr);
  952. }
  953. tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
  954. tokenPtr->start = src;
  955. tokenPtr->numComponents = 0;
  957. finishToken:
  958. tokenPtr->type = TCL_TOKEN_TEXT;
  959. tokenPtr->size = 0;
  960. parsePtr->numTokens++;
  961.     }
  962.     parsePtr->term = src;
  963.     return TCL_OK;
  964. }
  966. /*
  967.  *----------------------------------------------------------------------
  968.  *
  969.  * Tcl_FreeParse --
  970.  *
  971.  * This procedure is invoked to free any dynamic storage that may
  972.  * have been allocated by a previous call to Tcl_ParseCommand.
  973.  *
  974.  * Results:
  975.  * None.
  976.  *
  977.  * Side effects:
  978.  * If there is any dynamically allocated memory in *parsePtr,
  979.  * it is freed.
  980.  *
  981.  *----------------------------------------------------------------------
  982.  */
  984. void
  985. Tcl_FreeParse(parsePtr)
  986.     Tcl_Parse *parsePtr; /* Structure that was filled in by a
  987.  * previous call to Tcl_ParseCommand. */
  988. {
  989.     if (parsePtr->tokenPtr != parsePtr->staticTokens) {
  990. ckfree((char *) parsePtr->tokenPtr);
  991. parsePtr->tokenPtr = parsePtr->staticTokens;
  992.     }
  993. }
  995. /*
  996.  *----------------------------------------------------------------------
  997.  *
  998.  * TclExpandTokenArray --
  999.  *
  1000.  * This procedure is invoked when the current space for tokens in
  1001.  * a Tcl_Parse structure fills up; it allocates memory to grow the
  1002.  * token array
  1003.  *
  1004.  * Results:
  1005.  * None.
  1006.  *
  1007.  * Side effects:
  1008.  * Memory is allocated for a new larger token array; the memory
  1009.  * for the old array is freed, if it had been dynamically allocated.
  1010.  *
  1011.  *----------------------------------------------------------------------
  1012.  */
  1014. void
  1015. TclExpandTokenArray(parsePtr)
  1016.     Tcl_Parse *parsePtr; /* Parse structure whose token space
  1017.  * has overflowed. */
  1018. {
  1019.     int newCount;
  1020.     Tcl_Token *newPtr;
  1022.     newCount = parsePtr->tokensAvailable*2;
  1023.     newPtr = (Tcl_Token *) ckalloc((unsigned) (newCount * sizeof(Tcl_Token)));
  1024.     memcpy((VOID *) newPtr, (VOID *) parsePtr->tokenPtr,
  1025.     (size_t) (parsePtr->tokensAvailable * sizeof(Tcl_Token)));
  1026.     if (parsePtr->tokenPtr != parsePtr->staticTokens) {
  1027. ckfree((char *) parsePtr->tokenPtr);
  1028.     }
  1029.     parsePtr->tokenPtr = newPtr;
  1030.     parsePtr->tokensAvailable = newCount;
  1031. }
  1033. /*
  1034.  *----------------------------------------------------------------------
  1035.  *
  1036.  * Tcl_ParseVarName --
  1037.  *
  1038.  * Given a string starting with a $ sign, parse off a variable
  1039.  * name and return information about the parse.  No more than
  1040.  * numBytes bytes will be scanned.
  1041.  *
  1042.  * Results:
  1043.  * The return value is TCL_OK if the command was parsed
  1044.  * successfully and TCL_ERROR otherwise.  If an error occurs and
  1045.  * interp isn't NULL then an error message is left in its result. 
  1046.  * On a successful return, tokenPtr and numTokens fields of
  1047.  * parsePtr are filled in with information about the variable name
  1048.  * that was parsed.  The "size" field of the first new token gives
  1049.  * the total number of bytes in the variable name.  Other fields in
  1050.  * parsePtr are undefined.
  1051.  *
  1052.  * Side effects:
  1053.  * If there is insufficient space in parsePtr to hold all the
  1054.  * information about the command, then additional space is
  1055.  * malloc-ed.  If the procedure returns TCL_OK then the caller must
  1056.  * eventually invoke Tcl_FreeParse to release any additional space
  1057.  * that was allocated.
  1058.  *
  1059.  *----------------------------------------------------------------------
  1060.  */
  1062. int
  1063. Tcl_ParseVarName(interp, string, numBytes, parsePtr, append)
  1064.     Tcl_Interp *interp; /* Interpreter to use for error reporting;
  1065.  * if NULL, then no error message is
  1066.  * provided. */
  1067.     CONST char *string; /* String containing variable name.  First
  1068.  * character must be "$". */
  1069.     register int numBytes; /* Total number of bytes in string.  If < 0,
  1070.  * the string consists of all bytes up to the
  1071.  * first null character. */
  1072.     Tcl_Parse *parsePtr; /* Structure to fill in with information
  1073.  * about the variable name. */
  1074.     int append; /* Non-zero means append tokens to existing
  1075.  * information in parsePtr; zero means ignore
  1076.  * existing tokens in parsePtr and reinitialize
  1077.  * it. */
  1078. {
  1079.     Tcl_Token *tokenPtr;
  1080.     register CONST char *src;
  1081.     unsigned char c;
  1082.     int varIndex, offset;
  1083.     Tcl_UniChar ch;
  1084.     unsigned array;
  1086.     if ((numBytes == 0) || (string == NULL)) {
  1087. return TCL_ERROR;
  1088.     }
  1089.     if (numBytes < 0) {
  1090. numBytes = strlen(string);
  1091.     }
  1093.     if (!append) {
  1094. parsePtr->numWords = 0;
  1095. parsePtr->tokenPtr = parsePtr->staticTokens;
  1096. parsePtr->numTokens = 0;
  1097. parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
  1098. parsePtr->string = string;
  1099. parsePtr->end = (string + numBytes);
  1100. parsePtr->interp = interp;
  1101. parsePtr->errorType = TCL_PARSE_SUCCESS;
  1102. parsePtr->incomplete = 0;
  1103.     }
  1105.     /*
  1106.      * Generate one token for the variable, an additional token for the
  1107.      * name, plus any number of additional tokens for the index, if
  1108.      * there is one.
  1109.      */
  1111.     src = string;
  1112.     if ((parsePtr->numTokens + 2) > parsePtr->tokensAvailable) {
  1113. TclExpandTokenArray(parsePtr);
  1114.     }
  1115.     tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
  1116.     tokenPtr->type = TCL_TOKEN_VARIABLE;
  1117.     tokenPtr->start = src;
  1118.     varIndex = parsePtr->numTokens;
  1119.     parsePtr->numTokens++;
  1120.     tokenPtr++;
  1121.     src++; numBytes--;
  1122.     if (numBytes == 0) {
  1123. goto justADollarSign;
  1124.     }
  1125.     tokenPtr->type = TCL_TOKEN_TEXT;
  1126.     tokenPtr->start = src;
  1127.     tokenPtr->numComponents = 0;
  1129.     /*
  1130.      * The name of the variable can have three forms:
  1131.      * 1. The $ sign is followed by an open curly brace.  Then 
  1132.      *    the variable name is everything up to the next close
  1133.      *    curly brace, and the variable is a scalar variable.
  1134.      * 2. The $ sign is not followed by an open curly brace.  Then
  1135.      *    the variable name is everything up to the next
  1136.      *    character that isn't a letter, digit, or underscore.
  1137.      *    :: sequences are also considered part of the variable
  1138.      *    name, in order to support namespaces. If the following
  1139.      *    character is an open parenthesis, then the information
  1140.      *    between parentheses is the array element name.
  1141.      * 3. The $ sign is followed by something that isn't a letter,
  1142.      *    digit, or underscore:  in this case, there is no variable
  1143.      *    name and the token is just "$".
  1144.      */
  1146.     if (*src == '{') {
  1147. src++; numBytes--;
  1148. tokenPtr->type = TCL_TOKEN_TEXT;
  1149. tokenPtr->start = src;
  1150. tokenPtr->numComponents = 0;
  1152. while (numBytes && (*src != '}')) {
  1153.     numBytes--; src++;
  1154. }
  1155. if (numBytes == 0) {
  1156.     if (parsePtr->interp != NULL) {
  1157. Tcl_SetResult(parsePtr->interp,
  1158. "missing close-brace for variable name", TCL_STATIC);
  1159.     }
  1160.     parsePtr->errorType = TCL_PARSE_MISSING_VAR_BRACE;
  1161.     parsePtr->term = tokenPtr->start-1;
  1162.     parsePtr->incomplete = 1;
  1163.     goto error;
  1164. }
  1165. tokenPtr->size = src - tokenPtr->start;
  1166. tokenPtr[-1].size = src - tokenPtr[-1].start;
  1167. parsePtr->numTokens++;
  1168. src++;
  1169.     } else {
  1170. tokenPtr->type = TCL_TOKEN_TEXT;
  1171. tokenPtr->start = src;
  1172. tokenPtr->numComponents = 0;
  1173. while (numBytes) {
  1174.     if (Tcl_UtfCharComplete(src, numBytes)) {
  1175.         offset = Tcl_UtfToUniChar(src, &ch);
  1176.     } else {
  1177. char utfBytes[TCL_UTF_MAX];
  1178. memcpy(utfBytes, src, (size_t) numBytes);
  1179. utfBytes[numBytes] = '';
  1180.         offset = Tcl_UtfToUniChar(utfBytes, &ch);
  1181.     }
  1182.     c = UCHAR(ch);
  1183.     if (isalnum(c) || (c == '_')) { /* INTL: ISO only, UCHAR. */
  1184. src += offset;  numBytes -= offset;
  1185. continue;
  1186.     }
  1187.     if ((c == ':') && (numBytes != 1) && (src[1] == ':')) {
  1188. src += 2; numBytes -= 2;
  1189. while (numBytes && (*src == ':')) {
  1190.     src++; numBytes--; 
  1191. }
  1192. continue;
  1193.     }
  1194.     break;
  1195. }
  1197. /*
  1198.  * Support for empty array names here.
  1199.  */
  1200. array = (numBytes && (*src == '('));
  1201. tokenPtr->size = src - tokenPtr->start;
  1202. if ((tokenPtr->size == 0) && !array) {
  1203.     goto justADollarSign;
  1204. }
  1205. parsePtr->numTokens++;
  1206. if (array) {
  1207.     /*
  1208.      * This is a reference to an array element.  Call
  1209.      * ParseTokens recursively to parse the element name,
  1210.      * since it could contain any number of substitutions.
  1211.      */
  1213.     if (ParseTokens(src+1, numBytes-1, TYPE_CLOSE_PAREN, parsePtr)
  1214.     != TCL_OK) {
  1215. goto error;
  1216.     }
  1217.     if ((parsePtr->term == (src + numBytes)) 
  1218.     || (*parsePtr->term != ')')) { 
  1219. if (parsePtr->interp != NULL) {
  1220.     Tcl_SetResult(parsePtr->interp, "missing )",
  1221.     TCL_STATIC);
  1222. }
  1223. parsePtr->errorType = TCL_PARSE_MISSING_PAREN;
  1224. parsePtr->term = src;
  1225. parsePtr->incomplete = 1;
  1226. goto error;
  1227.     }
  1228.     src = parsePtr->term + 1;
  1229. }
  1230.     }
  1231.     tokenPtr = &parsePtr->tokenPtr[varIndex];
  1232.     tokenPtr->size = src - tokenPtr->start;
  1233.     tokenPtr->numComponents = parsePtr->numTokens - (varIndex + 1);
  1234.     return TCL_OK;
  1236.     /*
  1237.      * The dollar sign isn't followed by a variable name.
  1238.      * replace the TCL_TOKEN_VARIABLE token with a
  1239.      * TCL_TOKEN_TEXT token for the dollar sign.
  1240.      */
  1242.     justADollarSign:
  1243.     tokenPtr = &parsePtr->tokenPtr[varIndex];
  1244.     tokenPtr->type = TCL_TOKEN_TEXT;
  1245.     tokenPtr->size = 1;
  1246.     tokenPtr->numComponents = 0;
  1247.     return TCL_OK;
  1249.     error:
  1250.     Tcl_FreeParse(parsePtr);
  1251.     return TCL_ERROR;
  1252. }
  1254. /*
  1255.  *----------------------------------------------------------------------
  1256.  *
  1257.  * Tcl_ParseVar --
  1258.  *
  1259.  * Given a string starting with a $ sign, parse off a variable
  1260.  * name and return its value.
  1261.  *
  1262.  * Results:
  1263.  * The return value is the contents of the variable given by
  1264.  * the leading characters of string.  If termPtr isn't NULL,
  1265.  * *termPtr gets filled in with the address of the character
  1266.  * just after the last one in the variable specifier.  If the
  1267.  * variable doesn't exist, then the return value is NULL and
  1268.  * an error message will be left in interp's result.
  1269.  *
  1270.  * Side effects:
  1271.  * None.
  1272.  *
  1273.  *----------------------------------------------------------------------
  1274.  */
  1276. CONST char *
  1277. Tcl_ParseVar(interp, string, termPtr)
  1278.     Tcl_Interp *interp; /* Context for looking up variable. */
  1279.     register CONST char *string; /* String containing variable name.
  1280.  * First character must be "$". */
  1281.     CONST char **termPtr; /* If non-NULL, points to word to fill
  1282.  * in with character just after last
  1283.  * one in the variable specifier. */
  1285. {
  1286.     Tcl_Parse parse;
  1287.     register Tcl_Obj *objPtr;
  1288.     int code;
  1290.     if (Tcl_ParseVarName(interp, string, -1, &parse, 0) != TCL_OK) {
  1291. return NULL;
  1292.     }
  1294.     if (termPtr != NULL) {
  1295. *termPtr = string + parse.tokenPtr->size;
  1296.     }
  1297.     if (parse.numTokens == 1) {
  1298. /*
  1299.  * There isn't a variable name after all: the $ is just a $.
  1300.  */
  1302. return "$";
  1303.     }
  1305.     code = Tcl_EvalTokensStandard(interp, parse.tokenPtr, parse.numTokens);
  1306.     if (code != TCL_OK) {
  1307. return NULL;
  1308.     }
  1309.     objPtr = Tcl_GetObjResult(interp);
  1311.     /*
  1312.      * At this point we should have an object containing the value of
  1313.      * a variable.  Just return the string from that object.
  1314.      *
  1315.      * This should have returned the object for the user to manage, but
  1316.      * instead we have some weak reference to the string value in the
  1317.      * object, which is why we make sure the object exists after resetting
  1318.      * the result.  This isn't ideal, but it's the best we can do with the
  1319.      * current documented interface. -- hobbs
  1320.      */
  1322.     if (!Tcl_IsShared(objPtr)) {
  1323. Tcl_IncrRefCount(objPtr);
  1324.     }
  1325.     Tcl_ResetResult(interp);
  1326.     return TclGetString(objPtr);
  1327. }
  1329. /*
  1330.  *----------------------------------------------------------------------
  1331.  *
  1332.  * Tcl_ParseBraces --
  1333.  *
  1334.  * Given a string in braces such as a Tcl command argument or a string
  1335.  * value in a Tcl expression, this procedure parses the string and
  1336.  * returns information about the parse.  No more than numBytes bytes
  1337.  * will be scanned.
  1338.  *
  1339.  * Results:
  1340.  * The return value is TCL_OK if the string was parsed successfully and
  1341.  * TCL_ERROR otherwise. If an error occurs and interp isn't NULL then
  1342.  * an error message is left in its result. On a successful return,
  1343.  * tokenPtr and numTokens fields of parsePtr are filled in with
  1344.  * information about the string that was parsed. Other fields in
  1345.  * parsePtr are undefined. termPtr is set to point to the character
  1346.  * just after the last one in the braced string.
  1347.  *
  1348.  * Side effects:
  1349.  * If there is insufficient space in parsePtr to hold all the
  1350.  * information about the command, then additional space is
  1351.  * malloc-ed. If the procedure returns TCL_OK then the caller must
  1352.  * eventually invoke Tcl_FreeParse to release any additional space
  1353.  * that was allocated.
  1354.  *
  1355.  *----------------------------------------------------------------------
  1356.  */
  1358. int
  1359. Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr)
  1360.     Tcl_Interp *interp; /* Interpreter to use for error reporting;
  1361.  * if NULL, then no error message is
  1362.  * provided. */
  1363.     CONST char *string; /* String containing the string in braces.
  1364.  * The first character must be '{'. */
  1365.     register int numBytes; /* Total number of bytes in string. If < 0,
  1366.  * the string consists of all bytes up to
  1367.  * the first null character. */
  1368.     register Tcl_Parse *parsePtr;
  1369.      /* Structure to fill in with information
  1370.  * about the string. */
  1371.     int append; /* Non-zero means append tokens to existing
  1372.  * information in parsePtr; zero means
  1373.  * ignore existing tokens in parsePtr and
  1374.  * reinitialize it. */
  1375.     CONST char **termPtr; /* If non-NULL, points to word in which to
  1376.  * store a pointer to the character just
  1377.  * after the terminating '}' if the parse
  1378.  * was successful. */
  1380. {
  1381.     Tcl_Token *tokenPtr;
  1382.     register CONST char *src;
  1383.     int startIndex, level, length;
  1385.     if ((numBytes == 0) || (string == NULL)) {
  1386. return TCL_ERROR;
  1387.     }
  1388.     if (numBytes < 0) {
  1389. numBytes = strlen(string);
  1390.     }
  1392.     if (!append) {
  1393. parsePtr->numWords = 0;
  1394. parsePtr->tokenPtr = parsePtr->staticTokens;
  1395. parsePtr->numTokens = 0;
  1396. parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
  1397. parsePtr->string = string;
  1398. parsePtr->end = (string + numBytes);
  1399. parsePtr->interp = interp;
  1400. parsePtr->errorType = TCL_PARSE_SUCCESS;
  1401.     }
  1403.     src = string;
  1404.     startIndex = parsePtr->numTokens;
  1406.     if (parsePtr->numTokens == parsePtr->tokensAvailable) {
  1407. TclExpandTokenArray(parsePtr);
  1408.     }
  1409.     tokenPtr = &parsePtr->tokenPtr[startIndex];
  1410.     tokenPtr->type = TCL_TOKEN_TEXT;
  1411.     tokenPtr->start = src+1;
  1412.     tokenPtr->numComponents = 0;
  1413.     level = 1;
  1414.     while (1) {
  1415. while (++src, --numBytes) {
  1416.     if (CHAR_TYPE(*src) != TYPE_NORMAL) {
  1417. break;
  1418.     }
  1419. }
  1420. if (numBytes == 0) {
  1421.     register int openBrace = 0;
  1423.     parsePtr->errorType = TCL_PARSE_MISSING_BRACE;
  1424.     parsePtr->term = string;
  1425.     parsePtr->incomplete = 1;
  1426.     if (parsePtr->interp == NULL) {
  1427. /*
  1428.  * Skip straight to the exit code since we have no
  1429.  * interpreter to put error message in.
  1430.  */
  1431. goto error;
  1432.     }
  1434.     Tcl_SetResult(parsePtr->interp, "missing close-brace", TCL_STATIC);
  1436.     /*
  1437.      *  Guess if the problem is due to comments by searching
  1438.      *  the source string for a possible open brace within the
  1439.      *  context of a comment.  Since we aren't performing a
  1440.      *  full Tcl parse, just look for an open brace preceded
  1441.      *  by a '<whitespace>#' on the same line.
  1442.      */
  1444.     while (--src > string) {
  1445. switch (*src) {
  1446.     case '{':
  1447. openBrace = 1;
  1448. break;
  1449.     case 'n':
  1450. openBrace = 0;
  1451. break;
  1452.     case '#' :
  1453. if (openBrace && (isspace(UCHAR(src[-1])))) {
  1454.     Tcl_AppendResult(parsePtr->interp,
  1455.     ": possible unbalanced brace in comment",
  1456.     (char *) NULL);
  1457.     goto error;
  1458. }
  1459. break;
  1460. }
  1461.     }
  1463.     error:
  1464.     Tcl_FreeParse(parsePtr);
  1465.     return TCL_ERROR;
  1466. }
  1467. switch (*src) {
  1468.     case '{':
  1469. level++;
  1470. break;
  1471.     case '}':
  1472. if (--level == 0) {
  1474.     /*
  1475.      * Decide if we need to finish emitting a
  1476.      * partially-finished token.  There are 3 cases:
  1477.      *     {abc newline xyz} or {xyz}
  1478.      * - finish emitting "xyz" token
  1479.      *     {abc newline}
  1480.      * - don't emit token after newline
  1481.      *     {} - finish emitting zero-sized token
  1482.      *
  1483.      * The last case ensures that there is a token
  1484.      * (even if empty) that describes the braced string.
  1485.      */
  1486.     
  1487.     if ((src != tokenPtr->start)
  1488.     || (parsePtr->numTokens == startIndex)) {
  1489. tokenPtr->size = (src - tokenPtr->start);
  1490. parsePtr->numTokens++;
  1491.     }
  1492.     if (termPtr != NULL) {
  1493. *termPtr = src+1;
  1494.     }
  1495.     return TCL_OK;
  1496. }
  1497. break;
  1498.     case '\':
  1499. TclParseBackslash(src, numBytes, &length, NULL);
  1500. if ((length > 1) && (src[1] == 'n')) {
  1501.     /*
  1502.      * A backslash-newline sequence must be collapsed, even
  1503.      * inside braces, so we have to split the word into
  1504.      * multiple tokens so that the backslash-newline can be
  1505.      * represented explicitly.
  1506.      */
  1508.     if (numBytes == 2) {
  1509. parsePtr->incomplete = 1;
  1510.     }
  1511.     tokenPtr->size = (src - tokenPtr->start);
  1512.     if (tokenPtr->size != 0) {
  1513. parsePtr->numTokens++;
  1514.     }
  1515.     if ((parsePtr->numTokens+1) >= parsePtr->tokensAvailable) {
  1516. TclExpandTokenArray(parsePtr);
  1517.     }
  1518.     tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
  1519.     tokenPtr->type = TCL_TOKEN_BS;
  1520.     tokenPtr->start = src;
  1521.     tokenPtr->size = length;
  1522.     tokenPtr->numComponents = 0;
  1523.     parsePtr->numTokens++;
  1525.     src += length - 1;
  1526.     numBytes -= length - 1;
  1527.     tokenPtr++;
  1528.     tokenPtr->type = TCL_TOKEN_TEXT;
  1529.     tokenPtr->start = src + 1;
  1530.     tokenPtr->numComponents = 0;
  1531. } else {
  1532.     src += length - 1;
  1533.     numBytes -= length - 1;
  1534. }
  1535. break;
  1536. }
  1537.     }
  1538. }
  1540. /*
  1541.  *----------------------------------------------------------------------
  1542.  *
  1543.  * Tcl_ParseQuotedString --
  1544.  *
  1545.  * Given a double-quoted string such as a quoted Tcl command argument
  1546.  * or a quoted value in a Tcl expression, this procedure parses the
  1547.  * string and returns information about the parse.  No more than
  1548.  * numBytes bytes will be scanned.
  1549.  *
  1550.  * Results:
  1551.  * The return value is TCL_OK if the string was parsed successfully and
  1552.  * TCL_ERROR otherwise. If an error occurs and interp isn't NULL then
  1553.  * an error message is left in its result. On a successful return,
  1554.  * tokenPtr and numTokens fields of parsePtr are filled in with
  1555.  * information about the string that was parsed. Other fields in
  1556.  * parsePtr are undefined. termPtr is set to point to the character
  1557.  * just after the quoted string's terminating close-quote.
  1558.  *
  1559.  * Side effects:
  1560.  * If there is insufficient space in parsePtr to hold all the
  1561.  * information about the command, then additional space is
  1562.  * malloc-ed. If the procedure returns TCL_OK then the caller must
  1563.  * eventually invoke Tcl_FreeParse to release any additional space
  1564.  * that was allocated.
  1565.  *
  1566.  *----------------------------------------------------------------------
  1567.  */
  1569. int
  1570. Tcl_ParseQuotedString(interp, string, numBytes, parsePtr, append, termPtr)
  1571.     Tcl_Interp *interp; /* Interpreter to use for error reporting;
  1572.  * if NULL, then no error message is
  1573.  * provided. */
  1574.     CONST char *string; /* String containing the quoted string. 
  1575.  * The first character must be '"'. */
  1576.     register int numBytes; /* Total number of bytes in string. If < 0,
  1577.  * the string consists of all bytes up to
  1578.  * the first null character. */
  1579.     register Tcl_Parse *parsePtr;
  1580.      /* Structure to fill in with information
  1581.  * about the string. */
  1582.     int append; /* Non-zero means append tokens to existing
  1583.  * information in parsePtr; zero means
  1584.  * ignore existing tokens in parsePtr and
  1585.  * reinitialize it. */
  1586.     CONST char **termPtr; /* If non-NULL, points to word in which to
  1587.  * store a pointer to the character just
  1588.  * after the quoted string's terminating
  1589.  * close-quote if the parse succeeds. */
  1590. {
  1591.     if ((numBytes == 0) || (string == NULL)) {
  1592. return TCL_ERROR;
  1593.     }
  1594.     if (numBytes < 0) {
  1595. numBytes = strlen(string);
  1596.     }
  1598.     if (!append) {
  1599. parsePtr->numWords = 0;
  1600. parsePtr->tokenPtr = parsePtr->staticTokens;
  1601. parsePtr->numTokens = 0;
  1602. parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
  1603. parsePtr->string = string;
  1604. parsePtr->end = (string + numBytes);
  1605. parsePtr->interp = interp;
  1606. parsePtr->errorType = TCL_PARSE_SUCCESS;
  1607.     }
  1608.     
  1609.     if (ParseTokens(string+1, numBytes-1, TYPE_QUOTE, parsePtr) != TCL_OK) {
  1610. goto error;
  1611.     }
  1612.     if (*parsePtr->term != '"') {
  1613. if (parsePtr->interp != NULL) {
  1614.     Tcl_SetResult(parsePtr->interp, "missing "", TCL_STATIC);
  1615. }
  1616. parsePtr->errorType = TCL_PARSE_MISSING_QUOTE;
  1617. parsePtr->term = string;
  1618. parsePtr->incomplete = 1;
  1619. goto error;
  1620.     }
  1621.     if (termPtr != NULL) {
  1622. *termPtr = (parsePtr->term + 1);
  1623.     }
  1624.     return TCL_OK;
  1626.     error:
  1627.     Tcl_FreeParse(parsePtr);
  1628.     return TCL_ERROR;
  1629. }
  1631. /*
  1632.  *----------------------------------------------------------------------
  1633.  *
  1634.  * CommandComplete --
  1635.  *
  1636.  * This procedure is shared by TclCommandComplete and
  1637.  * Tcl_ObjCommandcoComplete; it does all the real work of seeing
  1638.  * whether a script is complete
  1639.  *
  1640.  * Results:
  1641.  * 1 is returned if the script is complete, 0 if there are open
  1642.  * delimiters such as " or (. 1 is also returned if there is a
  1643.  * parse error in the script other than unmatched delimiters.
  1644.  *
  1645.  * Side effects:
  1646.  * None.
  1647.  *
  1648.  *----------------------------------------------------------------------
  1649.  */
  1651. static int
  1652. CommandComplete(script, numBytes)
  1653.     CONST char *script; /* Script to check. */
  1654.     int numBytes; /* Number of bytes in script. */
  1655. {
  1656.     Tcl_Parse parse;
  1657.     CONST char *p, *end;
  1658.     int result;
  1660.     p = script;
  1661.     end = p + numBytes;
  1662.     while (Tcl_ParseCommand((Tcl_Interp *) NULL, p, end - p, 0, &parse)
  1663.     == TCL_OK) {
  1664. p = parse.commandStart + parse.commandSize;
  1665. if (p >= end) {
  1666.     break;
  1667. }
  1668. Tcl_FreeParse(&parse);
  1669.     }
  1670.     if (parse.incomplete) {
  1671. result = 0;
  1672.     } else {
  1673. result = 1;
  1674.     }
  1675.     Tcl_FreeParse(&parse);
  1676.     return result;
  1677. }
  1679. /*
  1680.  *----------------------------------------------------------------------
  1681.  *
  1682.  * Tcl_CommandComplete --
  1683.  *
  1684.  * Given a partial or complete Tcl script, this procedure
  1685.  * determines whether the script is complete in the sense
  1686.  * of having matched braces and quotes and brackets.
  1687.  *
  1688.  * Results:
  1689.  * 1 is returned if the script is complete, 0 otherwise.
  1690.  * 1 is also returned if there is a parse error in the script
  1691.  * other than unmatched delimiters.
  1692.  *
  1693.  * Side effects:
  1694.  * None.
  1695.  *
  1696.  *----------------------------------------------------------------------
  1697.  */
  1699. int
  1700. Tcl_CommandComplete(script)
  1701.     CONST char *script; /* Script to check. */
  1702. {
  1703.     return CommandComplete(script, (int) strlen(script));
  1704. }
  1706. /*
  1707.  *----------------------------------------------------------------------
  1708.  *
  1709.  * TclObjCommandComplete --
  1710.  *
  1711.  * Given a partial or complete Tcl command in a Tcl object, this
  1712.  * procedure determines whether the command is complete in the sense of
  1713.  * having matched braces and quotes and brackets.
  1714.  *
  1715.  * Results:
  1716.  * 1 is returned if the command is complete, 0 otherwise.
  1717.  *
  1718.  * Side effects:
  1719.  * None.
  1720.  *
  1721.  *----------------------------------------------------------------------
  1722.  */
  1724. int
  1725. TclObjCommandComplete(objPtr)
  1726.     Tcl_Obj *objPtr; /* Points to object holding script
  1727.  * to check. */
  1728. {
  1729.     CONST char *script;
  1730.     int length;
  1732.     script = Tcl_GetStringFromObj(objPtr, &length);
  1733.     return CommandComplete(script, length);
  1734. }
  1736. /*
  1737.  *----------------------------------------------------------------------
  1738.  *
  1739.  * TclIsLocalScalar --
  1740.  *
  1741.  * Check to see if a given string is a legal scalar variable
  1742.  * name with no namespace qualifiers or substitutions.
  1743.  *
  1744.  * Results:
  1745.  * Returns 1 if the variable is a local scalar.
  1746.  *
  1747.  * Side effects:
  1748.  * None.
  1749.  *
  1750.  *----------------------------------------------------------------------
  1751.  */
  1753. int
  1754. TclIsLocalScalar(src, len)
  1755.     CONST char *src;
  1756.     int len;
  1757. {
  1758.     CONST char *p;
  1759.     CONST char *lastChar = src + (len - 1);
  1761.     for (p = src; p <= lastChar; p++) {
  1762. if ((CHAR_TYPE(*p) != TYPE_NORMAL) &&
  1763. (CHAR_TYPE(*p) != TYPE_COMMAND_END)) {
  1764.     /*
  1765.      * TCL_COMMAND_END is returned for the last character
  1766.      * of the string.  By this point we know it isn't
  1767.      * an array or namespace reference.
  1768.      */
  1770.     return 0;
  1771. }
  1772. if  (*p == '(') {
  1773.     if (*lastChar == ')') { /* we have an array element */
  1774. return 0;
  1775.     }
  1776. } else if (*p == ':') {
  1777.     if ((p != lastChar) && *(p+1) == ':') { /* qualified name */
  1778. return 0;
  1779.     }
  1780. }
  1781.     }
  1783.     return 1;
  1784. }