home *** CD-ROM | disk | FTP | other *** search
/ ARM Club 3 / TheARMClub_PDCD3.iso / hensa / programming / tcl / tclsrc / c / tclUtil < prev    next >
Text File  |  1996-01-28  |  56KB  |  2,148 lines
  1. /*
  2.  * tclUtil.c --
  3.  *
  4.  *    This file contains utility procedures that are used by many Tcl
  5.  *    commands.
  6.  *
  7.  * Copyright (c) 1987-1993 The Regents of the University of California.
  8.  * Copyright (c) 1994-1995 Sun Microsystems, Inc.
  9.  *
  10.  * See the file "license.terms" for information on usage and redistribution
  11.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12.  */
  13.  
  14. static char sccsid[] = "@(#) tclUtil.c 1.108 95/06/19 08:06:31";
  15.  
  16. #include "tclInt.h"
  17. #ifndef TCL_GENERIC_ONLY /* not for RISCOS*/
  18. #include "tclPort.h"
  19. #endif
  20.  
  21. /*
  22.  * The following values are used in the flags returned by Tcl_ScanElement
  23.  * and used by Tcl_ConvertElement.  The value TCL_DONT_USE_BRACES is also
  24.  * defined in tcl.h;  make sure its value doesn't overlap with any of the
  25.  * values below.
  26.  *
  27.  * TCL_DONT_USE_BRACES -    1 means the string mustn't be enclosed in
  28.  *                braces (e.g. it contains unmatched braces,
  29.  *                or ends in a backslash character, or user
  30.  *                just doesn't want braces);  handle all
  31.  *                special characters by adding backslashes.
  32.  * USE_BRACES -            1 means the string contains a special
  33.  *                character that can be handled simply by
  34.  *                enclosing the entire argument in braces.
  35.  * BRACES_UNMATCHED -        1 means that braces aren't properly matched
  36.  *                in the argument.
  37.  */
  38.  
  39. #define USE_BRACES        2
  40. #define BRACES_UNMATCHED    4
  41.  
  42. /*
  43.  * Function prototypes for local procedures in this file:
  44.  */
  45.  
  46. static void        SetupAppendBuffer _ANSI_ARGS_((Interp *iPtr,
  47.                 int newSpace));
  48.  
  49. /*
  50.  *----------------------------------------------------------------------
  51.  *
  52.  * TclFindElement --
  53.  *
  54.  *    Given a pointer into a Tcl list, locate the first (or next)
  55.  *    element in the list.
  56.  *
  57.  * Results:
  58.  *    The return value is normally TCL_OK, which means that the
  59.  *    element was successfully located.  If TCL_ERROR is returned
  60.  *    it means that list didn't have proper list structure;
  61.  *    interp->result contains a more detailed error message.
  62.  *
  63.  *    If TCL_OK is returned, then *elementPtr will be set to point
  64.  *    to the first element of list, and *nextPtr will be set to point
  65.  *    to the character just after any white space following the last
  66.  *    character that's part of the element.  If this is the last argument
  67.  *    in the list, then *nextPtr will point to the NULL character at the
  68.  *    end of list.  If sizePtr is non-NULL, *sizePtr is filled in with
  69.  *    the number of characters in the element.  If the element is in
  70.  *    braces, then *elementPtr will point to the character after the
  71.  *    opening brace and *sizePtr will not include either of the braces.
  72.  *    If there isn't an element in the list, *sizePtr will be zero, and
  73.  *    both *elementPtr and *termPtr will refer to the null character at
  74.  *    the end of list.  Note:  this procedure does NOT collapse backslash
  75.  *    sequences.
  76.  *
  77.  * Side effects:
  78.  *    None.
  79.  *
  80.  *----------------------------------------------------------------------
  81.  */
  82.  
  83. int
  84. TclFindElement(interp, list, elementPtr, nextPtr, sizePtr, bracePtr)
  85.     Tcl_Interp *interp;        /* Interpreter to use for error reporting.
  86.                  * If NULL, then no error message is left
  87.                  * after errors. */
  88.     register char *list;    /* String containing Tcl list with zero
  89.                  * or more elements (possibly in braces). */
  90.     char **elementPtr;        /* Fill in with location of first significant
  91.                  * character in first element of list. */
  92.     char **nextPtr;        /* Fill in with location of character just
  93.                  * after all white space following end of
  94.                  * argument (i.e. next argument or end of
  95.                  * list). */
  96.     int *sizePtr;        /* If non-zero, fill in with size of
  97.                  * element. */
  98.     int *bracePtr;        /* If non-zero fill in with non-zero/zero
  99.                  * to indicate that arg was/wasn't
  100.                  * in braces. */
  101. {
  102.     register char *p;
  103.     int openBraces = 0;
  104.     int inQuotes = 0;
  105.     int size;
  106.  
  107.     /*
  108.      * Skim off leading white space and check for an opening brace or
  109.      * quote.   Note:  use of "isascii" below and elsewhere in this
  110.      * procedure is a temporary hack (7/27/90) because Mx uses characters
  111.      * with the high-order bit set for some things.  This should probably
  112.      * be changed back eventually, or all of Tcl should call isascii.
  113.      */
  114.  
  115.     while (isspace(UCHAR(*list))) {
  116.     list++;
  117.     }
  118.     if (*list == '{') {
  119.     openBraces = 1;
  120.     list++;
  121.     } else if (*list == '"') {
  122.     inQuotes = 1;
  123.     list++;
  124.     }
  125.     if (bracePtr != 0) {
  126.     *bracePtr = openBraces;
  127.     }
  128.     p = list;
  129.  
  130.     /*
  131.      * Find the end of the element (either a space or a close brace or
  132.      * the end of the string).
  133.      */
  134.  
  135.     while (1) {
  136.     switch (*p) {
  137.  
  138.         /*
  139.          * Open brace: don't treat specially unless the element is
  140.          * in braces.  In this case, keep a nesting count.
  141.          */
  142.  
  143.         case '{':
  144.         if (openBraces != 0) {
  145.             openBraces++;
  146.         }
  147.         break;
  148.  
  149.         /*
  150.          * Close brace: if element is in braces, keep nesting
  151.          * count and quit when the last close brace is seen.
  152.          */
  153.  
  154.         case '}':
  155.         if (openBraces == 1) {
  156.             char *p2;
  157.  
  158.             size = p - list;
  159.             p++;
  160.             if (isspace(UCHAR(*p)) || (*p == 0)) {
  161.             goto done;
  162.             }
  163.             for (p2 = p; (*p2 != 0) && (!isspace(UCHAR(*p2)))
  164.                 && (p2 < p+20); p2++) {
  165.             /* null body */
  166.             }
  167.             if (interp != NULL) {
  168.             Tcl_ResetResult(interp);
  169.             sprintf(interp->result,
  170.                 "list element in braces followed by \"%.*s\" instead of space",
  171.                 (int) (p2-p), p);
  172.             }
  173.             return TCL_ERROR;
  174.         } else if (openBraces != 0) {
  175.             openBraces--;
  176.         }
  177.         break;
  178.  
  179.         /*
  180.          * Backslash:  skip over everything up to the end of the
  181.          * backslash sequence.
  182.          */
  183.  
  184.         case '\\': {
  185.         int size;
  186.  
  187.         (void) Tcl_Backslash(p, &size);
  188.         p += size - 1;
  189.         break;
  190.         }
  191.  
  192.         /*
  193.          * Space: ignore if element is in braces or quotes;  otherwise
  194.          * terminate element.
  195.          */
  196.  
  197.         case ' ':
  198.         case '\f':
  199.         case '\n':
  200.         case '\r':
  201.         case '\t':
  202.         case '\v':
  203.         if ((openBraces == 0) && !inQuotes) {
  204.             size = p - list;
  205.             goto done;
  206.         }
  207.         break;
  208.  
  209.         /*
  210.          * Double-quote:  if element is in quotes then terminate it.
  211.          */
  212.  
  213.         case '"':
  214.         if (inQuotes) {
  215.             char *p2;
  216.  
  217.             size = p-list;
  218.             p++;
  219.             if (isspace(UCHAR(*p)) || (*p == 0)) {
  220.             goto done;
  221.             }
  222.             for (p2 = p; (*p2 != 0) && (!isspace(UCHAR(*p2)))
  223.                 && (p2 < p+20); p2++) {
  224.             /* null body */
  225.             }
  226.             if (interp != NULL) {
  227.             Tcl_ResetResult(interp);
  228.             sprintf(interp->result,
  229.                 "list element in quotes followed by \"%.*s\" %s", (int) (p2-p), p,
  230.                 "instead of space");
  231.             }
  232.             return TCL_ERROR;
  233.         }
  234.         break;
  235.  
  236.         /*
  237.          * End of list:  terminate element.
  238.          */
  239.  
  240.         case 0:
  241.         if (openBraces != 0) {
  242.             if (interp != NULL) {
  243.             Tcl_SetResult(interp, "unmatched open brace in list",
  244.                 TCL_STATIC);
  245.             }
  246.             return TCL_ERROR;
  247.         } else if (inQuotes) {
  248.             if (interp != NULL) {
  249.             Tcl_SetResult(interp, "unmatched open quote in list",
  250.                 TCL_STATIC);
  251.             }
  252.             return TCL_ERROR;
  253.         }
  254.         size = p - list;
  255.         goto done;
  256.  
  257.     }
  258.     p++;
  259.     }
  260.  
  261.     done:
  262.     while (isspace(UCHAR(*p))) {
  263.     p++;
  264.     }
  265.     *elementPtr = list;
  266.     *nextPtr = p;
  267.     if (sizePtr != 0) {
  268.     *sizePtr = size;
  269.     }
  270.     return TCL_OK;
  271. }
  272.  
  273. /*
  274.  *----------------------------------------------------------------------
  275.  *
  276.  * TclCopyAndCollapse --
  277.  *
  278.  *    Copy a string and eliminate any backslashes that aren't in braces.
  279.  *
  280.  * Results:
  281.  *    There is no return value.  Count chars. get copied from src
  282.  *    to dst.  Along the way, if backslash sequences are found outside
  283.  *    braces, the backslashes are eliminated in the copy.
  284.  *    After scanning count chars. from source, a null character is
  285.  *    placed at the end of dst.
  286.  *
  287.  * Side effects:
  288.  *    None.
  289.  *
  290.  *----------------------------------------------------------------------
  291.  */
  292.  
  293. void
  294. TclCopyAndCollapse(count, src, dst)
  295.     int count;            /* Total number of characters to copy
  296.                  * from src. */
  297.     register char *src;        /* Copy from here... */
  298.     register char *dst;        /* ... to here. */
  299. {
  300.     register char c;
  301.     int numRead;
  302.  
  303.     for (c = *src; count > 0; src++, c = *src, count--) {
  304.     if (c == '\\') {
  305.         *dst = Tcl_Backslash(src, &numRead);
  306.         dst++;
  307.         src += numRead-1;
  308.         count -= numRead-1;
  309.     } else {
  310.         *dst = c;
  311.         dst++;
  312.     }
  313.     }
  314.     *dst = 0;
  315. }
  316.  
  317. /*
  318.  *----------------------------------------------------------------------
  319.  *
  320.  * Tcl_SplitList --
  321.  *
  322.  *    Splits a list up into its constituent fields.
  323.  *
  324.  * Results
  325.  *    The return value is normally TCL_OK, which means that
  326.  *    the list was successfully split up.  If TCL_ERROR is
  327.  *    returned, it means that "list" didn't have proper list
  328.  *    structure;  interp->result will contain a more detailed
  329.  *    error message.
  330.  *
  331.  *    *argvPtr will be filled in with the address of an array
  332.  *    whose elements point to the elements of list, in order.
  333.  *    *argcPtr will get filled in with the number of valid elements
  334.  *    in the array.  A single block of memory is dynamically allocated
  335.  *    to hold both the argv array and a copy of the list (with
  336.  *    backslashes and braces removed in the standard way).
  337.  *    The caller must eventually free this memory by calling free()
  338.  *    on *argvPtr.  Note:  *argvPtr and *argcPtr are only modified
  339.  *    if the procedure returns normally.
  340.  *
  341.  * Side effects:
  342.  *    Memory is allocated.
  343.  *
  344.  *----------------------------------------------------------------------
  345.  */
  346.  
  347. int
  348. Tcl_SplitList(interp, list, argcPtr, argvPtr)
  349.     Tcl_Interp *interp;        /* Interpreter to use for error reporting.
  350.                  * If NULL, then no error message is left. */
  351.     char *list;            /* Pointer to string with list structure. */
  352.     int *argcPtr;        /* Pointer to location to fill in with
  353.                  * the number of elements in the list. */
  354.     char ***argvPtr;        /* Pointer to place to store pointer to array
  355.                  * of pointers to list elements. */
  356. {
  357.     char **argv;
  358.     register char *p;
  359.     int size, i, result, elSize, brace;
  360.     char *element;
  361.  
  362.     /*
  363.      * Figure out how much space to allocate.  There must be enough
  364.      * space for both the array of pointers and also for a copy of
  365.      * the list.  To estimate the number of pointers needed, count
  366.      * the number of space characters in the list.
  367.      */
  368.  
  369.     for (size = 1, p = list; *p != 0; p++) {
  370.     if (isspace(UCHAR(*p))) {
  371.         size++;
  372.     }
  373.     }
  374.     size++;            /* Leave space for final NULL pointer. */
  375.     argv = (char **) ckalloc((unsigned)
  376.         ((size * sizeof(char *)) + (p - list) + 1));
  377.     for (i = 0, p = ((char *) argv) + size*sizeof(char *);
  378.         *list != 0; i++) {
  379.     result = TclFindElement(interp, list, &element, &list, &elSize, &brace);
  380.     if (result != TCL_OK) {
  381.         ckfree((char *) argv);
  382.         return result;
  383.     }
  384.     if (*element == 0) {
  385.         break;
  386.     }
  387.     if (i >= size) {
  388.         ckfree((char *) argv);
  389.         if (interp != NULL) {
  390.         Tcl_SetResult(interp, "internal error in Tcl_SplitList",
  391.             TCL_STATIC);
  392.         }
  393.         return TCL_ERROR;
  394.     }
  395.     argv[i] = p;
  396.     if (brace) {
  397.         strncpy(p, element, (size_t) elSize);
  398.         p += elSize;
  399.         *p = 0;
  400.         p++;
  401.     } else {
  402.         TclCopyAndCollapse(elSize, element, p);
  403.         p += elSize+1;
  404.     }
  405.     }
  406.  
  407.     argv[i] = NULL;
  408.     *argvPtr = argv;
  409.     *argcPtr = i;
  410.     return TCL_OK;
  411. }
  412.  
  413. /*
  414.  *----------------------------------------------------------------------
  415.  *
  416.  * Tcl_ScanElement --
  417.  *
  418.  *    This procedure is a companion procedure to Tcl_ConvertElement.
  419.  *    It scans a string to see what needs to be done to it (e.g.
  420.  *    add backslashes or enclosing braces) to make the string into
  421.  *    a valid Tcl list element.
  422.  *
  423.  * Results:
  424.  *    The return value is an overestimate of the number of characters
  425.  *    that will be needed by Tcl_ConvertElement to produce a valid
  426.  *    list element from string.  The word at *flagPtr is filled in
  427.  *    with a value needed by Tcl_ConvertElement when doing the actual
  428.  *    conversion.
  429.  *
  430.  * Side effects:
  431.  *    None.
  432.  *
  433.  *----------------------------------------------------------------------
  434.  */
  435.  
  436. int
  437. Tcl_ScanElement(string, flagPtr)
  438.     char *string;        /* String to convert to Tcl list element. */
  439.     int *flagPtr;        /* Where to store information to guide
  440.                  * Tcl_ConvertElement. */
  441. {
  442.     int flags, nestingLevel;
  443.     register char *p;
  444.  
  445.     /*
  446.      * This procedure and Tcl_ConvertElement together do two things:
  447.      *
  448.      * 1. They produce a proper list, one that will yield back the
  449.      * argument strings when evaluated or when disassembled with
  450.      * Tcl_SplitList.  This is the most important thing.
  451.      *
  452.      * 2. They try to produce legible output, which means minimizing the
  453.      * use of backslashes (using braces instead).  However, there are
  454.      * some situations where backslashes must be used (e.g. an element
  455.      * like "{abc": the leading brace will have to be backslashed.  For
  456.      * each element, one of three things must be done:
  457.      *
  458.      * (a) Use the element as-is (it doesn't contain anything special
  459.      * characters).  This is the most desirable option.
  460.      *
  461.      * (b) Enclose the element in braces, but leave the contents alone.
  462.      * This happens if the element contains embedded space, or if it
  463.      * contains characters with special interpretation ($, [, ;, or \),
  464.      * or if it starts with a brace or double-quote, or if there are
  465.      * no characters in the element.
  466.      *
  467.      * (c) Don't enclose the element in braces, but add backslashes to
  468.      * prevent special interpretation of special characters.  This is a
  469.      * last resort used when the argument would normally fall under case
  470.      * (b) but contains unmatched braces.  It also occurs if the last
  471.      * character of the argument is a backslash or if the element contains
  472.      * a backslash followed by newline.
  473.      *
  474.      * The procedure figures out how many bytes will be needed to store
  475.      * the result (actually, it overestimates).  It also collects information
  476.      * about the element in the form of a flags word.
  477.      */
  478.  
  479.     nestingLevel = 0;
  480.     flags = 0;
  481.     if (string == NULL) {
  482.     string = "";
  483.     }
  484.     p = string;
  485.     if ((*p == '{') || (*p == '"') || (*p == 0)) {
  486.     flags |= USE_BRACES;
  487.     }
  488.     for ( ; *p != 0; p++) {
  489.     switch (*p) {
  490.         case '{':
  491.         nestingLevel++;
  492.         break;
  493.         case '}':
  494.         nestingLevel--;
  495.         if (nestingLevel < 0) {
  496.             flags |= TCL_DONT_USE_BRACES|BRACES_UNMATCHED;
  497.         }
  498.         break;
  499.         case '[':
  500.         case '$':
  501.         case ';':
  502.         case ' ':
  503.         case '\f':
  504.         case '\n':
  505.         case '\r':
  506.         case '\t':
  507.         case '\v':
  508.         flags |= USE_BRACES;
  509.         break;
  510.         case '\\':
  511.         if ((p[1] == 0) || (p[1] == '\n')) {
  512.             flags = TCL_DONT_USE_BRACES;
  513.         } else {
  514.             int size;
  515.  
  516.             (void) Tcl_Backslash(p, &size);
  517.             p += size-1;
  518.             flags |= USE_BRACES;
  519.         }
  520.         break;
  521.     }
  522.     }
  523.     if (nestingLevel != 0) {
  524.     flags = TCL_DONT_USE_BRACES | BRACES_UNMATCHED;
  525.     }
  526.     *flagPtr = flags;
  527.  
  528.     /*
  529.      * Allow enough space to backslash every character plus leave
  530.      * two spaces for braces.
  531.      */
  532.  
  533.     return 2*(p-string) + 2;
  534. }
  535.  
  536. /*
  537.  *----------------------------------------------------------------------
  538.  *
  539.  * Tcl_ConvertElement --
  540.  *
  541.  *    This is a companion procedure to Tcl_ScanElement.  Given the
  542.  *    information produced by Tcl_ScanElement, this procedure converts
  543.  *    a string to a list element equal to that string.
  544.  *
  545.  * Results:
  546.  *    Information is copied to *dst in the form of a list element
  547.  *    identical to src (i.e. if Tcl_SplitList is applied to dst it
  548.  *    will produce a string identical to src).  The return value is
  549.  *    a count of the number of characters copied (not including the
  550.  *    terminating NULL character).
  551.  *
  552.  * Side effects:
  553.  *    None.
  554.  *
  555.  *----------------------------------------------------------------------
  556.  */
  557.  
  558. int
  559. Tcl_ConvertElement(src, dst, flags)
  560.     register char *src;        /* Source information for list element. */
  561.     char *dst;            /* Place to put list-ified element. */
  562.     int flags;            /* Flags produced by Tcl_ScanElement. */
  563. {
  564.     register char *p = dst;
  565.  
  566.     /*
  567.      * See the comment block at the beginning of the Tcl_ScanElement
  568.      * code for details of how this works.
  569.      */
  570.  
  571.     if ((src == NULL) || (*src == 0)) {
  572.     p[0] = '{';
  573.     p[1] = '}';
  574.     p[2] = 0;
  575.     return 2;
  576.     }
  577.     if ((flags & USE_BRACES) && !(flags & TCL_DONT_USE_BRACES)) {
  578.     *p = '{';
  579.     p++;
  580.     for ( ; *src != 0; src++, p++) {
  581.         *p = *src;
  582.     }
  583.     *p = '}';
  584.     p++;
  585.     } else {
  586.     if (*src == '{') {
  587.         /*
  588.          * Can't have a leading brace unless the whole element is
  589.          * enclosed in braces.  Add a backslash before the brace.
  590.          * Furthermore, this may destroy the balance between open
  591.          * and close braces, so set BRACES_UNMATCHED.
  592.          */
  593.  
  594.         p[0] = '\\';
  595.         p[1] = '{';
  596.         p += 2;
  597.         src++;
  598.         flags |= BRACES_UNMATCHED;
  599.     }
  600.     for (; *src != 0 ; src++) {
  601.         switch (*src) {
  602.         case ']':
  603.         case '[':
  604.         case '$':
  605.         case ';':
  606.         case ' ':
  607.         case '\\':
  608.         case '"':
  609.             *p = '\\';
  610.             p++;
  611.             break;
  612.         case '{':
  613.         case '}':
  614.             /*
  615.              * It may not seem necessary to backslash braces, but
  616.              * it is.  The reason for this is that the resulting
  617.              * list element may actually be an element of a sub-list
  618.              * enclosed in braces (e.g. if Tcl_DStringStartSublist
  619.              * has been invoked), so there may be a brace mismatch
  620.              * if the braces aren't backslashed.
  621.              */
  622.  
  623.             if (flags & BRACES_UNMATCHED) {
  624.             *p = '\\';
  625.             p++;
  626.             }
  627.             break;
  628.         case '\f':
  629.             *p = '\\';
  630.             p++;
  631.             *p = 'f';
  632.             p++;
  633.             continue;
  634.         case '\n':
  635.             *p = '\\';
  636.             p++;
  637.             *p = 'n';
  638.             p++;
  639.             continue;
  640.         case '\r':
  641.             *p = '\\';
  642.             p++;
  643.             *p = 'r';
  644.             p++;
  645.             continue;
  646.         case '\t':
  647.             *p = '\\';
  648.             p++;
  649.             *p = 't';
  650.             p++;
  651.             continue;
  652.         case '\v':
  653.             *p = '\\';
  654.             p++;
  655.             *p = 'v';
  656.             p++;
  657.             continue;
  658.         }
  659.         *p = *src;
  660.         p++;
  661.     }
  662.     }
  663.     *p = '\0';
  664.     return p-dst;
  665. }
  666.  
  667. /*
  668.  *----------------------------------------------------------------------
  669.  *
  670.  * Tcl_Merge --
  671.  *
  672.  *    Given a collection of strings, merge them together into a
  673.  *    single string that has proper Tcl list structured (i.e.
  674.  *    Tcl_SplitList may be used to retrieve strings equal to the
  675.  *    original elements, and Tcl_Eval will parse the string back
  676.  *    into its original elements).
  677.  *
  678.  * Results:
  679.  *    The return value is the address of a dynamically-allocated
  680.  *    string containing the merged list.
  681.  *
  682.  * Side effects:
  683.  *    None.
  684.  *
  685.  *----------------------------------------------------------------------
  686.  */
  687.  
  688. char *
  689. Tcl_Merge(argc, argv)
  690.     int argc;            /* How many strings to merge. */
  691.     char **argv;        /* Array of string values. */
  692. {
  693. #   define LOCAL_SIZE 20
  694.     int localFlags[LOCAL_SIZE], *flagPtr;
  695.     int numChars;
  696.     char *result;
  697.     register char *dst;
  698.     int i;
  699.  
  700.     /*
  701.      * Pass 1: estimate space, gather flags.
  702.      */
  703.  
  704.     if (argc <= LOCAL_SIZE) {
  705.     flagPtr = localFlags;
  706.     } else {
  707.     flagPtr = (int *) ckalloc((unsigned) argc*sizeof(int));
  708.     }
  709.     numChars = 1;
  710.     for (i = 0; i < argc; i++) {
  711.     numChars += Tcl_ScanElement(argv[i], &flagPtr[i]) + 1;
  712.     }
  713.  
  714.     /*
  715.      * Pass two: copy into the result area.
  716.      */
  717.  
  718.     result = (char *) ckalloc((unsigned) numChars);
  719.     dst = result;
  720.     for (i = 0; i < argc; i++) {
  721.     numChars = Tcl_ConvertElement(argv[i], dst, flagPtr[i]);
  722.     dst += numChars;
  723.     *dst = ' ';
  724.     dst++;
  725.     }
  726.     if (dst == result) {
  727.     *dst = 0;
  728.     } else {
  729.     dst[-1] = 0;
  730.     }
  731.  
  732.     if (flagPtr != localFlags) {
  733.     ckfree((char *) flagPtr);
  734.     }
  735.     return result;
  736. }
  737.  
  738. /*
  739.  *----------------------------------------------------------------------
  740.  *
  741.  * Tcl_Concat --
  742.  *
  743.  *    Concatenate a set of strings into a single large string.
  744.  *
  745.  * Results:
  746.  *    The return value is dynamically-allocated string containing
  747.  *    a concatenation of all the strings in argv, with spaces between
  748.  *    the original argv elements.
  749.  *
  750.  * Side effects:
  751.  *    Memory is allocated for the result;  the caller is responsible
  752.  *    for freeing the memory.
  753.  *
  754.  *----------------------------------------------------------------------
  755.  */
  756.  
  757. char *
  758. Tcl_Concat(argc, argv)
  759.     int argc;            /* Number of strings to concatenate. */
  760.     char **argv;        /* Array of strings to concatenate. */
  761. {
  762.     int totalSize, i;
  763.     register char *p;
  764.     char *result;
  765.  
  766.     for (totalSize = 1, i = 0; i < argc; i++) {
  767.     totalSize += strlen(argv[i]) + 1;
  768.     }
  769.     result = (char *) ckalloc((unsigned) totalSize);
  770.     if (argc == 0) {
  771.     *result = '\0';
  772.     return result;
  773.     }
  774.     for (p = result, i = 0; i < argc; i++) {
  775.     char *element;
  776.     int length;
  777.  
  778.     /*
  779.      * Clip white space off the front and back of the string
  780.      * to generate a neater result, and ignore any empty
  781.      * elements.
  782.      */
  783.  
  784.     element = argv[i];
  785.     while (isspace(UCHAR(*element))) {
  786.         element++;
  787.     }
  788.     for (length = strlen(element);
  789.         (length > 0) && (isspace(UCHAR(element[length-1])));
  790.         length--) {
  791.         /* Null loop body. */
  792.     }
  793.     if (length == 0) {
  794.         continue;
  795.     }
  796.     (void) strncpy(p, element, (size_t) length);
  797.     p += length;
  798.     *p = ' ';
  799.     p++;
  800.     }
  801.     if (p != result) {
  802.     p[-1] = 0;
  803.     } else {
  804.     *p = 0;
  805.     }
  806.     return result;
  807. }
  808.  
  809. /*
  810.  *----------------------------------------------------------------------
  811.  *
  812.  * Tcl_StringMatch --
  813.  *
  814.  *    See if a particular string matches a particular pattern.
  815.  *
  816.  * Results:
  817.  *    The return value is 1 if string matches pattern, and
  818.  *    0 otherwise.  The matching operation permits the following
  819.  *    special characters in the pattern: *?\[] (see the manual
  820.  *    entry for details on what these mean).
  821.  *
  822.  * Side effects:
  823.  *    None.
  824.  *
  825.  *----------------------------------------------------------------------
  826.  */
  827.  
  828. int
  829. Tcl_StringMatch(string, pattern)
  830.     register char *string;    /* String. */
  831.     register char *pattern;    /* Pattern, which may contain
  832.                  * special characters. */
  833. {
  834.     char c2;
  835.  
  836.     while (1) {
  837.     /* See if we're at the end of both the pattern and the string.
  838.      * If so, we succeeded.  If we're at the end of the pattern
  839.      * but not at the end of the string, we failed.
  840.      */
  841.  
  842.     if (*pattern == 0) {
  843.         if (*string == 0) {
  844.         return 1;
  845.         } else {
  846.         return 0;
  847.         }
  848.     }
  849.     if ((*string == 0) && (*pattern != '*')) {
  850.         return 0;
  851.     }
  852.  
  853.     /* Check for a "*" as the next pattern character.  It matches
  854.      * any substring.  We handle this by calling ourselves
  855.      * recursively for each postfix of string, until either we
  856.      * match or we reach the end of the string.
  857.      */
  858.  
  859.     if (*pattern == '*') {
  860.         pattern += 1;
  861.         if (*pattern == 0) {
  862.         return 1;
  863.         }
  864.         while (1) {
  865.         if (Tcl_StringMatch(string, pattern)) {
  866.             return 1;
  867.         }
  868.         if (*string == 0) {
  869.             return 0;
  870.         }
  871.         string += 1;
  872.         }
  873.     }
  874.  
  875.     /* Check for a "?" as the next pattern character.  It matches
  876.      * any single character.
  877.      */
  878.  
  879.     if (*pattern == '?') {
  880.         goto thisCharOK;
  881.     }
  882.  
  883.     /* Check for a "[" as the next pattern character.  It is followed
  884.      * by a list of characters that are acceptable, or by a range
  885.      * (two characters separated by "-").
  886.      */
  887.  
  888.     if (*pattern == '[') {
  889.         pattern += 1;
  890.         while (1) {
  891.         if ((*pattern == ']') || (*pattern == 0)) {
  892.             return 0;
  893.         }
  894.         if (*pattern == *string) {
  895.             break;
  896.         }
  897.         if (pattern[1] == '-') {
  898.             c2 = pattern[2];
  899.             if (c2 == 0) {
  900.             return 0;
  901.             }
  902.             if ((*pattern <= *string) && (c2 >= *string)) {
  903.             break;
  904.             }
  905.             if ((*pattern >= *string) && (c2 <= *string)) {
  906.             break;
  907.             }
  908.             pattern += 2;
  909.         }
  910.         pattern += 1;
  911.         }
  912.         while (*pattern != ']') {
  913.         if (*pattern == 0) {
  914.             pattern--;
  915.             break;
  916.         }
  917.         pattern += 1;
  918.         }
  919.         goto thisCharOK;
  920.     }
  921.  
  922.     /* If the next pattern character is '/', just strip off the '/'
  923.      * so we do exact matching on the character that follows.
  924.      */
  925.  
  926.     if (*pattern == '\\') {
  927.         pattern += 1;
  928.         if (*pattern == 0) {
  929.         return 0;
  930.         }
  931.     }
  932.  
  933.     /* There's no special character.  Just make sure that the next
  934.      * characters of each string match.
  935.      */
  936.  
  937.     if (*pattern != *string) {
  938.         return 0;
  939.     }
  940.  
  941.     thisCharOK: pattern += 1;
  942.     string += 1;
  943.     }
  944. }
  945.  
  946. /*
  947.  *----------------------------------------------------------------------
  948.  *
  949.  * Tcl_SetResult --
  950.  *
  951.  *    Arrange for "string" to be the Tcl return value.
  952.  *
  953.  * Results:
  954.  *    None.
  955.  *
  956.  * Side effects:
  957.  *    interp->result is left pointing either to "string" (if "copy" is 0)
  958.  *    or to a copy of string.
  959.  *
  960.  *----------------------------------------------------------------------
  961.  */
  962.  
  963. void
  964. Tcl_SetResult(interp, string, freeProc)
  965.     Tcl_Interp *interp;        /* Interpreter with which to associate the
  966.                  * return value. */
  967.     char *string;        /* Value to be returned.  If NULL,
  968.                  * the result is set to an empty string. */
  969.     Tcl_FreeProc *freeProc;    /* Gives information about the string:
  970.                  * TCL_STATIC, TCL_VOLATILE, or the address
  971.                  * of a Tcl_FreeProc such as free. */
  972. {
  973.     register Interp *iPtr = (Interp *) interp;
  974.     int length;
  975.     Tcl_FreeProc *oldFreeProc = iPtr->freeProc;
  976.     char *oldResult = iPtr->result;
  977.  
  978.     if (string == NULL) {
  979.     iPtr->resultSpace[0] = 0;
  980.     iPtr->result = iPtr->resultSpace;
  981.     iPtr->freeProc = 0;
  982.     } else if (freeProc == TCL_DYNAMIC) {
  983.     iPtr->result = string;
  984.     iPtr->freeProc = (Tcl_FreeProc *) free;
  985.     } else if (freeProc == TCL_VOLATILE) {
  986.     length = strlen(string);
  987.     if (length > TCL_RESULT_SIZE) {
  988.         iPtr->result = (char *) ckalloc((unsigned) length+1);
  989.         iPtr->freeProc = (Tcl_FreeProc *) free;
  990.     } else {
  991.         iPtr->result = iPtr->resultSpace;
  992.         iPtr->freeProc = 0;
  993.     }
  994.     strcpy(iPtr->result, string);
  995.     } else {
  996.     iPtr->result = string;
  997.     iPtr->freeProc = freeProc;
  998.     }
  999.  
  1000.     /*
  1001.      * If the old result was dynamically-allocated, free it up.  Do it
  1002.      * here, rather than at the beginning, in case the new result value
  1003.      * was part of the old result value.
  1004.      */
  1005.  
  1006.     if (oldFreeProc != 0) {
  1007.     if (oldFreeProc == (Tcl_FreeProc *) free) {
  1008.         ckfree(oldResult);
  1009.     } else {
  1010.         (*oldFreeProc)(oldResult);
  1011.     }
  1012.     }
  1013. }
  1014.  
  1015. /*
  1016.  *----------------------------------------------------------------------
  1017.  *
  1018.  * Tcl_AppendResult --
  1019.  *
  1020.  *    Append a variable number of strings onto the result already
  1021.  *    present for an interpreter.
  1022.  *
  1023.  * Results:
  1024.  *    None.
  1025.  *
  1026.  * Side effects:
  1027.  *    The result in the interpreter given by the first argument
  1028.  *    is extended by the strings given by the second and following
  1029.  *    arguments (up to a terminating NULL argument).
  1030.  *
  1031.  *----------------------------------------------------------------------
  1032.  */
  1033.  
  1034. /* This has been rewritten for RISCOS using stdarg */
  1035.  
  1036.     /* VARARGS2 */
  1037. #ifndef lint
  1038. void
  1039. Tcl_AppendResult(va_alist)
  1040. #else
  1041. void
  1042.     /* VARARGS2 */ /* ARGSUSED */
  1043. Tcl_AppendResult(Tcl_Interp *interp,...)
  1044. #endif
  1045. {
  1046.     va_list argList;
  1047.     register Interp *iPtr;
  1048.     char *string;
  1049.     int newSpace;
  1050.  
  1051.     /*
  1052.      * First, scan through all the arguments to see how much space is
  1053.      * needed.
  1054.      */
  1055.     iPtr=(Interp*)interp;
  1056.     va_start(argList,interp);
  1057.     newSpace = 0;
  1058.     while (1) {
  1059.     string = va_arg(argList, char *);
  1060.     if (string == NULL) {
  1061.         break;
  1062.     }
  1063.     newSpace += strlen(string);
  1064.     }
  1065.     va_end(argList);
  1066.  
  1067.     /*
  1068.      * If the append buffer isn't already setup and large enough
  1069.      * to hold the new data, set it up.
  1070.      */
  1071.  
  1072.     if ((iPtr->result != iPtr->appendResult)
  1073.         || (iPtr->appendResult[iPtr->appendUsed] != 0)
  1074.         || ((newSpace + iPtr->appendUsed) >= iPtr->appendAvl)) {
  1075.        SetupAppendBuffer(iPtr, newSpace);
  1076.     }
  1077.  
  1078.     /*
  1079.      * Final step:  go through all the argument strings again, copying
  1080.      * them into the buffer.
  1081.      */
  1082.  
  1083.     va_start(argList,interp);
  1084.     while (1) {
  1085.     string = va_arg(argList, char *);
  1086.     if (string == NULL) {
  1087.         break;
  1088.     }
  1089.     strcpy(iPtr->appendResult + iPtr->appendUsed, string);
  1090.     iPtr->appendUsed += strlen(string);
  1091.     }
  1092.     va_end(argList);
  1093. }
  1094.  
  1095. /*
  1096.  *----------------------------------------------------------------------
  1097.  *
  1098.  * Tcl_AppendElement --
  1099.  *
  1100.  *    Convert a string to a valid Tcl list element and append it
  1101.  *    to the current result (which is ostensibly a list).
  1102.  *
  1103.  * Results:
  1104.  *    None.
  1105.  *
  1106.  * Side effects:
  1107.  *    The result in the interpreter given by the first argument
  1108.  *    is extended with a list element converted from string.  A
  1109.  *    separator space is added before the converted list element
  1110.  *    unless the current result is empty, contains the single
  1111.  *    character "{", or ends in " {".
  1112.  *
  1113.  *----------------------------------------------------------------------
  1114.  */
  1115.  
  1116. void
  1117. Tcl_AppendElement(interp, string)
  1118.     Tcl_Interp *interp;        /* Interpreter whose result is to be
  1119.                  * extended. */
  1120.     char *string;        /* String to convert to list element and
  1121.                  * add to result. */
  1122. {
  1123.     register Interp *iPtr = (Interp *) interp;
  1124.     int size, flags;
  1125.     char *dst;
  1126.  
  1127.     /*
  1128.      * See how much space is needed, and grow the append buffer if
  1129.      * needed to accommodate the list element.
  1130.      */
  1131.  
  1132.     size = Tcl_ScanElement(string, &flags) + 1;
  1133.     if ((iPtr->result != iPtr->appendResult)
  1134.         || (iPtr->appendResult[iPtr->appendUsed] != 0)
  1135.         || ((size + iPtr->appendUsed) >= iPtr->appendAvl)) {
  1136.        SetupAppendBuffer(iPtr, size+iPtr->appendUsed);
  1137.     }
  1138.  
  1139.     /*
  1140.      * Convert the string into a list element and copy it to the
  1141.      * buffer that's forming, with a space separator if needed.
  1142.      */
  1143.  
  1144.     dst = iPtr->appendResult + iPtr->appendUsed;
  1145.     if (TclNeedSpace(iPtr->appendResult, dst)) {
  1146.     iPtr->appendUsed++;
  1147.     *dst = ' ';
  1148.     dst++;
  1149.     }
  1150.     iPtr->appendUsed += Tcl_ConvertElement(string, dst, flags);
  1151. }
  1152.  
  1153. /*
  1154.  *----------------------------------------------------------------------
  1155.  *
  1156.  * SetupAppendBuffer --
  1157.  *
  1158.  *    This procedure makes sure that there is an append buffer
  1159.  *    properly initialized for interp, and that it has at least
  1160.  *    enough room to accommodate newSpace new bytes of information.
  1161.  *
  1162.  * Results:
  1163.  *    None.
  1164.  *
  1165.  * Side effects:
  1166.  *    None.
  1167.  *
  1168.  *----------------------------------------------------------------------
  1169.  */
  1170.  
  1171. static void
  1172. SetupAppendBuffer(iPtr, newSpace)
  1173.     register Interp *iPtr;    /* Interpreter whose result is being set up. */
  1174.     int newSpace;        /* Make sure that at least this many bytes
  1175.                  * of new information may be added. */
  1176. {
  1177.     int totalSpace;
  1178.  
  1179.     /*
  1180.      * Make the append buffer larger, if that's necessary, then
  1181.      * copy the current result into the append buffer and make the
  1182.      * append buffer the official Tcl result.
  1183.      */
  1184.  
  1185.     if (iPtr->result != iPtr->appendResult) {
  1186.     /*
  1187.      * If an oversized buffer was used recently, then free it up
  1188.      * so we go back to a smaller buffer.  This avoids tying up
  1189.      * memory forever after a large operation.
  1190.      */
  1191.  
  1192.     if (iPtr->appendAvl > 500) {
  1193.         ckfree(iPtr->appendResult);
  1194.         iPtr->appendResult = NULL;
  1195.         iPtr->appendAvl = 0;
  1196.     }
  1197.     iPtr->appendUsed = strlen(iPtr->result);
  1198.     } else if (iPtr->result[iPtr->appendUsed] != 0) {
  1199.     /*
  1200.      * Most likely someone has modified a result created by
  1201.      * Tcl_AppendResult et al. so that it has a different size.
  1202.      * Just recompute the size.
  1203.      */
  1204.  
  1205.     iPtr->appendUsed = strlen(iPtr->result);
  1206.     }
  1207.     totalSpace = newSpace + iPtr->appendUsed;
  1208.     if (totalSpace >= iPtr->appendAvl) {
  1209.     char *new;
  1210.  
  1211.     if (totalSpace < 100) {
  1212.         totalSpace = 200;
  1213.     } else {
  1214.         totalSpace *= 2;
  1215.     }
  1216.     new = (char *) ckalloc((unsigned) totalSpace);
  1217.     strcpy(new, iPtr->result);
  1218.     if (iPtr->appendResult != NULL) {
  1219.         ckfree(iPtr->appendResult);
  1220.     }
  1221.     iPtr->appendResult = new;
  1222.     iPtr->appendAvl = totalSpace;
  1223.     } else if (iPtr->result != iPtr->appendResult) {
  1224.     strcpy(iPtr->appendResult, iPtr->result);
  1225.     }
  1226.     Tcl_FreeResult(iPtr);
  1227.     iPtr->result = iPtr->appendResult;
  1228. }
  1229.  
  1230. /*
  1231.  *----------------------------------------------------------------------
  1232.  *
  1233.  * Tcl_ResetResult --
  1234.  *
  1235.  *    This procedure restores the result area for an interpreter
  1236.  *    to its default initialized state, freeing up any memory that
  1237.  *    may have been allocated for the result and clearing any
  1238.  *    error information for the interpreter.
  1239.  *
  1240.  * Results:
  1241.  *    None.
  1242.  *
  1243.  * Side effects:
  1244.  *    None.
  1245.  *
  1246.  *----------------------------------------------------------------------
  1247.  */
  1248.  
  1249. void
  1250. Tcl_ResetResult(interp)
  1251.     Tcl_Interp *interp;        /* Interpreter for which to clear result. */
  1252. {
  1253.     register Interp *iPtr = (Interp *) interp;
  1254.  
  1255.     Tcl_FreeResult(iPtr);
  1256.     iPtr->result = iPtr->resultSpace;
  1257.     iPtr->resultSpace[0] = 0;
  1258.     iPtr->flags &=
  1259.         ~(ERR_ALREADY_LOGGED | ERR_IN_PROGRESS | ERROR_CODE_SET);
  1260. }
  1261.  
  1262. /*
  1263.  *----------------------------------------------------------------------
  1264.  *
  1265.  * Tcl_SetErrorCode --
  1266.  *
  1267.  *    This procedure is called to record machine-readable information
  1268.  *    about an error that is about to be returned.
  1269.  *
  1270.  * Results:
  1271.  *    None.
  1272.  *
  1273.  * Side effects:
  1274.  *    The errorCode global variable is modified to hold all of the
  1275.  *    arguments to this procedure, in a list form with each argument
  1276.  *    becoming one element of the list.  A flag is set internally
  1277.  *    to remember that errorCode has been set, so the variable doesn't
  1278.  *    get set automatically when the error is returned.
  1279.  *
  1280.  *----------------------------------------------------------------------
  1281.  */
  1282.     /* VARARGS2 */
  1283. #ifndef lint
  1284. void
  1285. Tcl_SetErrorCode(va_alist)
  1286. #else
  1287. void
  1288.     /* VARARGS2 */ /* ARGSUSED */
  1289. Tcl_SetErrorCode(Tcl_Interp *interp,...) /* converted to stdarg for RISCOS */
  1290. #endif
  1291. {
  1292.     va_list argList;
  1293.     char *string;
  1294.     int flags;
  1295.     Interp *iPtr;
  1296.  
  1297.     /*
  1298.      * Scan through the arguments one at a time, appending them to
  1299.      * $errorCode as list elements.
  1300.      */
  1301.  
  1302.     iPtr=(Interp*)interp;   /* converted to stdarg for RISCOS */
  1303.     va_start(argList,interp);
  1304.     flags = TCL_GLOBAL_ONLY | TCL_LIST_ELEMENT;
  1305.     while (1) {
  1306.     string = va_arg(argList, char *);
  1307.     if (string == NULL) {
  1308.         break;
  1309.     }
  1310.     (void) Tcl_SetVar2((Tcl_Interp *) iPtr, "errorCode",
  1311.         (char *) NULL, string, flags);
  1312.     flags |= TCL_APPEND_VALUE;
  1313.     }
  1314.     va_end(argList);
  1315.     iPtr->flags |= ERROR_CODE_SET;
  1316. }
  1317.  
  1318. /*
  1319.  *----------------------------------------------------------------------
  1320.  *
  1321.  * TclGetListIndex --
  1322.  *
  1323.  *    Parse a list index, which may be either an integer or the
  1324.  *    value "end".
  1325.  *
  1326.  * Results:
  1327.  *    The return value is either TCL_OK or TCL_ERROR.  If it is
  1328.  *    TCL_OK, then the index corresponding to string is left in
  1329.  *    *indexPtr.  If the return value is TCL_ERROR, then string
  1330.  *    was bogus;  an error message is returned in interp->result.
  1331.  *    If a negative index is specified, it is rounded up to 0.
  1332.  *    The index value may be larger than the size of the list
  1333.  *    (this happens when "end" is specified).
  1334.  *
  1335.  * Side effects:
  1336.  *    None.
  1337.  *
  1338.  *----------------------------------------------------------------------
  1339.  */
  1340.  
  1341. int
  1342. TclGetListIndex(interp, string, indexPtr)
  1343.     Tcl_Interp *interp;            /* Interpreter for error reporting. */
  1344.     char *string;            /* String containing list index. */
  1345.     int *indexPtr;            /* Where to store index. */
  1346. {
  1347.     if (isdigit(UCHAR(*string)) || (*string == '-')) {
  1348.     if (Tcl_GetInt(interp, string, indexPtr) != TCL_OK) {
  1349.         return TCL_ERROR;
  1350.     }
  1351.     if (*indexPtr < 0) {
  1352.         *indexPtr = 0;
  1353.     }
  1354.     } else if (strncmp(string, "end", strlen(string)) == 0) {
  1355.     *indexPtr = INT_MAX;
  1356.     } else {
  1357.     Tcl_AppendResult(interp, "bad index \"", string,
  1358.         "\": must be integer or \"end\"", (char *) NULL);
  1359.     return TCL_ERROR;
  1360.     }
  1361.     return TCL_OK;
  1362. }
  1363.  
  1364. /*
  1365.  *----------------------------------------------------------------------
  1366.  *
  1367.  * Tcl_RegExpCompile --
  1368.  *
  1369.  *    Compile a regular expression into a form suitable for fast
  1370.  *    matching.  This procedure retains a small cache of pre-compiled
  1371.  *    regular expressions in the interpreter, in order to avoid
  1372.  *    compilation costs as much as possible.
  1373.  *
  1374.  * Results:
  1375.  *    The return value is a pointer to the compiled form of string,
  1376.  *    suitable for passing to Tcl_RegExpExec.  This compiled form
  1377.  *    is only valid up until the next call to this procedure, so
  1378.  *    don't keep these around for a long time!  If an error occurred
  1379.  *    while compiling the pattern, then NULL is returned and an error
  1380.  *    message is left in interp->result.
  1381.  *
  1382.  * Side effects:
  1383.  *    The cache of compiled regexp's in interp will be modified to
  1384.  *    hold information for string, if such information isn't already
  1385.  *    present in the cache.
  1386.  *
  1387.  *----------------------------------------------------------------------
  1388.  */
  1389.  
  1390. Tcl_RegExp
  1391. Tcl_RegExpCompile(interp, string)
  1392.     Tcl_Interp *interp;            /* For use in error reporting. */
  1393.     char *string;            /* String for which to produce
  1394.                      * compiled regular expression. */
  1395. {
  1396.     register Interp *iPtr = (Interp *) interp;
  1397.     int i, length;
  1398.     regexp *result;
  1399.  
  1400.     length = strlen(string);
  1401.     for (i = 0; i < NUM_REGEXPS; i++) {
  1402.     if ((length == iPtr->patLengths[i])
  1403.         && (strcmp(string, iPtr->patterns[i]) == 0)) {
  1404.         /*
  1405.          * Move the matched pattern to the first slot in the
  1406.          * cache and shift the other patterns down one position.
  1407.          */
  1408.  
  1409.         if (i != 0) {
  1410.         int j;
  1411.         char *cachedString;
  1412.  
  1413.         cachedString = iPtr->patterns[i];
  1414.         result = iPtr->regexps[i];
  1415.         for (j = i-1; j >= 0; j--) {
  1416.             iPtr->patterns[j+1] = iPtr->patterns[j];
  1417.             iPtr->patLengths[j+1] = iPtr->patLengths[j];
  1418.             iPtr->regexps[j+1] = iPtr->regexps[j];
  1419.         }
  1420.         iPtr->patterns[0] = cachedString;
  1421.         iPtr->patLengths[0] = length;
  1422.         iPtr->regexps[0] = result;
  1423.         }
  1424.         return (Tcl_RegExp) iPtr->regexps[0];
  1425.     }
  1426.     }
  1427.  
  1428.     /*
  1429.      * No match in the cache.  Compile the string and add it to the
  1430.      * cache.
  1431.      */
  1432.  
  1433.     TclRegError((char *) NULL);
  1434.     result = TclRegComp(string);
  1435.     if (TclGetRegError() != NULL) {
  1436.     Tcl_AppendResult(interp,
  1437.         "couldn't compile regular expression pattern: ",
  1438.         TclGetRegError(), (char *) NULL);
  1439.     return NULL;
  1440.     }
  1441.     if (iPtr->patterns[NUM_REGEXPS-1] != NULL) {
  1442.     ckfree(iPtr->patterns[NUM_REGEXPS-1]);
  1443.     ckfree((char *) iPtr->regexps[NUM_REGEXPS-1]);
  1444.     }
  1445.     for (i = NUM_REGEXPS - 2; i >= 0; i--) {
  1446.     iPtr->patterns[i+1] = iPtr->patterns[i];
  1447.     iPtr->patLengths[i+1] = iPtr->patLengths[i];
  1448.     iPtr->regexps[i+1] = iPtr->regexps[i];
  1449.     }
  1450.     iPtr->patterns[0] = (char *) ckalloc((unsigned) (length+1));
  1451.     strcpy(iPtr->patterns[0], string);
  1452.     iPtr->patLengths[0] = length;
  1453.     iPtr->regexps[0] = result;
  1454.     return (Tcl_RegExp) result;
  1455. }
  1456.  
  1457. /*
  1458.  *----------------------------------------------------------------------
  1459.  *
  1460.  * Tcl_RegExpExec --
  1461.  *
  1462.  *    Execute the regular expression matcher using a compiled form
  1463.  *    of a regular expression and save information about any match
  1464.  *    that is found.
  1465.  *
  1466.  * Results:
  1467.  *    If an error occurs during the matching operation then -1
  1468.  *    is returned and interp->result contains an error message.
  1469.  *    Otherwise the return value is 1 if
  1470.  *
  1471.  * Side effects:
  1472.  *    None.
  1473.  *
  1474.  *----------------------------------------------------------------------
  1475.  */
  1476.  
  1477. int
  1478. Tcl_RegExpExec(interp, re, string, start)
  1479.     Tcl_Interp *interp;        /* Interpreter to use for error reporting. */
  1480.     Tcl_RegExp re;        /* Compiled regular expression;  must have
  1481.                  * been returned by previous call to
  1482.                  * Tcl_RegExpCompile. */
  1483.     char *string;        /* String against which to match re. */
  1484.     char *start;        /* If string is part of a larger string,
  1485.                  * this identifies beginning of larger
  1486.                  * string, so that "^" won't match. */
  1487. {
  1488.     int match;
  1489.  
  1490.     regexp *regexpPtr = (regexp *) re;
  1491.     TclRegError((char *) NULL);
  1492.     match = TclRegExec(regexpPtr, string, start);
  1493.     if (TclGetRegError() != NULL) {
  1494.     Tcl_ResetResult(interp);
  1495.     Tcl_AppendResult(interp, "error while matching regular expression: ",
  1496.         TclGetRegError(), (char *) NULL);
  1497.     return -1;
  1498.     }
  1499.     return match;
  1500. }
  1501.  
  1502. /*
  1503.  *----------------------------------------------------------------------
  1504.  *
  1505.  * Tcl_RegExpRange --
  1506.  *
  1507.  *    Returns pointers describing the range of a regular expression match,
  1508.  *    or one of the subranges within the match.
  1509.  *
  1510.  * Results:
  1511.  *    The variables at *startPtr and *endPtr are modified to hold the
  1512.  *    addresses of the endpoints of the range given by index.  If the
  1513.  *    specified range doesn't exist then NULLs are returned.
  1514.  *
  1515.  * Side effects:
  1516.  *    None.
  1517.  *
  1518.  *----------------------------------------------------------------------
  1519.  */
  1520.  
  1521. void
  1522. Tcl_RegExpRange(re, index, startPtr, endPtr)
  1523.     Tcl_RegExp re;        /* Compiled regular expression that has
  1524.                  * been passed to Tcl_RegExpExec. */
  1525.     int index;            /* 0 means give the range of the entire
  1526.                  * match, > 0 means give the range of
  1527.                  * a matching subrange.  Must be no greater
  1528.                  * than NSUBEXP. */
  1529.     char **startPtr;        /* Store address of first character in
  1530.                  * (sub-) range here. */
  1531.     char **endPtr;        /* Store address of character just after last
  1532.                  * in (sub-) range here. */
  1533. {
  1534.     regexp *regexpPtr = (regexp *) re;
  1535.  
  1536.     if (index >= NSUBEXP) {
  1537.     *startPtr = *endPtr = NULL;
  1538.     } else {
  1539.     *startPtr = regexpPtr->startp[index];
  1540.     *endPtr = regexpPtr->endp[index];
  1541.     }
  1542. }
  1543.  
  1544. /*
  1545.  *----------------------------------------------------------------------
  1546.  *
  1547.  * Tcl_RegExpMatch --
  1548.  *
  1549.  *    See if a string matches a regular expression.
  1550.  *
  1551.  * Results:
  1552.  *    If an error occurs during the matching operation then -1
  1553.  *    is returned and interp->result contains an error message.
  1554.  *    Otherwise the return value is 1 if "string" matches "pattern"
  1555.  *    and 0 otherwise.
  1556.  *
  1557.  * Side effects:
  1558.  *    None.
  1559.  *
  1560.  *----------------------------------------------------------------------
  1561.  */
  1562.  
  1563. int
  1564. Tcl_RegExpMatch(interp, string, pattern)
  1565.     Tcl_Interp *interp;        /* Used for error reporting. */
  1566.     char *string;        /* String. */
  1567.     char *pattern;        /* Regular expression to match against
  1568.                  * string. */
  1569. {
  1570.     Tcl_RegExp re;
  1571.  
  1572.     re = Tcl_RegExpCompile(interp, pattern);
  1573.     if (re == NULL) {
  1574.     return -1;
  1575.     }
  1576.     return Tcl_RegExpExec(interp, re, string, string);
  1577. }
  1578.  
  1579. /*
  1580.  *----------------------------------------------------------------------
  1581.  *
  1582.  * Tcl_DStringInit --
  1583.  *
  1584.  *    Initializes a dynamic string, discarding any previous contents
  1585.  *    of the string (Tcl_DStringFree should have been called already
  1586.  *    if the dynamic string was previously in use).
  1587.  *
  1588.  * Results:
  1589.  *    None.
  1590.  *
  1591.  * Side effects:
  1592.  *    The dynamic string is initialized to be empty.
  1593.  *
  1594.  *----------------------------------------------------------------------
  1595.  */
  1596.  
  1597. void
  1598. Tcl_DStringInit(dsPtr)
  1599.     register Tcl_DString *dsPtr;    /* Pointer to structure for
  1600.                      * dynamic string. */
  1601. {
  1602.     dsPtr->string = dsPtr->staticSpace;
  1603.     dsPtr->length = 0;
  1604.     dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
  1605.     dsPtr->staticSpace[0] = 0;
  1606. }
  1607.  
  1608. /*
  1609.  *----------------------------------------------------------------------
  1610.  *
  1611.  * Tcl_DStringAppend --
  1612.  *
  1613.  *    Append more characters to the current value of a dynamic string.
  1614.  *
  1615.  * Results:
  1616.  *    The return value is a pointer to the dynamic string's new value.
  1617.  *
  1618.  * Side effects:
  1619.  *    Length bytes from string (or all of string if length is less
  1620.  *    than zero) are added to the current value of the string.  Memory
  1621.  *    gets reallocated if needed to accomodate the string's new size.
  1622.  *
  1623.  *----------------------------------------------------------------------
  1624.  */
  1625.  
  1626. char *
  1627. Tcl_DStringAppend(dsPtr, string, length)
  1628.     register Tcl_DString *dsPtr;    /* Structure describing dynamic
  1629.                      * string. */
  1630.     char *string;            /* String to append.  If length is
  1631.                      * -1 then this must be
  1632.                      * null-terminated. */
  1633.     int length;                /* Number of characters from string
  1634.                      * to append.  If < 0, then append all
  1635.                      * of string, up to null at end. */
  1636. {
  1637.     int newSize;
  1638.     char *newString, *dst, *end;
  1639.  
  1640.     if (length < 0) {
  1641.     length = strlen(string);
  1642.     }
  1643.     newSize = length + dsPtr->length;
  1644.  
  1645.     /*
  1646.      * Allocate a larger buffer for the string if the current one isn't
  1647.      * large enough.  Allocate extra space in the new buffer so that there
  1648.      * will be room to grow before we have to allocate again.
  1649.      */
  1650.  
  1651.     if (newSize >= dsPtr->spaceAvl) {
  1652.     dsPtr->spaceAvl = newSize*2;
  1653.     newString = (char *) ckalloc((unsigned) dsPtr->spaceAvl);
  1654.     memcpy((VOID *)newString, (VOID *) dsPtr->string,
  1655.         (size_t) dsPtr->length);
  1656.     if (dsPtr->string != dsPtr->staticSpace) {
  1657.         ckfree(dsPtr->string);
  1658.     }
  1659.     dsPtr->string = newString;
  1660.     }
  1661.  
  1662.     /*
  1663.      * Copy the new string into the buffer at the end of the old
  1664.      * one.
  1665.      */
  1666.  
  1667.     for (dst = dsPtr->string + dsPtr->length, end = string+length;
  1668.         string < end; string++, dst++) {
  1669.     *dst = *string;
  1670.     }
  1671.     *dst = 0;
  1672.     dsPtr->length += length;
  1673.     return dsPtr->string;
  1674. }
  1675.  
  1676. /*
  1677.  *----------------------------------------------------------------------
  1678.  *
  1679.  * Tcl_DStringAppendElement --
  1680.  *
  1681.  *    Append a list element to the current value of a dynamic string.
  1682.  *
  1683.  * Results:
  1684.  *    The return value is a pointer to the dynamic string's new value.
  1685.  *
  1686.  * Side effects:
  1687.  *    String is reformatted as a list element and added to the current
  1688.  *    value of the string.  Memory gets reallocated if needed to
  1689.  *    accomodate the string's new size.
  1690.  *
  1691.  *----------------------------------------------------------------------
  1692.  */
  1693.  
  1694. char *
  1695. Tcl_DStringAppendElement(dsPtr, string)
  1696.     register Tcl_DString *dsPtr;    /* Structure describing dynamic
  1697.                      * string. */
  1698.     char *string;            /* String to append.  Must be
  1699.                      * null-terminated. */
  1700. {
  1701.     int newSize, flags;
  1702.     char *dst, *newString;
  1703.  
  1704.     newSize = Tcl_ScanElement(string, &flags) + dsPtr->length + 1;
  1705.  
  1706.     /*
  1707.      * Allocate a larger buffer for the string if the current one isn't
  1708.      * large enough.  Allocate extra space in the new buffer so that there
  1709.      * will be room to grow before we have to allocate again.
  1710.      * SPECIAL NOTE: must use memcpy, not strcpy, to copy the string
  1711.      * to a larger buffer, since there may be embedded NULLs in the
  1712.      * string in some cases.
  1713.      */
  1714.  
  1715.     if (newSize >= dsPtr->spaceAvl) {
  1716.     dsPtr->spaceAvl = newSize*2;
  1717.     newString = (char *) ckalloc((unsigned) dsPtr->spaceAvl);
  1718.     memcpy((VOID *) newString, (VOID *) dsPtr->string,
  1719.         (size_t) dsPtr->length);
  1720.     if (dsPtr->string != dsPtr->staticSpace) {
  1721.         ckfree(dsPtr->string);
  1722.     }
  1723.     dsPtr->string = newString;
  1724.     }
  1725.  
  1726.     /*
  1727.      * Convert the new string to a list element and copy it into the
  1728.      * buffer at the end, with a space, if needed.
  1729.      */
  1730.  
  1731.     dst = dsPtr->string + dsPtr->length;
  1732.     if (TclNeedSpace(dsPtr->string, dst)) {
  1733.     *dst = ' ';
  1734.     dst++;
  1735.     dsPtr->length++;
  1736.     }
  1737.     dsPtr->length += Tcl_ConvertElement(string, dst, flags);
  1738.     return dsPtr->string;
  1739. }
  1740.  
  1741. /*
  1742.  *----------------------------------------------------------------------
  1743.  *
  1744.  * Tcl_DStringSetLength --
  1745.  *
  1746.  *    Change the length of a dynamic string.  This can cause the
  1747.  *    string to either grow or shrink, depending on the value of
  1748.  *    length.
  1749.  *
  1750.  * Results:
  1751.  *    None.
  1752.  *
  1753.  * Side effects:
  1754.  *    The length of dsPtr is changed to length and a null byte is
  1755.  *    stored at that position in the string.  If length is larger
  1756.  *    than the space allocated for dsPtr, then a panic occurs.
  1757.  *
  1758.  *----------------------------------------------------------------------
  1759.  */
  1760.  
  1761. void
  1762. Tcl_DStringSetLength(dsPtr, length)
  1763.     register Tcl_DString *dsPtr;    /* Structure describing dynamic
  1764.                      * string. */
  1765.     int length;                /* New length for dynamic string. */
  1766. {
  1767.     if (length < 0) {
  1768.     length = 0;
  1769.     }
  1770.     if (length >= dsPtr->spaceAvl) {
  1771.     char *newString;
  1772.  
  1773.     dsPtr->spaceAvl = length+1;
  1774.     newString = (char *) ckalloc((unsigned) dsPtr->spaceAvl);
  1775.  
  1776.     /*
  1777.      * SPECIAL NOTE: must use memcpy, not strcpy, to copy the string
  1778.      * to a larger buffer, since there may be embedded NULLs in the
  1779.      * string in some cases.
  1780.      */
  1781.  
  1782.     memcpy((VOID *) newString, (VOID *) dsPtr->string,
  1783.         (size_t) dsPtr->length);
  1784.     if (dsPtr->string != dsPtr->staticSpace) {
  1785.         ckfree(dsPtr->string);
  1786.     }
  1787.     dsPtr->string = newString;
  1788.     }
  1789.     dsPtr->length = length;
  1790.     dsPtr->string[length] = 0;
  1791. }
  1792.  
  1793. /*
  1794.  *----------------------------------------------------------------------
  1795.  *
  1796.  * Tcl_DStringFree --
  1797.  *
  1798.  *    Frees up any memory allocated for the dynamic string and
  1799.  *    reinitializes the string to an empty state.
  1800.  *
  1801.  * Results:
  1802.  *    None.
  1803.  *
  1804.  * Side effects:
  1805.  *    The previous contents of the dynamic string are lost, and
  1806.  *    the new value is an empty string.
  1807.  *
  1808.  *----------------------------------------------------------------------
  1809.  */
  1810.  
  1811. void
  1812. Tcl_DStringFree(dsPtr)
  1813.     register Tcl_DString *dsPtr;    /* Structure describing dynamic
  1814.                      * string. */
  1815. {
  1816.     if (dsPtr->string != dsPtr->staticSpace) {
  1817.     ckfree(dsPtr->string);
  1818.     }
  1819.     dsPtr->string = dsPtr->staticSpace;
  1820.     dsPtr->length = 0;
  1821.     dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
  1822.     dsPtr->staticSpace[0] = 0;
  1823. }
  1824.  
  1825. /*
  1826.  *----------------------------------------------------------------------
  1827.  *
  1828.  * Tcl_DStringResult --
  1829.  *
  1830.  *    This procedure moves the value of a dynamic string into an
  1831.  *    interpreter as its result.  The string itself is reinitialized
  1832.  *    to an empty string.
  1833.  *
  1834.  * Results:
  1835.  *    None.
  1836.  *
  1837.  * Side effects:
  1838.  *    The string is "moved" to interp's result, and any existing
  1839.  *    result for interp is freed up.  DsPtr is reinitialized to
  1840.  *    an empty string.
  1841.  *
  1842.  *----------------------------------------------------------------------
  1843.  */
  1844.  
  1845. void
  1846. Tcl_DStringResult(interp, dsPtr)
  1847.     Tcl_Interp *interp;            /* Interpreter whose result is to be
  1848.                      * reset. */
  1849.     Tcl_DString *dsPtr;            /* Dynamic string that is to become
  1850.                      * the result of interp. */
  1851. {
  1852.     Tcl_ResetResult(interp);
  1853.     if (dsPtr->string != dsPtr->staticSpace) {
  1854.     interp->result = dsPtr->string;
  1855.     interp->freeProc = (Tcl_FreeProc *) free;
  1856.     } else if (dsPtr->length < TCL_RESULT_SIZE) {
  1857.     interp->result = ((Interp *) interp)->resultSpace;
  1858.     strcpy(interp->result, dsPtr->string);
  1859.     } else {
  1860.     Tcl_SetResult(interp, dsPtr->string, TCL_VOLATILE);
  1861.     }
  1862.     dsPtr->string = dsPtr->staticSpace;
  1863.     dsPtr->length = 0;
  1864.     dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
  1865.     dsPtr->staticSpace[0] = 0;
  1866. }
  1867.  
  1868. /*
  1869.  *----------------------------------------------------------------------
  1870.  *
  1871.  * Tcl_DStringGetResult --
  1872.  *
  1873.  *    This procedure moves the result of an interpreter into a
  1874.  *    dynamic string.
  1875.  *
  1876.  * Results:
  1877.  *    None.
  1878.  *
  1879.  * Side effects:
  1880.  *    The interpreter's result is cleared, and the previous contents
  1881.  *    of dsPtr are freed.
  1882.  *
  1883.  *----------------------------------------------------------------------
  1884.  */
  1885.  
  1886. void
  1887. Tcl_DStringGetResult(interp, dsPtr)
  1888.     Tcl_Interp *interp;            /* Interpreter whose result is to be
  1889.                      * reset. */
  1890.     Tcl_DString *dsPtr;            /* Dynamic string that is to become
  1891.                      * the result of interp. */
  1892. {
  1893.     Interp *iPtr = (Interp *) interp;
  1894.     if (dsPtr->string != dsPtr->staticSpace) {
  1895.     ckfree(dsPtr->string);
  1896.     }
  1897.     dsPtr->length = strlen(iPtr->result);
  1898.     if (iPtr->freeProc != NULL) {
  1899.     if (iPtr->freeProc == (Tcl_FreeProc *) free) {
  1900.         dsPtr->string = iPtr->result;
  1901.         dsPtr->spaceAvl = dsPtr->length+1;
  1902.     } else {
  1903.         dsPtr->string = ckalloc((unsigned) (dsPtr->length+1));
  1904.         strcpy(dsPtr->string, iPtr->result);
  1905.         (*iPtr->freeProc)(iPtr->result);
  1906.     }
  1907.     dsPtr->spaceAvl = dsPtr->length+1;
  1908.     iPtr->freeProc = NULL;
  1909.     } else {
  1910.     if (dsPtr->length < TCL_DSTRING_STATIC_SIZE) {
  1911.         dsPtr->string = dsPtr->staticSpace;
  1912.         dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
  1913.     } else {
  1914.         dsPtr->string = ckalloc((unsigned) (dsPtr->length + 1));
  1915.         dsPtr->spaceAvl = dsPtr->length + 1;
  1916.     }
  1917.     strcpy(dsPtr->string, iPtr->result);
  1918.     }
  1919.     iPtr->result = iPtr->resultSpace;
  1920.     iPtr->resultSpace[0] = 0;
  1921. }
  1922.  
  1923. /*
  1924.  *----------------------------------------------------------------------
  1925.  *
  1926.  * Tcl_DStringStartSublist --
  1927.  *
  1928.  *    This procedure adds the necessary information to a dynamic
  1929.  *    string (e.g. " {" to start a sublist.  Future element
  1930.  *    appends will be in the sublist rather than the main list.
  1931.  *
  1932.  * Results:
  1933.  *    None.
  1934.  *
  1935.  * Side effects:
  1936.  *    Characters get added to the dynamic string.
  1937.  *
  1938.  *----------------------------------------------------------------------
  1939.  */
  1940.  
  1941. void
  1942. Tcl_DStringStartSublist(dsPtr)
  1943.     Tcl_DString *dsPtr;            /* Dynamic string. */
  1944. {
  1945.     if (TclNeedSpace(dsPtr->string, dsPtr->string + dsPtr->length)) {
  1946.     Tcl_DStringAppend(dsPtr, " {", -1);
  1947.     } else {
  1948.     Tcl_DStringAppend(dsPtr, "{", -1);
  1949.     }
  1950. }
  1951.  
  1952. /*
  1953.  *----------------------------------------------------------------------
  1954.  *
  1955.  * Tcl_DStringEndSublist --
  1956.  *
  1957.  *    This procedure adds the necessary characters to a dynamic
  1958.  *    string to end a sublist (e.g. "}").  Future element appends
  1959.  *    will be in the enclosing (sub)list rather than the current
  1960.  *    sublist.
  1961.  *
  1962.  * Results:
  1963.  *    None.
  1964.  *
  1965.  * Side effects:
  1966.  *    None.
  1967.  *
  1968.  *----------------------------------------------------------------------
  1969.  */
  1970.  
  1971. void
  1972. Tcl_DStringEndSublist(dsPtr)
  1973.     Tcl_DString *dsPtr;            /* Dynamic string. */
  1974. {
  1975.     Tcl_DStringAppend(dsPtr, "}", -1);
  1976. }
  1977.  
  1978. /*
  1979.  *----------------------------------------------------------------------
  1980.  *
  1981.  * Tcl_PrintDouble --
  1982.  *
  1983.  *    Given a floating-point value, this procedure converts it to
  1984.  *    an ASCII string using.
  1985.  *
  1986.  * Results:
  1987.  *    The ASCII equivalent of "value" is written at "dst".  It is
  1988.  *    written using the current precision, and it is guaranteed to
  1989.  *    contain a decimal point or exponent, so that it looks like
  1990.  *    a floating-point value and not an integer.
  1991.  *
  1992.  * Side effects:
  1993.  *    None.
  1994.  *
  1995.  *----------------------------------------------------------------------
  1996.  */
  1997.  
  1998. void
  1999. Tcl_PrintDouble(interp, value, dst)
  2000.     Tcl_Interp *interp;            /* Interpreter whose tcl_precision
  2001.                      * variable controls printing. */
  2002.     double value;            /* Value to print as string. */
  2003.     char *dst;                /* Where to store converted value;
  2004.                      * must have at least TCL_DOUBLE_SPACE
  2005.                      * characters. */
  2006. {
  2007.     register char *p;
  2008.     sprintf(dst, ((Interp *) interp)->pdFormat, value);
  2009.  
  2010.     /*
  2011.      * If the ASCII result looks like an integer, add ".0" so that it
  2012.      * doesn't look like an integer anymore.  This prevents floating-point
  2013.      * values from being converted to integers unintentionally.
  2014.      */
  2015.  
  2016.     for (p = dst; *p != 0; p++) {
  2017.     if ((*p == '.') || (isalpha(UCHAR(*p)))) {
  2018.         return;
  2019.     }
  2020.     }
  2021.     p[0] = '.';
  2022.     p[1] = '0';
  2023.     p[2] = 0;
  2024. }
  2025.  
  2026. /*
  2027.  *----------------------------------------------------------------------
  2028.  *
  2029.  * TclPrecTraceProc --
  2030.  *
  2031.  *    This procedure is invoked whenever the variable "tcl_precision"
  2032.  *    is written.
  2033.  *
  2034.  * Results:
  2035.  *    Returns NULL if all went well, or an error message if the
  2036.  *    new value for the variable doesn't make sense.
  2037.  *
  2038.  * Side effects:
  2039.  *    If the new value doesn't make sense then this procedure
  2040.  *    undoes the effect of the variable modification.  Otherwise
  2041.  *    it modifies the format string that's used by Tcl_PrintDouble.
  2042.  *
  2043.  *----------------------------------------------------------------------
  2044.  */
  2045.  
  2046.     /* ARGSUSED */
  2047. char *
  2048. TclPrecTraceProc(clientData, interp, name1, name2, flags)
  2049.     ClientData clientData;    /* Not used. */
  2050.     Tcl_Interp *interp;        /* Interpreter containing variable. */
  2051.     char *name1;        /* Name of variable. */
  2052.     char *name2;        /* Second part of variable name. */
  2053.     int flags;            /* Information about what happened. */
  2054. {
  2055.     register Interp *iPtr = (Interp *) interp;
  2056.     char *value, *end;
  2057.     int prec;
  2058.  
  2059.     /*
  2060.      * If the variable is unset, then recreate the trace and restore
  2061.      * the default value of the format string.
  2062.      */
  2063.  
  2064.     if (flags & TCL_TRACE_UNSETS) {
  2065.     if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) {
  2066.         Tcl_TraceVar2(interp, name1, name2,
  2067.             TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
  2068.             TclPrecTraceProc, clientData);
  2069.     }
  2070.     strcpy(iPtr->pdFormat, DEFAULT_PD_FORMAT);
  2071.     iPtr->pdPrec = DEFAULT_PD_PREC;
  2072.     return (char *) NULL;
  2073.     }
  2074.  
  2075.     value = Tcl_GetVar2(interp, name1, name2, flags & TCL_GLOBAL_ONLY);
  2076.     if (value == NULL) {
  2077.     value = "";
  2078.     }
  2079.     prec = strtoul(value, &end, 10);
  2080.     if ((prec <= 0) || (prec > TCL_MAX_PREC) || (prec > 100) ||
  2081.         (end == value) || (*end != 0)) {
  2082.     char oldValue[10];
  2083.  
  2084.     sprintf(oldValue, "%d", iPtr->pdPrec);
  2085.     Tcl_SetVar2(interp, name1, name2, oldValue, flags & TCL_GLOBAL_ONLY);
  2086.     return "improper value for precision";
  2087.     }
  2088.     sprintf(iPtr->pdFormat, "%%.%dg", prec);
  2089.     iPtr->pdPrec = prec;
  2090.     return (char *) NULL;
  2091. }
  2092.  
  2093. /*
  2094.  *----------------------------------------------------------------------
  2095.  *
  2096.  * TclNeedSpace --
  2097.  *
  2098.  *    This procedure checks to see whether it is appropriate to
  2099.  *    add a space before appending a new list element to an
  2100.  *    existing string.
  2101.  *
  2102.  * Results:
  2103.  *    The return value is 1 if a space is appropriate, 0 otherwise.
  2104.  *
  2105.  * Side effects:
  2106.  *    None.
  2107.  *
  2108.  *----------------------------------------------------------------------
  2109.  */
  2110.  
  2111. int
  2112. TclNeedSpace(start, end)
  2113.     char *start;        /* First character in string. */
  2114.     char *end;            /* End of string (place where space will
  2115.                  * be added, if appropriate). */
  2116. {
  2117.     /*
  2118.      * A space is needed unless either
  2119.      * (a) we're at the start of the string, or
  2120.      * (b) the trailing characters of the string consist of one or more
  2121.      *     open curly braces preceded by a space or extending back to
  2122.      *     the beginning of the string.
  2123.      * (c) the trailing characters of the string consist of a space
  2124.      *       preceded by a character other than backslash.
  2125.      */
  2126.  
  2127.     if (end == start) {
  2128.     return 0;
  2129.     }
  2130.     end--;
  2131.     if (*end != '{') {
  2132.     if (isspace(UCHAR(*end)) && ((end == start) || (end[-1] != '\\'))) {
  2133.         return 0;
  2134.     }
  2135.     return 1;
  2136.     }
  2137.     do {
  2138.     if (end == start) {
  2139.         return 0;
  2140.     }
  2141.     end--;
  2142.     } while (*end == '{');
  2143.     if (isspace(UCHAR(*end))) {
  2144.     return 0;
  2145.     }
  2146.     return 1;
  2147. }
  2148.