/[dtapublic]/projs/ets/trunk/src/c_tcl_base_7_5_w_mods/tclutil.c
ViewVC logotype

Diff of /projs/ets/trunk/src/c_tcl_base_7_5_w_mods/tclutil.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclutil.c revision 64 by dashley, Sun Oct 30 04:21:11 2016 UTC projs/dtats/trunk/shared_source/c_tcl_base_7_5_w_mods/tclutil.c revision 98 by dashley, Sun Dec 18 00:57:31 2016 UTC
# Line 1  Line 1 
 /* $Header$ */  
   
 /*  
  * tclUtil.c --  
  *  
  *      This file contains utility procedures that are used by many Tcl  
  *      commands.  
  *  
  * Copyright (c) 1987-1993 The Regents of the University of California.  
  * Copyright (c) 1994-1998 Sun Microsystems, Inc.  
  *  
  * See the file "license.terms" for information on usage and redistribution  
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.  
  *  
  *  RCS: @(#) $Id: tclutil.c,v 1.1.1.1 2001/06/13 04:47:21 dtashley Exp $  
  */  
   
 #include "tclInt.h"  
 #include "tclPort.h"  
   
 /*  
  * The following variable holds the full path name of the binary  
  * from which this application was executed, or NULL if it isn't  
  * know.  The value of the variable is set by the procedure  
  * Tcl_FindExecutable.  The storage space is dynamically allocated.  
  */  
   
 char *tclExecutableName = NULL;  
 char *tclNativeExecutableName = NULL;  
   
 /*  
  * The following values are used in the flags returned by Tcl_ScanElement  
  * and used by Tcl_ConvertElement.  The value TCL_DONT_USE_BRACES is also  
  * defined in tcl.h;  make sure its value doesn't overlap with any of the  
  * values below.  
  *  
  * TCL_DONT_USE_BRACES -        1 means the string mustn't be enclosed in  
  *                              braces (e.g. it contains unmatched braces,  
  *                              or ends in a backslash character, or user  
  *                              just doesn't want braces);  handle all  
  *                              special characters by adding backslashes.  
  * USE_BRACES -                 1 means the string contains a special  
  *                              character that can be handled simply by  
  *                              enclosing the entire argument in braces.  
  * BRACES_UNMATCHED -           1 means that braces aren't properly matched  
  *                              in the argument.  
  */  
   
 #define USE_BRACES              2  
 #define BRACES_UNMATCHED        4  
   
 /*  
  * The following values determine the precision used when converting  
  * floating-point values to strings.  This information is linked to all  
  * of the tcl_precision variables in all interpreters via the procedure  
  * TclPrecTraceProc.  
  */  
   
 static char precisionString[10] = "12";  
                                 /* The string value of all the tcl_precision  
                                  * variables. */  
 static char precisionFormat[10] = "%.12g";  
                                 /* The format string actually used in calls  
                                  * to sprintf. */  
 TCL_DECLARE_MUTEX(precisionMutex)  
   
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * TclFindElement --  
  *  
  *      Given a pointer into a Tcl list, locate the first (or next)  
  *      element in the list.  
  *  
  * Results:  
  *      The return value is normally TCL_OK, which means that the  
  *      element was successfully located.  If TCL_ERROR is returned  
  *      it means that list didn't have proper list structure;  
  *      the interp's result contains a more detailed error message.  
  *  
  *      If TCL_OK is returned, then *elementPtr will be set to point to the  
  *      first element of list, and *nextPtr will be set to point to the  
  *      character just after any white space following the last character  
  *      that's part of the element. If this is the last argument in the  
  *      list, then *nextPtr will point just after the last character in the  
  *      list (i.e., at the character at list+listLength). If sizePtr is  
  *      non-NULL, *sizePtr is filled in with the number of characters in the  
  *      element.  If the element is in braces, then *elementPtr will point  
  *      to the character after the opening brace and *sizePtr will not  
  *      include either of the braces. If there isn't an element in the list,  
  *      *sizePtr will be zero, and both *elementPtr and *termPtr will point  
  *      just after the last character in the list. Note: this procedure does  
  *      NOT collapse backslash sequences.  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 TclFindElement(interp, list, listLength, elementPtr, nextPtr, sizePtr,  
                bracePtr)  
     Tcl_Interp *interp;         /* Interpreter to use for error reporting.  
                                  * If NULL, then no error message is left  
                                  * after errors. */  
     CONST char *list;           /* Points to the first byte of a string  
                                  * containing a Tcl list with zero or more  
                                  * elements (possibly in braces). */  
     int listLength;             /* Number of bytes in the list's string. */  
     CONST char **elementPtr;    /* Where to put address of first significant  
                                  * character in first element of list. */  
     CONST char **nextPtr;       /* Fill in with location of character just  
                                  * after all white space following end of  
                                  * argument (next arg or end of list). */  
     int *sizePtr;               /* If non-zero, fill in with size of  
                                  * element. */  
     int *bracePtr;              /* If non-zero, fill in with non-zero/zero  
                                  * to indicate that arg was/wasn't  
                                  * in braces. */  
 {  
     CONST char *p = list;  
     CONST char *elemStart;      /* Points to first byte of first element. */  
     CONST char *limit;          /* Points just after list's last byte. */  
     int openBraces = 0;         /* Brace nesting level during parse. */  
     int inQuotes = 0;  
     int size = 0;               /* lint. */  
     int numChars;  
     CONST char *p2;  
       
     /*  
      * Skim off leading white space and check for an opening brace or  
      * quote. We treat embedded NULLs in the list as bytes belonging to  
      * a list element.  
      */  
   
     limit = (list + listLength);  
     while ((p < limit) && (isspace(UCHAR(*p)))) { /* INTL: ISO space. */  
         p++;  
     }  
     if (p == limit) {           /* no element found */  
         elemStart = limit;  
         goto done;  
     }  
   
     if (*p == '{') {  
         openBraces = 1;  
         p++;  
     } else if (*p == '"') {  
         inQuotes = 1;  
         p++;  
     }  
     elemStart = p;  
     if (bracePtr != 0) {  
         *bracePtr = openBraces;  
     }  
   
     /*  
      * Find element's end (a space, close brace, or the end of the string).  
      */  
   
     while (p < limit) {  
         switch (*p) {  
   
             /*  
              * Open brace: don't treat specially unless the element is in  
              * braces. In this case, keep a nesting count.  
              */  
   
             case '{':  
                 if (openBraces != 0) {  
                     openBraces++;  
                 }  
                 break;  
   
             /*  
              * Close brace: if element is in braces, keep nesting count and  
              * quit when the last close brace is seen.  
              */  
   
             case '}':  
                 if (openBraces > 1) {  
                     openBraces--;  
                 } else if (openBraces == 1) {  
                     size = (p - elemStart);  
                     p++;  
                     if ((p >= limit)  
                             || isspace(UCHAR(*p))) { /* INTL: ISO space. */  
                         goto done;  
                     }  
   
                     /*  
                      * Garbage after the closing brace; return an error.  
                      */  
                       
                     if (interp != NULL) {  
                         char buf[100];  
                           
                         p2 = p;  
                         while ((p2 < limit)  
                                 && (!isspace(UCHAR(*p2))) /* INTL: ISO space. */  
                                 && (p2 < p+20)) {  
                             p2++;  
                         }  
                         sprintf(buf,  
                                 "list element in braces followed by \"%.*s\" instead of space",  
                                 (int) (p2-p), p);  
                         Tcl_SetResult(interp, buf, TCL_VOLATILE);  
                     }  
                     return TCL_ERROR;  
                 }  
                 break;  
   
             /*  
              * Backslash:  skip over everything up to the end of the  
              * backslash sequence.  
              */  
   
             case '\\': {  
                 Tcl_UtfBackslash(p, &numChars, NULL);  
                 p += (numChars - 1);  
                 break;  
             }  
   
             /*  
              * Space: ignore if element is in braces or quotes; otherwise  
              * terminate element.  
              */  
   
             case ' ':  
             case '\f':  
             case '\n':  
             case '\r':  
             case '\t':  
             case '\v':  
                 if ((openBraces == 0) && !inQuotes) {  
                     size = (p - elemStart);  
                     goto done;  
                 }  
                 break;  
   
             /*  
              * Double-quote: if element is in quotes then terminate it.  
              */  
   
             case '"':  
                 if (inQuotes) {  
                     size = (p - elemStart);  
                     p++;  
                     if ((p >= limit)  
                             || isspace(UCHAR(*p))) { /* INTL: ISO space */  
                         goto done;  
                     }  
   
                     /*  
                      * Garbage after the closing quote; return an error.  
                      */  
                       
                     if (interp != NULL) {  
                         char buf[100];  
                           
                         p2 = p;  
                         while ((p2 < limit)  
                                 && (!isspace(UCHAR(*p2))) /* INTL: ISO space */  
                                  && (p2 < p+20)) {  
                             p2++;  
                         }  
                         sprintf(buf,  
                                 "list element in quotes followed by \"%.*s\" %s",  
                                 (int) (p2-p), p, "instead of space");  
                         Tcl_SetResult(interp, buf, TCL_VOLATILE);  
                     }  
                     return TCL_ERROR;  
                 }  
                 break;  
         }  
         p++;  
     }  
   
   
     /*  
      * End of list: terminate element.  
      */  
   
     if (p == limit) {  
         if (openBraces != 0) {  
             if (interp != NULL) {  
                 Tcl_SetResult(interp, "unmatched open brace in list",  
                         TCL_STATIC);  
             }  
             return TCL_ERROR;  
         } else if (inQuotes) {  
             if (interp != NULL) {  
                 Tcl_SetResult(interp, "unmatched open quote in list",  
                         TCL_STATIC);  
             }  
             return TCL_ERROR;  
         }  
         size = (p - elemStart);  
     }  
   
     done:  
     while ((p < limit) && (isspace(UCHAR(*p)))) { /* INTL: ISO space. */  
         p++;  
     }  
     *elementPtr = elemStart;  
     *nextPtr = p;  
     if (sizePtr != 0) {  
         *sizePtr = size;  
     }  
     return TCL_OK;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * TclCopyAndCollapse --  
  *  
  *      Copy a string and eliminate any backslashes that aren't in braces.  
  *  
  * Results:  
  *      There is no return value. Count characters get copied from src to  
  *      dst. Along the way, if backslash sequences are found outside braces,  
  *      the backslashes are eliminated in the copy. After scanning count  
  *      chars from source, a null character is placed at the end of dst.  
  *      Returns the number of characters that got copied.  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 TclCopyAndCollapse(count, src, dst)  
     int count;                  /* Number of characters to copy from src. */  
     CONST char *src;            /* Copy from here... */  
     char *dst;                  /* ... to here. */  
 {  
     register char c;  
     int numRead;  
     int newCount = 0;  
     int backslashCount;  
   
     for (c = *src;  count > 0;  src++, c = *src, count--) {  
         if (c == '\\') {  
             backslashCount = Tcl_UtfBackslash(src, &numRead, dst);  
             dst += backslashCount;  
             newCount += backslashCount;  
             src += numRead-1;  
             count -= numRead-1;  
         } else {  
             *dst = c;  
             dst++;  
             newCount++;  
         }  
     }  
     *dst = 0;  
     return newCount;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_SplitList --  
  *  
  *      Splits a list up into its constituent fields.  
  *  
  * Results  
  *      The return value is normally TCL_OK, which means that  
  *      the list was successfully split up.  If TCL_ERROR is  
  *      returned, it means that "list" didn't have proper list  
  *      structure;  the interp's result will contain a more detailed  
  *      error message.  
  *  
  *      *argvPtr will be filled in with the address of an array  
  *      whose elements point to the elements of list, in order.  
  *      *argcPtr will get filled in with the number of valid elements  
  *      in the array.  A single block of memory is dynamically allocated  
  *      to hold both the argv array and a copy of the list (with  
  *      backslashes and braces removed in the standard way).  
  *      The caller must eventually free this memory by calling free()  
  *      on *argvPtr.  Note:  *argvPtr and *argcPtr are only modified  
  *      if the procedure returns normally.  
  *  
  * Side effects:  
  *      Memory is allocated.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 Tcl_SplitList(interp, list, argcPtr, argvPtr)  
     Tcl_Interp *interp;         /* Interpreter to use for error reporting.  
                                  * If NULL, no error message is left. */  
     CONST char *list;           /* Pointer to string with list structure. */  
     int *argcPtr;               /* Pointer to location to fill in with  
                                  * the number of elements in the list. */  
     char ***argvPtr;            /* Pointer to place to store pointer to  
                                  * array of pointers to list elements. */  
 {  
     char **argv;  
     CONST char *l;  
     char *p;  
     int length, size, i, result, elSize, brace;  
     CONST char *element;  
   
     /*  
      * Figure out how much space to allocate.  There must be enough  
      * space for both the array of pointers and also for a copy of  
      * the list.  To estimate the number of pointers needed, count  
      * the number of space characters in the list.  
      */  
   
     for (size = 1, l = list; *l != 0; l++) {  
         if (isspace(UCHAR(*l))) { /* INTL: ISO space. */  
             size++;  
         }  
     }  
     size++;                     /* Leave space for final NULL pointer. */  
     argv = (char **) ckalloc((unsigned)  
             ((size * sizeof(char *)) + (l - list) + 1));  
     length = strlen(list);  
     for (i = 0, p = ((char *) argv) + size*sizeof(char *);  
             *list != 0;  i++) {  
         CONST char *prevList = list;  
           
         result = TclFindElement(interp, list, length, &element,  
                                 &list, &elSize, &brace);  
         length -= (list - prevList);  
         if (result != TCL_OK) {  
             ckfree((char *) argv);  
             return result;  
         }  
         if (*element == 0) {  
             break;  
         }  
         if (i >= size) {  
             ckfree((char *) argv);  
             if (interp != NULL) {  
                 Tcl_SetResult(interp, "internal error in Tcl_SplitList",  
                         TCL_STATIC);  
             }  
             return TCL_ERROR;  
         }  
         argv[i] = p;  
         if (brace) {  
             memcpy((VOID *) p, (VOID *) element, (size_t) elSize);  
             p += elSize;  
             *p = 0;  
             p++;  
         } else {  
             TclCopyAndCollapse(elSize, element, p);  
             p += elSize+1;  
         }  
     }  
   
     argv[i] = NULL;  
     *argvPtr = argv;  
     *argcPtr = i;  
     return TCL_OK;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_ScanElement --  
  *  
  *      This procedure is a companion procedure to Tcl_ConvertElement.  
  *      It scans a string to see what needs to be done to it (e.g. add  
  *      backslashes or enclosing braces) to make the string into a  
  *      valid Tcl list element.  
  *  
  * Results:  
  *      The return value is an overestimate of the number of characters  
  *      that will be needed by Tcl_ConvertElement to produce a valid  
  *      list element from string.  The word at *flagPtr is filled in  
  *      with a value needed by Tcl_ConvertElement when doing the actual  
  *      conversion.  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 Tcl_ScanElement(string, flagPtr)  
     register CONST char *string; /* String to convert to list element. */  
     register int *flagPtr;       /* Where to store information to guide  
                                   * Tcl_ConvertCountedElement. */  
 {  
     return Tcl_ScanCountedElement(string, -1, flagPtr);  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_ScanCountedElement --  
  *  
  *      This procedure is a companion procedure to  
  *      Tcl_ConvertCountedElement.  It scans a string to see what  
  *      needs to be done to it (e.g. add backslashes or enclosing  
  *      braces) to make the string into a valid Tcl list element.  
  *      If length is -1, then the string is scanned up to the first  
  *      null byte.  
  *  
  * Results:  
  *      The return value is an overestimate of the number of characters  
  *      that will be needed by Tcl_ConvertCountedElement to produce a  
  *      valid list element from string.  The word at *flagPtr is  
  *      filled in with a value needed by Tcl_ConvertCountedElement  
  *      when doing the actual conversion.  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 Tcl_ScanCountedElement(string, length, flagPtr)  
     CONST char *string;         /* String to convert to Tcl list element. */  
     int length;                 /* Number of bytes in string, or -1. */  
     int *flagPtr;               /* Where to store information to guide  
                                  * Tcl_ConvertElement. */  
 {  
     int flags, nestingLevel;  
     register CONST char *p, *lastChar;  
   
     /*  
      * This procedure and Tcl_ConvertElement together do two things:  
      *  
      * 1. They produce a proper list, one that will yield back the  
      * argument strings when evaluated or when disassembled with  
      * Tcl_SplitList.  This is the most important thing.  
      *  
      * 2. They try to produce legible output, which means minimizing the  
      * use of backslashes (using braces instead).  However, there are  
      * some situations where backslashes must be used (e.g. an element  
      * like "{abc": the leading brace will have to be backslashed.  
      * For each element, one of three things must be done:  
      *  
      * (a) Use the element as-is (it doesn't contain any special  
      * characters).  This is the most desirable option.  
      *  
      * (b) Enclose the element in braces, but leave the contents alone.  
      * This happens if the element contains embedded space, or if it  
      * contains characters with special interpretation ($, [, ;, or \),  
      * or if it starts with a brace or double-quote, or if there are  
      * no characters in the element.  
      *  
      * (c) Don't enclose the element in braces, but add backslashes to  
      * prevent special interpretation of special characters.  This is a  
      * last resort used when the argument would normally fall under case  
      * (b) but contains unmatched braces.  It also occurs if the last  
      * character of the argument is a backslash or if the element contains  
      * a backslash followed by newline.  
      *  
      * The procedure figures out how many bytes will be needed to store  
      * the result (actually, it overestimates). It also collects information  
      * about the element in the form of a flags word.  
      *  
      * Note: list elements produced by this procedure and  
      * Tcl_ConvertCountedElement must have the property that they can be  
      * enclosing in curly braces to make sub-lists.  This means, for  
      * example, that we must not leave unmatched curly braces in the  
      * resulting list element.  This property is necessary in order for  
      * procedures like Tcl_DStringStartSublist to work.  
      */  
   
     nestingLevel = 0;  
     flags = 0;  
     if (string == NULL) {  
         string = "";  
     }  
     if (length == -1) {  
         length = strlen(string);  
     }  
     lastChar = string + length;  
     p = string;  
     if ((p == lastChar) || (*p == '{') || (*p == '"')) {  
         flags |= USE_BRACES;  
     }  
     for ( ; p < lastChar; p++) {  
         switch (*p) {  
             case '{':  
                 nestingLevel++;  
                 break;  
             case '}':  
                 nestingLevel--;  
                 if (nestingLevel < 0) {  
                     flags |= TCL_DONT_USE_BRACES|BRACES_UNMATCHED;  
                 }  
                 break;  
             case '[':  
             case '$':  
             case ';':  
             case ' ':  
             case '\f':  
             case '\n':  
             case '\r':  
             case '\t':  
             case '\v':  
                 flags |= USE_BRACES;  
                 break;  
             case '\\':  
                 if ((p+1 == lastChar) || (p[1] == '\n')) {  
                     flags = TCL_DONT_USE_BRACES | BRACES_UNMATCHED;  
                 } else {  
                     int size;  
   
                     Tcl_UtfBackslash(p, &size, NULL);  
                     p += size-1;  
                     flags |= USE_BRACES;  
                 }  
                 break;  
         }  
     }  
     if (nestingLevel != 0) {  
         flags = TCL_DONT_USE_BRACES | BRACES_UNMATCHED;  
     }  
     *flagPtr = flags;  
   
     /*  
      * Allow enough space to backslash every character plus leave  
      * two spaces for braces.  
      */  
   
     return 2*(p-string) + 2;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_ConvertElement --  
  *  
  *      This is a companion procedure to Tcl_ScanElement.  Given  
  *      the information produced by Tcl_ScanElement, this procedure  
  *      converts a string to a list element equal to that string.  
  *  
  * Results:  
  *      Information is copied to *dst in the form of a list element  
  *      identical to src (i.e. if Tcl_SplitList is applied to dst it  
  *      will produce a string identical to src).  The return value is  
  *      a count of the number of characters copied (not including the  
  *      terminating NULL character).  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 Tcl_ConvertElement(src, dst, flags)  
     register CONST char *src;   /* Source information for list element. */  
     register char *dst;         /* Place to put list-ified element. */  
     register int flags;         /* Flags produced by Tcl_ScanElement. */  
 {  
     return Tcl_ConvertCountedElement(src, -1, dst, flags);  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_ConvertCountedElement --  
  *  
  *      This is a companion procedure to Tcl_ScanCountedElement.  Given  
  *      the information produced by Tcl_ScanCountedElement, this  
  *      procedure converts a string to a list element equal to that  
  *      string.  
  *  
  * Results:  
  *      Information is copied to *dst in the form of a list element  
  *      identical to src (i.e. if Tcl_SplitList is applied to dst it  
  *      will produce a string identical to src).  The return value is  
  *      a count of the number of characters copied (not including the  
  *      terminating NULL character).  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 Tcl_ConvertCountedElement(src, length, dst, flags)  
     register CONST char *src;   /* Source information for list element. */  
     int length;                 /* Number of bytes in src, or -1. */  
     char *dst;                  /* Place to put list-ified element. */  
     int flags;                  /* Flags produced by Tcl_ScanElement. */  
 {  
     register char *p = dst;  
     register CONST char *lastChar;  
   
     /*  
      * See the comment block at the beginning of the Tcl_ScanElement  
      * code for details of how this works.  
      */  
   
     if (src && length == -1) {  
         length = strlen(src);  
     }  
     if ((src == NULL) || (length == 0)) {  
         p[0] = '{';  
         p[1] = '}';  
         p[2] = 0;  
         return 2;  
     }  
     lastChar = src + length;  
     if ((flags & USE_BRACES) && !(flags & TCL_DONT_USE_BRACES)) {  
         *p = '{';  
         p++;  
         for ( ; src != lastChar; src++, p++) {  
             *p = *src;  
         }  
         *p = '}';  
         p++;  
     } else {  
         if (*src == '{') {  
             /*  
              * Can't have a leading brace unless the whole element is  
              * enclosed in braces.  Add a backslash before the brace.  
              * Furthermore, this may destroy the balance between open  
              * and close braces, so set BRACES_UNMATCHED.  
              */  
   
             p[0] = '\\';  
             p[1] = '{';  
             p += 2;  
             src++;  
             flags |= BRACES_UNMATCHED;  
         }  
         for (; src != lastChar; src++) {  
             switch (*src) {  
                 case ']':  
                 case '[':  
                 case '$':  
                 case ';':  
                 case ' ':  
                 case '\\':  
                 case '"':  
                     *p = '\\';  
                     p++;  
                     break;  
                 case '{':  
                 case '}':  
                     /*  
                      * It may not seem necessary to backslash braces, but  
                      * it is.  The reason for this is that the resulting  
                      * list element may actually be an element of a sub-list  
                      * enclosed in braces (e.g. if Tcl_DStringStartSublist  
                      * has been invoked), so there may be a brace mismatch  
                      * if the braces aren't backslashed.  
                      */  
   
                     if (flags & BRACES_UNMATCHED) {  
                         *p = '\\';  
                         p++;  
                     }  
                     break;  
                 case '\f':  
                     *p = '\\';  
                     p++;  
                     *p = 'f';  
                     p++;  
                     continue;  
                 case '\n':  
                     *p = '\\';  
                     p++;  
                     *p = 'n';  
                     p++;  
                     continue;  
                 case '\r':  
                     *p = '\\';  
                     p++;  
                     *p = 'r';  
                     p++;  
                     continue;  
                 case '\t':  
                     *p = '\\';  
                     p++;  
                     *p = 't';  
                     p++;  
                     continue;  
                 case '\v':  
                     *p = '\\';  
                     p++;  
                     *p = 'v';  
                     p++;  
                     continue;  
             }  
             *p = *src;  
             p++;  
         }  
     }  
     *p = '\0';  
     return p-dst;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_Merge --  
  *  
  *      Given a collection of strings, merge them together into a  
  *      single string that has proper Tcl list structured (i.e.  
  *      Tcl_SplitList may be used to retrieve strings equal to the  
  *      original elements, and Tcl_Eval will parse the string back  
  *      into its original elements).  
  *  
  * Results:  
  *      The return value is the address of a dynamically-allocated  
  *      string containing the merged list.  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 char *  
 Tcl_Merge(argc, argv)  
     int argc;                   /* How many strings to merge. */  
     char **argv;                /* Array of string values. */  
 {  
 #   define LOCAL_SIZE 20  
     int localFlags[LOCAL_SIZE], *flagPtr;  
     int numChars;  
     char *result;  
     char *dst;  
     int i;  
   
     /*  
      * Pass 1: estimate space, gather flags.  
      */  
   
     if (argc <= LOCAL_SIZE) {  
         flagPtr = localFlags;  
     } else {  
         flagPtr = (int *) ckalloc((unsigned) argc*sizeof(int));  
     }  
     numChars = 1;  
     for (i = 0; i < argc; i++) {  
         numChars += Tcl_ScanElement(argv[i], &flagPtr[i]) + 1;  
     }  
   
     /*  
      * Pass two: copy into the result area.  
      */  
   
     result = (char *) ckalloc((unsigned) numChars);  
     dst = result;  
     for (i = 0; i < argc; i++) {  
         numChars = Tcl_ConvertElement(argv[i], dst, flagPtr[i]);  
         dst += numChars;  
         *dst = ' ';  
         dst++;  
     }  
     if (dst == result) {  
         *dst = 0;  
     } else {  
         dst[-1] = 0;  
     }  
   
     if (flagPtr != localFlags) {  
         ckfree((char *) flagPtr);  
     }  
     return result;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_Backslash --  
  *  
  *      Figure out how to handle a backslash sequence.  
  *  
  * Results:  
  *      The return value is the character that should be substituted  
  *      in place of the backslash sequence that starts at src.  If  
  *      readPtr isn't NULL then it is filled in with a count of the  
  *      number of characters in the backslash sequence.  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 char  
 Tcl_Backslash(src, readPtr)  
     CONST char *src;            /* Points to the backslash character of  
                                  * a backslash sequence. */  
     int *readPtr;               /* Fill in with number of characters read  
                                  * from src, unless NULL. */  
 {  
     char buf[TCL_UTF_MAX];  
     Tcl_UniChar ch;  
   
     Tcl_UtfBackslash(src, readPtr, buf);  
     Tcl_UtfToUniChar(buf, &ch);  
     return (char) ch;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_Concat --  
  *  
  *      Concatenate a set of strings into a single large string.  
  *  
  * Results:  
  *      The return value is dynamically-allocated string containing  
  *      a concatenation of all the strings in argv, with spaces between  
  *      the original argv elements.  
  *  
  * Side effects:  
  *      Memory is allocated for the result;  the caller is responsible  
  *      for freeing the memory.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 char *  
 Tcl_Concat(argc, argv)  
     int argc;                   /* Number of strings to concatenate. */  
     char **argv;                /* Array of strings to concatenate. */  
 {  
     int totalSize, i;  
     char *p;  
     char *result;  
   
     for (totalSize = 1, i = 0; i < argc; i++) {  
         totalSize += strlen(argv[i]) + 1;  
     }  
     result = (char *) ckalloc((unsigned) totalSize);  
     if (argc == 0) {  
         *result = '\0';  
         return result;  
     }  
     for (p = result, i = 0; i < argc; i++) {  
         char *element;  
         int length;  
   
         /*  
          * Clip white space off the front and back of the string  
          * to generate a neater result, and ignore any empty  
          * elements.  
          */  
   
         element = argv[i];  
         while (isspace(UCHAR(*element))) { /* INTL: ISO space. */  
             element++;  
         }  
         for (length = strlen(element);  
                 (length > 0)  
                 && (isspace(UCHAR(element[length-1]))) /* INTL: ISO space. */  
                 && ((length < 2) || (element[length-2] != '\\'));  
                 length--) {  
             /* Null loop body. */  
         }  
         if (length == 0) {  
             continue;  
         }  
         memcpy((VOID *) p, (VOID *) element, (size_t) length);  
         p += length;  
         *p = ' ';  
         p++;  
     }  
     if (p != result) {  
         p[-1] = 0;  
     } else {  
         *p = 0;  
     }  
     return result;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_ConcatObj --  
  *  
  *      Concatenate the strings from a set of objects into a single string  
  *      object with spaces between the original strings.  
  *  
  * Results:  
  *      The return value is a new string object containing a concatenation  
  *      of the strings in objv. Its ref count is zero.  
  *  
  * Side effects:  
  *      A new object is created.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 Tcl_Obj *  
 Tcl_ConcatObj(objc, objv)  
     int objc;                   /* Number of objects to concatenate. */  
     Tcl_Obj *CONST objv[];      /* Array of objects to concatenate. */  
 {  
     int allocSize, finalSize, length, elemLength, i;  
     char *p;  
     char *element;  
     char *concatStr;  
     Tcl_Obj *objPtr;  
   
     /*  
      * Check first to see if all the items are of list type.  If so,  
      * we will concat them together as lists, and return a list object.  
      * This is only valid when the lists have no current string  
      * representation, since we don't know what the original type was.  
      * An original string rep may have lost some whitespace info when  
      * converted which could be important.  
      */  
     for (i = 0;  i < objc;  i++) {  
         objPtr = objv[i];  
         if ((objPtr->typePtr != &tclListType) || (objPtr->bytes != NULL)) {  
             break;  
         }  
     }  
     if (i == objc) {  
         Tcl_Obj **listv;  
         int listc;  
   
         objPtr = Tcl_NewListObj(0, NULL);  
         for (i = 0;  i < objc;  i++) {  
             /*  
              * Tcl_ListObjAppendList could be used here, but this saves  
              * us a bit of type checking (since we've already done it)  
              * Use of INT_MAX tells us to always put the new stuff on  
              * the end.  It will be set right in Tcl_ListObjReplace.  
              */  
             Tcl_ListObjGetElements(NULL, objv[i], &listc, &listv);  
             Tcl_ListObjReplace(NULL, objPtr, INT_MAX, 0, listc, listv);  
         }  
         return objPtr;  
     }  
   
     allocSize = 0;  
     for (i = 0;  i < objc;  i++) {  
         objPtr = objv[i];  
         element = Tcl_GetStringFromObj(objPtr, &length);  
         if ((element != NULL) && (length > 0)) {  
             allocSize += (length + 1);  
         }  
     }  
     if (allocSize == 0) {  
         allocSize = 1;          /* enough for the NULL byte at end */  
     }  
   
     /*  
      * Allocate storage for the concatenated result. Note that allocSize  
      * is one more than the total number of characters, and so includes  
      * room for the terminating NULL byte.  
      */  
       
     concatStr = (char *) ckalloc((unsigned) allocSize);  
   
     /*  
      * Now concatenate the elements. Clip white space off the front and back  
      * to generate a neater result, and ignore any empty elements. Also put  
      * a null byte at the end.  
      */  
   
     finalSize = 0;  
     if (objc == 0) {  
         *concatStr = '\0';  
     } else {  
         p = concatStr;  
         for (i = 0;  i < objc;  i++) {  
             objPtr = objv[i];  
             element = Tcl_GetStringFromObj(objPtr, &elemLength);  
             while ((elemLength > 0)  
                     && (isspace(UCHAR(*element)))) { /* INTL: ISO space. */  
                  element++;  
                  elemLength--;  
             }  
   
             /*  
              * Trim trailing white space.  But, be careful not to trim  
              * a space character if it is preceded by a backslash: in  
              * this case it could be significant.  
              */  
   
             while ((elemLength > 0)  
                     && isspace(UCHAR(element[elemLength-1])) /* INTL: ISO space. */  
                     && ((elemLength < 2) || (element[elemLength-2] != '\\'))) {  
                 elemLength--;  
             }  
             if (elemLength == 0) {  
                  continue;      /* nothing left of this element */  
             }  
             memcpy((VOID *) p, (VOID *) element, (size_t) elemLength);  
             p += elemLength;  
             *p = ' ';  
             p++;  
             finalSize += (elemLength + 1);  
         }  
         if (p != concatStr) {  
             p[-1] = 0;  
             finalSize -= 1;     /* we overwrote the final ' ' */  
         } else {  
             *p = 0;  
         }  
     }  
       
     TclNewObj(objPtr);  
     objPtr->bytes  = concatStr;  
     objPtr->length = finalSize;  
     return objPtr;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_StringMatch --  
  *  
  *      See if a particular string matches a particular pattern.  
  *  
  * Results:  
  *      The return value is 1 if string matches pattern, and  
  *      0 otherwise.  The matching operation permits the following  
  *      special characters in the pattern: *?\[] (see the manual  
  *      entry for details on what these mean).  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 Tcl_StringMatch(string, pattern)  
     CONST char *string;         /* String. */  
     CONST char *pattern;        /* Pattern, which may contain special  
                                  * characters. */  
 {  
     int p, s;  
     CONST char *pstart = pattern;  
       
     while (1) {  
         p = *pattern;  
         s = *string;  
           
         /*  
          * See if we're at the end of both the pattern and the string.  If  
          * so, we succeeded.  If we're at the end of the pattern but not at  
          * the end of the string, we failed.  
          */  
           
         if (p == '\0') {  
             if (s == '\0') {  
                 return 1;  
             } else {  
                 return 0;  
             }  
         }  
         if ((s == '\0') && (p != '*')) {  
             return 0;  
         }  
   
         /* Check for a "*" as the next pattern character.  It matches  
          * any substring.  We handle this by calling ourselves  
          * recursively for each postfix of string, until either we  
          * match or we reach the end of the string.  
          */  
           
         if (p == '*') {  
             pattern++;  
             if (*pattern == '\0') {  
                 return 1;  
             }  
             while (1) {  
                 if (Tcl_StringMatch(string, pattern)) {  
                     return 1;  
                 }  
                 if (*string == '\0') {  
                     return 0;  
                 }  
                 string++;  
             }  
         }  
   
         /* Check for a "?" as the next pattern character.  It matches  
          * any single character.  
          */  
   
         if (p == '?') {  
             Tcl_UniChar ch;  
               
             pattern++;  
             string += Tcl_UtfToUniChar(string, &ch);  
             continue;  
         }  
   
         /* Check for a "[" as the next pattern character.  It is followed  
          * by a list of characters that are acceptable, or by a range  
          * (two characters separated by "-").  
          */  
           
         if (p == '[') {  
             Tcl_UniChar ch, startChar, endChar;  
   
             pattern++;  
             string += Tcl_UtfToUniChar(string, &ch);  
   
             while (1) {  
                 if ((*pattern == ']') || (*pattern == '\0')) {  
                     return 0;  
                 }  
                 pattern += Tcl_UtfToUniChar(pattern, &startChar);  
                 if (*pattern == '-') {  
                     pattern++;  
                     if (*pattern == '\0') {  
                         return 0;  
                     }  
                     pattern += Tcl_UtfToUniChar(pattern, &endChar);  
                     if (((startChar <= ch) && (ch <= endChar))  
                             || ((endChar <= ch) && (ch <= startChar))) {  
                         /*  
                          * Matches ranges of form [a-z] or [z-a].  
                          */  
   
                         break;  
                     }  
                 } else if (startChar == ch) {  
                     break;  
                 }  
             }  
             while (*pattern != ']') {  
                 if (*pattern == '\0') {  
                     pattern = Tcl_UtfPrev(pattern, pstart);  
                     break;  
                 }  
                 pattern++;  
             }  
             pattern++;  
             continue;  
         }  
       
         /* If the next pattern character is '\', just strip off the '\'  
          * so we do exact matching on the character that follows.  
          */  
           
         if (p == '\\') {  
             pattern++;  
             p = *pattern;  
             if (p == '\0') {  
                 return 0;  
             }  
         }  
   
         /* There's no special character.  Just make sure that the next  
          * bytes of each string match.  
          */  
           
         if (s != p) {  
             return 0;  
         }  
         pattern++;  
         string++;  
     }  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_StringCaseMatch --  
  *  
  *      See if a particular string matches a particular pattern.  
  *      Allows case insensitivity.  
  *  
  * Results:  
  *      The return value is 1 if string matches pattern, and  
  *      0 otherwise.  The matching operation permits the following  
  *      special characters in the pattern: *?\[] (see the manual  
  *      entry for details on what these mean).  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 Tcl_StringCaseMatch(string, pattern, nocase)  
     CONST char *string;         /* String. */  
     CONST char *pattern;        /* Pattern, which may contain special  
                                  * characters. */  
     int nocase;                 /* 0 for case sensitive, 1 for insensitive */  
 {  
     int p, s;  
     CONST char *pstart = pattern;  
     Tcl_UniChar ch1, ch2;  
       
     while (1) {  
         p = *pattern;  
         s = *string;  
           
         /*  
          * See if we're at the end of both the pattern and the string.  If  
          * so, we succeeded.  If we're at the end of the pattern but not at  
          * the end of the string, we failed.  
          */  
           
         if (p == '\0') {  
             return (s == '\0');  
         }  
         if ((s == '\0') && (p != '*')) {  
             return 0;  
         }  
   
         /* Check for a "*" as the next pattern character.  It matches  
          * any substring.  We handle this by calling ourselves  
          * recursively for each postfix of string, until either we  
          * match or we reach the end of the string.  
          */  
           
         if (p == '*') {  
             pattern++;  
             if (*pattern == '\0') {  
                 return 1;  
             }  
             while (1) {  
                 if (Tcl_StringCaseMatch(string, pattern, nocase)) {  
                     return 1;  
                 }  
                 if (*string == '\0') {  
                     return 0;  
                 }  
                 string++;  
             }  
         }  
   
         /* Check for a "?" as the next pattern character.  It matches  
          * any single character.  
          */  
   
         if (p == '?') {  
             pattern++;  
             string += Tcl_UtfToUniChar(string, &ch1);  
             continue;  
         }  
   
         /* Check for a "[" as the next pattern character.  It is followed  
          * by a list of characters that are acceptable, or by a range  
          * (two characters separated by "-").  
          */  
           
         if (p == '[') {  
             Tcl_UniChar startChar, endChar;  
   
             pattern++;  
             string += Tcl_UtfToUniChar(string, &ch1);  
             if (nocase) {  
                 ch1 = Tcl_UniCharToLower(ch1);  
             }  
             while (1) {  
                 if ((*pattern == ']') || (*pattern == '\0')) {  
                     return 0;  
                 }  
                 pattern += Tcl_UtfToUniChar(pattern, &startChar);  
                 if (nocase) {  
                     startChar = Tcl_UniCharToLower(startChar);  
                 }  
                 if (*pattern == '-') {  
                     pattern++;  
                     if (*pattern == '\0') {  
                         return 0;  
                     }  
                     pattern += Tcl_UtfToUniChar(pattern, &endChar);  
                     if (nocase) {  
                         endChar = Tcl_UniCharToLower(endChar);  
                     }  
                     if (((startChar <= ch1) && (ch1 <= endChar))  
                             || ((endChar <= ch1) && (ch1 <= startChar))) {  
                         /*  
                          * Matches ranges of form [a-z] or [z-a].  
                          */  
   
                         break;  
                     }  
                 } else if (startChar == ch1) {  
                     break;  
                 }  
             }  
             while (*pattern != ']') {  
                 if (*pattern == '\0') {  
                     pattern = Tcl_UtfPrev(pattern, pstart);  
                     break;  
                 }  
                 pattern++;  
             }  
             pattern++;  
             continue;  
         }  
       
         /* If the next pattern character is '\', just strip off the '\'  
          * so we do exact matching on the character that follows.  
          */  
           
         if (p == '\\') {  
             pattern++;  
             p = *pattern;  
             if (p == '\0') {  
                 return 0;  
             }  
         }  
   
         /* There's no special character.  Just make sure that the next  
          * bytes of each string match.  
          */  
           
         string  += Tcl_UtfToUniChar(string, &ch1);  
         pattern += Tcl_UtfToUniChar(pattern, &ch2);  
         if (nocase) {  
             if (Tcl_UniCharToLower(ch1) != Tcl_UniCharToLower(ch2)) {  
                 return 0;  
             }  
         } else if (ch1 != ch2) {  
             return 0;  
         }  
     }  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_DStringInit --  
  *  
  *      Initializes a dynamic string, discarding any previous contents  
  *      of the string (Tcl_DStringFree should have been called already  
  *      if the dynamic string was previously in use).  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      The dynamic string is initialized to be empty.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 void  
 Tcl_DStringInit(dsPtr)  
     Tcl_DString *dsPtr;         /* Pointer to structure for dynamic string. */  
 {  
     dsPtr->string = dsPtr->staticSpace;  
     dsPtr->length = 0;  
     dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;  
     dsPtr->staticSpace[0] = '\0';  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_DStringAppend --  
  *  
  *      Append more characters to the current value of a dynamic string.  
  *  
  * Results:  
  *      The return value is a pointer to the dynamic string's new value.  
  *  
  * Side effects:  
  *      Length bytes from string (or all of string if length is less  
  *      than zero) are added to the current value of the string. Memory  
  *      gets reallocated if needed to accomodate the string's new size.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 char *  
 Tcl_DStringAppend(dsPtr, string, length)  
     Tcl_DString *dsPtr;         /* Structure describing dynamic string. */  
     CONST char *string;         /* String to append.  If length is -1 then  
                                  * this must be null-terminated. */  
     int length;                 /* Number of characters from string to  
                                  * append.  If < 0, then append all of string,  
                                  * up to null at end. */  
 {  
     int newSize;  
     char *dst;  
     CONST char *end;  
   
     if (length < 0) {  
         length = strlen(string);  
     }  
     newSize = length + dsPtr->length;  
   
     /*  
      * Allocate a larger buffer for the string if the current one isn't  
      * large enough. Allocate extra space in the new buffer so that there  
      * will be room to grow before we have to allocate again.  
      */  
   
     if (newSize >= dsPtr->spaceAvl) {  
         dsPtr->spaceAvl = newSize * 2;  
         if (dsPtr->string == dsPtr->staticSpace) {  
             char *newString;  
   
             newString = (char *) ckalloc((unsigned) dsPtr->spaceAvl);  
             memcpy((VOID *) newString, (VOID *) dsPtr->string,  
                     (size_t) dsPtr->length);  
             dsPtr->string = newString;  
         } else {  
             dsPtr->string = (char *) ckrealloc((VOID *) dsPtr->string,  
                     (size_t) dsPtr->spaceAvl);  
         }  
     }  
   
     /*  
      * Copy the new string into the buffer at the end of the old  
      * one.  
      */  
   
     for (dst = dsPtr->string + dsPtr->length, end = string+length;  
             string < end; string++, dst++) {  
         *dst = *string;  
     }  
     *dst = '\0';  
     dsPtr->length += length;  
     return dsPtr->string;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_DStringAppendElement --  
  *  
  *      Append a list element to the current value of a dynamic string.  
  *  
  * Results:  
  *      The return value is a pointer to the dynamic string's new value.  
  *  
  * Side effects:  
  *      String is reformatted as a list element and added to the current  
  *      value of the string.  Memory gets reallocated if needed to  
  *      accomodate the string's new size.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 char *  
 Tcl_DStringAppendElement(dsPtr, string)  
     Tcl_DString *dsPtr;         /* Structure describing dynamic string. */  
     CONST char *string;         /* String to append.  Must be  
                                  * null-terminated. */  
 {  
     int newSize, flags;  
     char *dst;  
   
     newSize = Tcl_ScanElement(string, &flags) + dsPtr->length + 1;  
   
     /*  
      * Allocate a larger buffer for the string if the current one isn't  
      * large enough.  Allocate extra space in the new buffer so that there  
      * will be room to grow before we have to allocate again.  
      * SPECIAL NOTE: must use memcpy, not strcpy, to copy the string  
      * to a larger buffer, since there may be embedded NULLs in the  
      * string in some cases.  
      */  
   
     if (newSize >= dsPtr->spaceAvl) {  
         dsPtr->spaceAvl = newSize * 2;  
         if (dsPtr->string == dsPtr->staticSpace) {  
             char *newString;  
   
             newString = (char *) ckalloc((unsigned) dsPtr->spaceAvl);  
             memcpy((VOID *) newString, (VOID *) dsPtr->string,  
                     (size_t) dsPtr->length);  
             dsPtr->string = newString;  
         } else {  
             dsPtr->string = (char *) ckrealloc((VOID *) dsPtr->string,  
                     (size_t) dsPtr->spaceAvl);  
         }  
     }  
   
     /*  
      * Convert the new string to a list element and copy it into the  
      * buffer at the end, with a space, if needed.  
      */  
   
     dst = dsPtr->string + dsPtr->length;  
     if (TclNeedSpace(dsPtr->string, dst)) {  
         *dst = ' ';  
         dst++;  
         dsPtr->length++;  
     }  
     dsPtr->length += Tcl_ConvertElement(string, dst, flags);  
     return dsPtr->string;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_DStringSetLength --  
  *  
  *      Change the length of a dynamic string.  This can cause the  
  *      string to either grow or shrink, depending on the value of  
  *      length.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      The length of dsPtr is changed to length and a null byte is  
  *      stored at that position in the string.  If length is larger  
  *      than the space allocated for dsPtr, then a panic occurs.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 void  
 Tcl_DStringSetLength(dsPtr, length)  
     Tcl_DString *dsPtr;         /* Structure describing dynamic string. */  
     int length;                 /* New length for dynamic string. */  
 {  
     int newsize;  
   
     if (length < 0) {  
         length = 0;  
     }  
     if (length >= dsPtr->spaceAvl) {  
         /*  
          * There are two interesting cases here.  In the first case, the user  
          * may be trying to allocate a large buffer of a specific size.  It  
          * would be wasteful to overallocate that buffer, so we just allocate  
          * enough for the requested size plus the trailing null byte.  In the  
          * second case, we are growing the buffer incrementally, so we need  
          * behavior similar to Tcl_DStringAppend.  The requested length will  
          * usually be a small delta above the current spaceAvl, so we'll end up  
          * doubling the old size.  This won't grow the buffer quite as quickly,  
          * but it should be close enough.  
          */  
   
         newsize = dsPtr->spaceAvl * 2;  
         if (length < newsize) {  
             dsPtr->spaceAvl = newsize;  
         } else {  
             dsPtr->spaceAvl = length + 1;  
         }  
         if (dsPtr->string == dsPtr->staticSpace) {  
             char *newString;  
   
             newString = (char *) ckalloc((unsigned) dsPtr->spaceAvl);  
             memcpy((VOID *) newString, (VOID *) dsPtr->string,  
                     (size_t) dsPtr->length);  
             dsPtr->string = newString;  
         } else {  
             dsPtr->string = (char *) ckrealloc((VOID *) dsPtr->string,  
                     (size_t) dsPtr->spaceAvl);  
         }  
     }  
     dsPtr->length = length;  
     dsPtr->string[length] = 0;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_DStringFree --  
  *  
  *      Frees up any memory allocated for the dynamic string and  
  *      reinitializes the string to an empty state.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      The previous contents of the dynamic string are lost, and  
  *      the new value is an empty string.  
  *  
  *---------------------------------------------------------------------- */  
   
 void  
 Tcl_DStringFree(dsPtr)  
     Tcl_DString *dsPtr;         /* Structure describing dynamic string. */  
 {  
     if (dsPtr->string != dsPtr->staticSpace) {  
         ckfree(dsPtr->string);  
     }  
     dsPtr->string = dsPtr->staticSpace;  
     dsPtr->length = 0;  
     dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;  
     dsPtr->staticSpace[0] = '\0';  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_DStringResult --  
  *  
  *      This procedure moves the value of a dynamic string into an  
  *      interpreter as its string result. Afterwards, the dynamic string  
  *      is reset to an empty string.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      The string is "moved" to interp's result, and any existing  
  *      string result for interp is freed. dsPtr is reinitialized to  
  *      an empty string.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 void  
 Tcl_DStringResult(interp, dsPtr)  
     Tcl_Interp *interp;         /* Interpreter whose result is to be reset. */  
     Tcl_DString *dsPtr;         /* Dynamic string that is to become the  
                                  * result of interp. */  
 {  
     Tcl_ResetResult(interp);  
       
     if (dsPtr->string != dsPtr->staticSpace) {  
         interp->result = dsPtr->string;  
         interp->freeProc = TCL_DYNAMIC;  
     } else if (dsPtr->length < TCL_RESULT_SIZE) {  
         interp->result = ((Interp *) interp)->resultSpace;  
         strcpy(interp->result, dsPtr->string);  
     } else {  
         Tcl_SetResult(interp, dsPtr->string, TCL_VOLATILE);  
     }  
       
     dsPtr->string = dsPtr->staticSpace;  
     dsPtr->length = 0;  
     dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;  
     dsPtr->staticSpace[0] = '\0';  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_DStringGetResult --  
  *  
  *      This procedure moves an interpreter's result into a dynamic string.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      The interpreter's string result is cleared, and the previous  
  *      contents of dsPtr are freed.  
  *  
  *      If the string result is empty, the object result is moved to the  
  *      string result, then the object result is reset.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 void  
 Tcl_DStringGetResult(interp, dsPtr)  
     Tcl_Interp *interp;         /* Interpreter whose result is to be reset. */  
     Tcl_DString *dsPtr;         /* Dynamic string that is to become the  
                                  * result of interp. */  
 {  
     Interp *iPtr = (Interp *) interp;  
       
     if (dsPtr->string != dsPtr->staticSpace) {  
         ckfree(dsPtr->string);  
     }  
   
     /*  
      * If the string result is empty, move the object result to the  
      * string result, then reset the object result.  
      */  
   
     if (*(iPtr->result) == 0) {  
         Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),  
                 TCL_VOLATILE);  
     }  
   
     dsPtr->length = strlen(iPtr->result);  
     if (iPtr->freeProc != NULL) {  
         if ((iPtr->freeProc == TCL_DYNAMIC)  
                 || (iPtr->freeProc == (Tcl_FreeProc *) free)) {  
             dsPtr->string = iPtr->result;  
             dsPtr->spaceAvl = dsPtr->length+1;  
         } else {  
             dsPtr->string = (char *) ckalloc((unsigned) (dsPtr->length+1));  
             strcpy(dsPtr->string, iPtr->result);  
             (*iPtr->freeProc)(iPtr->result);  
         }  
         dsPtr->spaceAvl = dsPtr->length+1;  
         iPtr->freeProc = NULL;  
     } else {  
         if (dsPtr->length < TCL_DSTRING_STATIC_SIZE) {  
             dsPtr->string = dsPtr->staticSpace;  
             dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;  
         } else {  
             dsPtr->string = (char *) ckalloc((unsigned) (dsPtr->length + 1));  
             dsPtr->spaceAvl = dsPtr->length + 1;  
         }  
         strcpy(dsPtr->string, iPtr->result);  
     }  
       
     iPtr->result = iPtr->resultSpace;  
     iPtr->resultSpace[0] = 0;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_DStringStartSublist --  
  *  
  *      This procedure adds the necessary information to a dynamic  
  *      string (e.g. " {" to start a sublist.  Future element  
  *      appends will be in the sublist rather than the main list.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      Characters get added to the dynamic string.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 void  
 Tcl_DStringStartSublist(dsPtr)  
     Tcl_DString *dsPtr;                 /* Dynamic string. */  
 {  
     if (TclNeedSpace(dsPtr->string, dsPtr->string + dsPtr->length)) {  
         Tcl_DStringAppend(dsPtr, " {", -1);  
     } else {  
         Tcl_DStringAppend(dsPtr, "{", -1);  
     }  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_DStringEndSublist --  
  *  
  *      This procedure adds the necessary characters to a dynamic  
  *      string to end a sublist (e.g. "}").  Future element appends  
  *      will be in the enclosing (sub)list rather than the current  
  *      sublist.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 void  
 Tcl_DStringEndSublist(dsPtr)  
     Tcl_DString *dsPtr;                 /* Dynamic string. */  
 {  
     Tcl_DStringAppend(dsPtr, "}", -1);  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_PrintDouble --  
  *  
  *      Given a floating-point value, this procedure converts it to  
  *      an ASCII string using.  
  *  
  * Results:  
  *      The ASCII equivalent of "value" is written at "dst".  It is  
  *      written using the current precision, and it is guaranteed to  
  *      contain a decimal point or exponent, so that it looks like  
  *      a floating-point value and not an integer.  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 void  
 Tcl_PrintDouble(interp, value, dst)  
     Tcl_Interp *interp;                 /* Interpreter whose tcl_precision  
                                          * variable used to be used to control  
                                          * printing.  It's ignored now. */  
     double value;                       /* Value to print as string. */  
     char *dst;                          /* Where to store converted value;  
                                          * must have at least TCL_DOUBLE_SPACE  
                                          * characters. */  
 {  
     char *p, c;  
     Tcl_UniChar ch;  
   
     Tcl_MutexLock(&precisionMutex);  
     sprintf(dst, precisionFormat, value);  
     Tcl_MutexUnlock(&precisionMutex);  
   
     /*  
      * If the ASCII result looks like an integer, add ".0" so that it  
      * doesn't look like an integer anymore.  This prevents floating-point  
      * values from being converted to integers unintentionally.  
      */  
   
     for (p = dst; *p != 0; ) {  
         p += Tcl_UtfToUniChar(p, &ch);  
         c = UCHAR(ch);  
         if ((c == '.') || isalpha(UCHAR(c))) {  /* INTL: ISO only. */  
             return;  
         }  
     }  
     p[0] = '.';  
     p[1] = '0';  
     p[2] = 0;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * TclPrecTraceProc --  
  *  
  *      This procedure is invoked whenever the variable "tcl_precision"  
  *      is written.  
  *  
  * Results:  
  *      Returns NULL if all went well, or an error message if the  
  *      new value for the variable doesn't make sense.  
  *  
  * Side effects:  
  *      If the new value doesn't make sense then this procedure  
  *      undoes the effect of the variable modification.  Otherwise  
  *      it modifies the format string that's used by Tcl_PrintDouble.  
  *  
  *----------------------------------------------------------------------  
  */  
   
         /* ARGSUSED */  
 char *  
 TclPrecTraceProc(clientData, interp, name1, name2, flags)  
     ClientData clientData;      /* Not used. */  
     Tcl_Interp *interp;         /* Interpreter containing variable. */  
     char *name1;                /* Name of variable. */  
     char *name2;                /* Second part of variable name. */  
     int flags;                  /* Information about what happened. */  
 {  
     char *value, *end;  
     int prec;  
   
     /*  
      * If the variable is unset, then recreate the trace.  
      */  
   
     if (flags & TCL_TRACE_UNSETS) {  
         if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) {  
             Tcl_TraceVar2(interp, name1, name2,  
                     TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES  
                     |TCL_TRACE_UNSETS, TclPrecTraceProc, clientData);  
         }  
         return (char *) NULL;  
     }  
   
     /*  
      * When the variable is read, reset its value from our shared  
      * value.  This is needed in case the variable was modified in  
      * some other interpreter so that this interpreter's value is  
      * out of date.  
      */  
   
     Tcl_MutexLock(&precisionMutex);  
   
     if (flags & TCL_TRACE_READS) {  
         Tcl_SetVar2(interp, name1, name2, precisionString,  
                 flags & TCL_GLOBAL_ONLY);  
         Tcl_MutexUnlock(&precisionMutex);  
         return (char *) NULL;  
     }  
   
     /*  
      * The variable is being written.  Check the new value and disallow  
      * it if it isn't reasonable or if this is a safe interpreter (we  
      * don't want safe interpreters messing up the precision of other  
      * interpreters).  
      */  
   
     if (Tcl_IsSafe(interp)) {  
         Tcl_SetVar2(interp, name1, name2, precisionString,  
                 flags & TCL_GLOBAL_ONLY);  
         Tcl_MutexUnlock(&precisionMutex);  
         return "can't modify precision from a safe interpreter";  
     }  
     value = Tcl_GetVar2(interp, name1, name2, flags & TCL_GLOBAL_ONLY);  
     if (value == NULL) {  
         value = "";  
     }  
     prec = strtoul(value, &end, 10);  
     if ((prec <= 0) || (prec > TCL_MAX_PREC) || (prec > 100) ||  
             (end == value) || (*end != 0)) {  
         Tcl_SetVar2(interp, name1, name2, precisionString,  
                 flags & TCL_GLOBAL_ONLY);  
         Tcl_MutexUnlock(&precisionMutex);  
         return "improper value for precision";  
     }  
     TclFormatInt(precisionString, prec);  
     sprintf(precisionFormat, "%%.%dg", prec);  
     Tcl_MutexUnlock(&precisionMutex);  
     return (char *) NULL;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * TclNeedSpace --  
  *  
  *      This procedure checks to see whether it is appropriate to  
  *      add a space before appending a new list element to an  
  *      existing string.  
  *  
  * Results:  
  *      The return value is 1 if a space is appropriate, 0 otherwise.  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 TclNeedSpace(start, end)  
     char *start;                /* First character in string. */  
     char *end;                  /* End of string (place where space will  
                                  * be added, if appropriate). */  
 {  
     /*  
      * A space is needed unless either  
      * (a) we're at the start of the string, or  
      * (b) the trailing characters of the string consist of one or more  
      *     open curly braces preceded by a space or extending back to  
      *     the beginning of the string.  
      * (c) the trailing characters of the string consist of a space  
      *     preceded by a character other than backslash.  
      */  
   
     if (end == start) {  
         return 0;  
     }  
     end--;  
     if (*end != '{') {  
         if (isspace(UCHAR(*end)) /* INTL: ISO space. */  
                 && ((end == start) || (end[-1] != '\\'))) {  
             return 0;  
         }  
         return 1;  
     }  
     do {  
         if (end == start) {  
             return 0;  
         }  
         end--;  
     } while (*end == '{');  
     if (isspace(UCHAR(*end))) { /* INTL: ISO space. */  
         return 0;  
     }  
     return 1;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * TclFormatInt --  
  *  
  *      This procedure formats an integer into a sequence of decimal digit  
  *      characters in a buffer. If the integer is negative, a minus sign is  
  *      inserted at the start of the buffer. A null character is inserted at  
  *      the end of the formatted characters. It is the caller's  
  *      responsibility to ensure that enough storage is available. This  
  *      procedure has the effect of sprintf(buffer, "%d", n) but is faster.  
  *  
  * Results:  
  *      An integer representing the number of characters formatted, not  
  *      including the terminating \0.  
  *  
  * Side effects:  
  *      The formatted characters are written into the storage pointer to  
  *      by the "buffer" argument.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 TclFormatInt(buffer, n)  
     char *buffer;               /* Points to the storage into which the  
                                  * formatted characters are written. */  
     long n;                     /* The integer to format. */  
 {  
     long intVal;  
     int i;  
     int numFormatted, j;  
     char *digits = "0123456789";  
   
     /*  
      * Check first whether "n" is zero.  
      */  
   
     if (n == 0) {  
         buffer[0] = '0';  
         buffer[1] = 0;  
         return 1;  
     }  
   
     /*  
      * Check whether "n" is the maximum negative value. This is  
      * -2^(m-1) for an m-bit word, and has no positive equivalent;  
      * negating it produces the same value.  
      */  
   
     if (n == -n) {  
         sprintf(buffer, "%ld", n);  
         return strlen(buffer);  
     }  
   
     /*  
      * Generate the characters of the result backwards in the buffer.  
      */  
   
     intVal = (n < 0? -n : n);  
     i = 0;  
     buffer[0] = '\0';  
     do {  
         i++;  
         buffer[i] = digits[intVal % 10];  
         intVal = intVal/10;  
     } while (intVal > 0);  
     if (n < 0) {  
         i++;  
         buffer[i] = '-';  
     }  
     numFormatted = i;  
   
     /*  
      * Now reverse the characters.  
      */  
   
     for (j = 0;  j < i;  j++, i--) {  
         char tmp = buffer[i];  
         buffer[i] = buffer[j];  
         buffer[j] = tmp;  
     }  
     return numFormatted;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * TclLooksLikeInt --  
  *  
  *      This procedure decides whether the leading characters of a  
  *      string look like an integer or something else (such as a  
  *      floating-point number or string).  
  *  
  * Results:  
  *      The return value is 1 if the leading characters of p look  
  *      like a valid Tcl integer.  If they look like a floating-point  
  *      number (e.g. "e01" or "2.4"), or if they don't look like a  
  *      number at all, then 0 is returned.  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 TclLooksLikeInt(bytes, length)  
     register char *bytes;       /* Points to first byte of the string. */  
     int length;                 /* Number of bytes in the string. If < 0  
                                  * bytes up to the first null byte are  
                                  * considered (if they may appear in an  
                                  * integer). */  
 {  
     register char *p, *end;  
   
     if (length < 0) {  
         length = (bytes? strlen(bytes) : 0);  
     }  
     end = (bytes + length);  
   
     p = bytes;  
     while ((p < end) && isspace(UCHAR(*p))) { /* INTL: ISO space. */  
         p++;  
     }  
     if (p == end) {  
         return 0;  
     }  
       
     if ((*p == '+') || (*p == '-')) {  
         p++;  
     }  
     if ((p == end) || !isdigit(UCHAR(*p))) { /* INTL: digit */  
         return 0;  
     }  
     p++;  
     while ((p < end) && isdigit(UCHAR(*p))) { /* INTL: digit */  
         p++;  
     }  
     if (p == end) {  
         return 1;  
     }  
     if ((*p != '.') && (*p != 'e') && (*p != 'E')) {  
         return 1;  
     }  
     return 0;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * TclGetIntForIndex --  
  *  
  *      This procedure returns an integer corresponding to the list index  
  *      held in a Tcl object. The Tcl object's value is expected to be  
  *      either an integer or a string of the form "end([+-]integer)?".  
  *  
  * Results:  
  *      The return value is normally TCL_OK, which means that the index was  
  *      successfully stored into the location referenced by "indexPtr".  If  
  *      the Tcl object referenced by "objPtr" has the value "end", the  
  *      value stored is "endValue". If "objPtr"s values is not of the form  
  *      "end([+-]integer)?" and  
  *      can not be converted to an integer, TCL_ERROR is returned and, if  
  *      "interp" is non-NULL, an error message is left in the interpreter's  
  *      result object.  
  *  
  * Side effects:  
  *      The object referenced by "objPtr" might be converted to an  
  *      integer object.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 TclGetIntForIndex(interp, objPtr, endValue, indexPtr)  
     Tcl_Interp *interp;         /* Interpreter to use for error reporting.  
                                  * If NULL, then no error message is left  
                                  * after errors. */  
     Tcl_Obj *objPtr;            /* Points to an object containing either  
                                  * "end" or an integer. */  
     int endValue;               /* The value to be stored at "indexPtr" if  
                                  * "objPtr" holds "end". */  
     int *indexPtr;              /* Location filled in with an integer  
                                  * representing an index. */  
 {  
     char *bytes;  
     int length, offset;  
   
     if (objPtr->typePtr == &tclIntType) {  
         *indexPtr = (int)objPtr->internalRep.longValue;  
         return TCL_OK;  
     }  
   
     bytes = Tcl_GetStringFromObj(objPtr, &length);  
   
     if ((*bytes != 'e') || (strncmp(bytes, "end",  
             (size_t)((length > 3) ? 3 : length)) != 0)) {  
         if (Tcl_GetIntFromObj(NULL, objPtr, &offset) != TCL_OK) {  
             goto intforindex_error;  
         }  
         *indexPtr = offset;  
         return TCL_OK;  
     }  
   
     if (length <= 3) {  
         *indexPtr = endValue;  
     } else if (bytes[3] == '-') {  
         /*  
          * This is our limited string expression evaluator  
          */  
         if (Tcl_GetInt(interp, bytes+3, &offset) != TCL_OK) {  
             return TCL_ERROR;  
         }  
         *indexPtr = endValue + offset;  
     } else {  
         intforindex_error:  
         if ((Interp *)interp != NULL) {  
             Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),  
                     "bad index \"", bytes,  
                     "\": must be integer or end?-integer?", (char *) NULL);  
             TclCheckBadOctal(interp, bytes);  
         }  
         return TCL_ERROR;  
     }  
     return TCL_OK;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * TclCheckBadOctal --  
  *  
  *      This procedure checks for a bad octal value and appends a  
  *      meaningful error to the interp's result.  
  *  
  * Results:  
  *      1 if the argument was a bad octal, else 0.  
  *  
  * Side effects:  
  *      The interpreter's result is modified.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 TclCheckBadOctal(interp, value)  
     Tcl_Interp *interp;         /* Interpreter to use for error reporting.  
                                  * If NULL, then no error message is left  
                                  * after errors. */  
     char *value;                /* String to check. */  
 {  
     register char *p = value;  
   
     /*  
      * A frequent mistake is invalid octal values due to an unwanted  
      * leading zero. Try to generate a meaningful error message.  
      */  
   
     while (isspace(UCHAR(*p))) {        /* INTL: ISO space. */  
         p++;  
     }  
     if (*p == '+' || *p == '-') {  
         p++;  
     }  
     if (*p == '0') {  
         while (isdigit(UCHAR(*p))) {    /* INTL: digit. */  
             p++;  
         }  
         while (isspace(UCHAR(*p))) {    /* INTL: ISO space. */  
             p++;  
         }  
         if (*p == '\0') {  
             /* Reached end of string */  
             if (interp != NULL) {  
                 Tcl_AppendResult(interp, " (looks like invalid octal number)",  
                         (char *) NULL);  
             }  
             return 1;  
         }  
     }  
     return 0;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_GetNameOfExecutable --  
  *  
  *      This procedure simply returns a pointer to the internal full  
  *      path name of the executable file as computed by  
  *      Tcl_FindExecutable.  This procedure call is the C API  
  *      equivalent to the "info nameofexecutable" command.  
  *  
  * Results:  
  *      A pointer to the internal string or NULL if the internal full  
  *      path name has not been computed or unknown.  
  *  
  * Side effects:  
  *      The object referenced by "objPtr" might be converted to an  
  *      integer object.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 CONST char *  
 Tcl_GetNameOfExecutable()  
 {  
     return (tclExecutableName);  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_GetCwd --  
  *  
  *      This function replaces the library version of getcwd().  
  *  
  * Results:  
  *      The result is a pointer to a string specifying the current  
  *      directory, or NULL if the current directory could not be  
  *      determined.  If NULL is returned, an error message is left in the  
  *      interp's result.  Storage for the result string is allocated in  
  *      bufferPtr; the caller must call Tcl_DStringFree() when the result  
  *      is no longer needed.  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 char *  
 Tcl_GetCwd(interp, cwdPtr)  
     Tcl_Interp *interp;  
     Tcl_DString *cwdPtr;  
 {  
     return TclpGetCwd(interp, cwdPtr);  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_Chdir --  
  *  
  *      This function replaces the library version of chdir().  
  *  
  * Results:  
  *      See chdir() documentation.  
  *  
  * Side effects:  
  *      See chdir() documentation.    
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 Tcl_Chdir(dirName)  
     CONST char *dirName;  
 {  
     return TclpChdir(dirName);  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_Access --  
  *  
  *      This function replaces the library version of access().  
  *  
  * Results:  
  *      See access() documentation.  
  *  
  * Side effects:  
  *      See access() documentation.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 Tcl_Access(path, mode)  
     CONST char *path;           /* Path of file to access (UTF-8). */  
     int mode;                   /* Permission setting. */  
 {  
     return TclAccess(path, mode);  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_Stat --  
  *  
  *      This function replaces the library version of stat().  
  *  
  * Results:  
  *      See stat() documentation.  
  *  
  * Side effects:  
  *      See stat() documentation.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 Tcl_Stat(path, bufPtr)  
     CONST char *path;           /* Path of file to stat (in UTF-8). */  
     struct stat *bufPtr;        /* Filled with results of stat call. */  
 {  
     return TclStat(path, bufPtr);  
 }  
   
   
 /* $History: tclutil.c $  
  *  
  * *****************  Version 1  *****************  
  * User: Dtashley     Date: 1/02/01    Time: 12:50a  
  * Created in $/IjuScripter, IjuConsole/Source/Tcl Base  
  * Initial check-in.  
  */  
   
 /* End of TCLUTIL.C */  
1    /* $Header$ */
2    /*
3     * tclUtil.c --
4     *
5     *      This file contains utility procedures that are used by many Tcl
6     *      commands.
7     *
8     * Copyright (c) 1987-1993 The Regents of the University of California.
9     * Copyright (c) 1994-1998 Sun Microsystems, Inc.
10     *
11     * See the file "license.terms" for information on usage and redistribution
12     * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
13     *
14     *  RCS: @(#) $Id: tclutil.c,v 1.1.1.1 2001/06/13 04:47:21 dtashley Exp $
15     */
16    
17    #include "tclInt.h"
18    #include "tclPort.h"
19    
20    /*
21     * The following variable holds the full path name of the binary
22     * from which this application was executed, or NULL if it isn't
23     * know.  The value of the variable is set by the procedure
24     * Tcl_FindExecutable.  The storage space is dynamically allocated.
25     */
26    
27    char *tclExecutableName = NULL;
28    char *tclNativeExecutableName = NULL;
29    
30    /*
31     * The following values are used in the flags returned by Tcl_ScanElement
32     * and used by Tcl_ConvertElement.  The value TCL_DONT_USE_BRACES is also
33     * defined in tcl.h;  make sure its value doesn't overlap with any of the
34     * values below.
35     *
36     * TCL_DONT_USE_BRACES -        1 means the string mustn't be enclosed in
37     *                              braces (e.g. it contains unmatched braces,
38     *                              or ends in a backslash character, or user
39     *                              just doesn't want braces);  handle all
40     *                              special characters by adding backslashes.
41     * USE_BRACES -                 1 means the string contains a special
42     *                              character that can be handled simply by
43     *                              enclosing the entire argument in braces.
44     * BRACES_UNMATCHED -           1 means that braces aren't properly matched
45     *                              in the argument.
46     */
47    
48    #define USE_BRACES              2
49    #define BRACES_UNMATCHED        4
50    
51    /*
52     * The following values determine the precision used when converting
53     * floating-point values to strings.  This information is linked to all
54     * of the tcl_precision variables in all interpreters via the procedure
55     * TclPrecTraceProc.
56     */
57    
58    static char precisionString[10] = "12";
59                                    /* The string value of all the tcl_precision
60                                     * variables. */
61    static char precisionFormat[10] = "%.12g";
62                                    /* The format string actually used in calls
63                                     * to sprintf. */
64    TCL_DECLARE_MUTEX(precisionMutex)
65    
66    
67    /*
68     *----------------------------------------------------------------------
69     *
70     * TclFindElement --
71     *
72     *      Given a pointer into a Tcl list, locate the first (or next)
73     *      element in the list.
74     *
75     * Results:
76     *      The return value is normally TCL_OK, which means that the
77     *      element was successfully located.  If TCL_ERROR is returned
78     *      it means that list didn't have proper list structure;
79     *      the interp's result contains a more detailed error message.
80     *
81     *      If TCL_OK is returned, then *elementPtr will be set to point to the
82     *      first element of list, and *nextPtr will be set to point to the
83     *      character just after any white space following the last character
84     *      that's part of the element. If this is the last argument in the
85     *      list, then *nextPtr will point just after the last character in the
86     *      list (i.e., at the character at list+listLength). If sizePtr is
87     *      non-NULL, *sizePtr is filled in with the number of characters in the
88     *      element.  If the element is in braces, then *elementPtr will point
89     *      to the character after the opening brace and *sizePtr will not
90     *      include either of the braces. If there isn't an element in the list,
91     *      *sizePtr will be zero, and both *elementPtr and *termPtr will point
92     *      just after the last character in the list. Note: this procedure does
93     *      NOT collapse backslash sequences.
94     *
95     * Side effects:
96     *      None.
97     *
98     *----------------------------------------------------------------------
99     */
100    
101    int
102    TclFindElement(interp, list, listLength, elementPtr, nextPtr, sizePtr,
103                   bracePtr)
104        Tcl_Interp *interp;         /* Interpreter to use for error reporting.
105                                     * If NULL, then no error message is left
106                                     * after errors. */
107        CONST char *list;           /* Points to the first byte of a string
108                                     * containing a Tcl list with zero or more
109                                     * elements (possibly in braces). */
110        int listLength;             /* Number of bytes in the list's string. */
111        CONST char **elementPtr;    /* Where to put address of first significant
112                                     * character in first element of list. */
113        CONST char **nextPtr;       /* Fill in with location of character just
114                                     * after all white space following end of
115                                     * argument (next arg or end of list). */
116        int *sizePtr;               /* If non-zero, fill in with size of
117                                     * element. */
118        int *bracePtr;              /* If non-zero, fill in with non-zero/zero
119                                     * to indicate that arg was/wasn't
120                                     * in braces. */
121    {
122        CONST char *p = list;
123        CONST char *elemStart;      /* Points to first byte of first element. */
124        CONST char *limit;          /* Points just after list's last byte. */
125        int openBraces = 0;         /* Brace nesting level during parse. */
126        int inQuotes = 0;
127        int size = 0;               /* lint. */
128        int numChars;
129        CONST char *p2;
130        
131        /*
132         * Skim off leading white space and check for an opening brace or
133         * quote. We treat embedded NULLs in the list as bytes belonging to
134         * a list element.
135         */
136    
137        limit = (list + listLength);
138        while ((p < limit) && (isspace(UCHAR(*p)))) { /* INTL: ISO space. */
139            p++;
140        }
141        if (p == limit) {           /* no element found */
142            elemStart = limit;
143            goto done;
144        }
145    
146        if (*p == '{') {
147            openBraces = 1;
148            p++;
149        } else if (*p == '"') {
150            inQuotes = 1;
151            p++;
152        }
153        elemStart = p;
154        if (bracePtr != 0) {
155            *bracePtr = openBraces;
156        }
157    
158        /*
159         * Find element's end (a space, close brace, or the end of the string).
160         */
161    
162        while (p < limit) {
163            switch (*p) {
164    
165                /*
166                 * Open brace: don't treat specially unless the element is in
167                 * braces. In this case, keep a nesting count.
168                 */
169    
170                case '{':
171                    if (openBraces != 0) {
172                        openBraces++;
173                    }
174                    break;
175    
176                /*
177                 * Close brace: if element is in braces, keep nesting count and
178                 * quit when the last close brace is seen.
179                 */
180    
181                case '}':
182                    if (openBraces > 1) {
183                        openBraces--;
184                    } else if (openBraces == 1) {
185                        size = (p - elemStart);
186                        p++;
187                        if ((p >= limit)
188                                || isspace(UCHAR(*p))) { /* INTL: ISO space. */
189                            goto done;
190                        }
191    
192                        /*
193                         * Garbage after the closing brace; return an error.
194                         */
195                        
196                        if (interp != NULL) {
197                            char buf[100];
198                            
199                            p2 = p;
200                            while ((p2 < limit)
201                                    && (!isspace(UCHAR(*p2))) /* INTL: ISO space. */
202                                    && (p2 < p+20)) {
203                                p2++;
204                            }
205                            sprintf(buf,
206                                    "list element in braces followed by \"%.*s\" instead of space",
207                                    (int) (p2-p), p);
208                            Tcl_SetResult(interp, buf, TCL_VOLATILE);
209                        }
210                        return TCL_ERROR;
211                    }
212                    break;
213    
214                /*
215                 * Backslash:  skip over everything up to the end of the
216                 * backslash sequence.
217                 */
218    
219                case '\\': {
220                    Tcl_UtfBackslash(p, &numChars, NULL);
221                    p += (numChars - 1);
222                    break;
223                }
224    
225                /*
226                 * Space: ignore if element is in braces or quotes; otherwise
227                 * terminate element.
228                 */
229    
230                case ' ':
231                case '\f':
232                case '\n':
233                case '\r':
234                case '\t':
235                case '\v':
236                    if ((openBraces == 0) && !inQuotes) {
237                        size = (p - elemStart);
238                        goto done;
239                    }
240                    break;
241    
242                /*
243                 * Double-quote: if element is in quotes then terminate it.
244                 */
245    
246                case '"':
247                    if (inQuotes) {
248                        size = (p - elemStart);
249                        p++;
250                        if ((p >= limit)
251                                || isspace(UCHAR(*p))) { /* INTL: ISO space */
252                            goto done;
253                        }
254    
255                        /*
256                         * Garbage after the closing quote; return an error.
257                         */
258                        
259                        if (interp != NULL) {
260                            char buf[100];
261                            
262                            p2 = p;
263                            while ((p2 < limit)
264                                    && (!isspace(UCHAR(*p2))) /* INTL: ISO space */
265                                     && (p2 < p+20)) {
266                                p2++;
267                            }
268                            sprintf(buf,
269                                    "list element in quotes followed by \"%.*s\" %s",
270                                    (int) (p2-p), p, "instead of space");
271                            Tcl_SetResult(interp, buf, TCL_VOLATILE);
272                        }
273                        return TCL_ERROR;
274                    }
275                    break;
276            }
277            p++;
278        }
279    
280    
281        /*
282         * End of list: terminate element.
283         */
284    
285        if (p == limit) {
286            if (openBraces != 0) {
287                if (interp != NULL) {
288                    Tcl_SetResult(interp, "unmatched open brace in list",
289                            TCL_STATIC);
290                }
291                return TCL_ERROR;
292            } else if (inQuotes) {
293                if (interp != NULL) {
294                    Tcl_SetResult(interp, "unmatched open quote in list",
295                            TCL_STATIC);
296                }
297                return TCL_ERROR;
298            }
299            size = (p - elemStart);
300        }
301    
302        done:
303        while ((p < limit) && (isspace(UCHAR(*p)))) { /* INTL: ISO space. */
304            p++;
305        }
306        *elementPtr = elemStart;
307        *nextPtr = p;
308        if (sizePtr != 0) {
309            *sizePtr = size;
310        }
311        return TCL_OK;
312    }
313    
314    /*
315     *----------------------------------------------------------------------
316     *
317     * TclCopyAndCollapse --
318     *
319     *      Copy a string and eliminate any backslashes that aren't in braces.
320     *
321     * Results:
322     *      There is no return value. Count characters get copied from src to
323     *      dst. Along the way, if backslash sequences are found outside braces,
324     *      the backslashes are eliminated in the copy. After scanning count
325     *      chars from source, a null character is placed at the end of dst.
326     *      Returns the number of characters that got copied.
327     *
328     * Side effects:
329     *      None.
330     *
331     *----------------------------------------------------------------------
332     */
333    
334    int
335    TclCopyAndCollapse(count, src, dst)
336        int count;                  /* Number of characters to copy from src. */
337        CONST char *src;            /* Copy from here... */
338        char *dst;                  /* ... to here. */
339    {
340        register char c;
341        int numRead;
342        int newCount = 0;
343        int backslashCount;
344    
345        for (c = *src;  count > 0;  src++, c = *src, count--) {
346            if (c == '\\') {
347                backslashCount = Tcl_UtfBackslash(src, &numRead, dst);
348                dst += backslashCount;
349                newCount += backslashCount;
350                src += numRead-1;
351                count -= numRead-1;
352            } else {
353                *dst = c;
354                dst++;
355                newCount++;
356            }
357        }
358        *dst = 0;
359        return newCount;
360    }
361    
362    /*
363     *----------------------------------------------------------------------
364     *
365     * Tcl_SplitList --
366     *
367     *      Splits a list up into its constituent fields.
368     *
369     * Results
370     *      The return value is normally TCL_OK, which means that
371     *      the list was successfully split up.  If TCL_ERROR is
372     *      returned, it means that "list" didn't have proper list
373     *      structure;  the interp's result will contain a more detailed
374     *      error message.
375     *
376     *      *argvPtr will be filled in with the address of an array
377     *      whose elements point to the elements of list, in order.
378     *      *argcPtr will get filled in with the number of valid elements
379     *      in the array.  A single block of memory is dynamically allocated
380     *      to hold both the argv array and a copy of the list (with
381     *      backslashes and braces removed in the standard way).
382     *      The caller must eventually free this memory by calling free()
383     *      on *argvPtr.  Note:  *argvPtr and *argcPtr are only modified
384     *      if the procedure returns normally.
385     *
386     * Side effects:
387     *      Memory is allocated.
388     *
389     *----------------------------------------------------------------------
390     */
391    
392    int
393    Tcl_SplitList(interp, list, argcPtr, argvPtr)
394        Tcl_Interp *interp;         /* Interpreter to use for error reporting.
395                                     * If NULL, no error message is left. */
396        CONST char *list;           /* Pointer to string with list structure. */
397        int *argcPtr;               /* Pointer to location to fill in with
398                                     * the number of elements in the list. */
399        char ***argvPtr;            /* Pointer to place to store pointer to
400                                     * array of pointers to list elements. */
401    {
402        char **argv;
403        CONST char *l;
404        char *p;
405        int length, size, i, result, elSize, brace;
406        CONST char *element;
407    
408        /*
409         * Figure out how much space to allocate.  There must be enough
410         * space for both the array of pointers and also for a copy of
411         * the list.  To estimate the number of pointers needed, count
412         * the number of space characters in the list.
413         */
414    
415        for (size = 1, l = list; *l != 0; l++) {
416            if (isspace(UCHAR(*l))) { /* INTL: ISO space. */
417                size++;
418            }
419        }
420        size++;                     /* Leave space for final NULL pointer. */
421        argv = (char **) ckalloc((unsigned)
422                ((size * sizeof(char *)) + (l - list) + 1));
423        length = strlen(list);
424        for (i = 0, p = ((char *) argv) + size*sizeof(char *);
425                *list != 0;  i++) {
426            CONST char *prevList = list;
427            
428            result = TclFindElement(interp, list, length, &element,
429                                    &list, &elSize, &brace);
430            length -= (list - prevList);
431            if (result != TCL_OK) {
432                ckfree((char *) argv);
433                return result;
434            }
435            if (*element == 0) {
436                break;
437            }
438            if (i >= size) {
439                ckfree((char *) argv);
440                if (interp != NULL) {
441                    Tcl_SetResult(interp, "internal error in Tcl_SplitList",
442                            TCL_STATIC);
443                }
444                return TCL_ERROR;
445            }
446            argv[i] = p;
447            if (brace) {
448                memcpy((VOID *) p, (VOID *) element, (size_t) elSize);
449                p += elSize;
450                *p = 0;
451                p++;
452            } else {
453                TclCopyAndCollapse(elSize, element, p);
454                p += elSize+1;
455            }
456        }
457    
458        argv[i] = NULL;
459        *argvPtr = argv;
460        *argcPtr = i;
461        return TCL_OK;
462    }
463    
464    /*
465     *----------------------------------------------------------------------
466     *
467     * Tcl_ScanElement --
468     *
469     *      This procedure is a companion procedure to Tcl_ConvertElement.
470     *      It scans a string to see what needs to be done to it (e.g. add
471     *      backslashes or enclosing braces) to make the string into a
472     *      valid Tcl list element.
473     *
474     * Results:
475     *      The return value is an overestimate of the number of characters
476     *      that will be needed by Tcl_ConvertElement to produce a valid
477     *      list element from string.  The word at *flagPtr is filled in
478     *      with a value needed by Tcl_ConvertElement when doing the actual
479     *      conversion.
480     *
481     * Side effects:
482     *      None.
483     *
484     *----------------------------------------------------------------------
485     */
486    
487    int
488    Tcl_ScanElement(string, flagPtr)
489        register CONST char *string; /* String to convert to list element. */
490        register int *flagPtr;       /* Where to store information to guide
491                                      * Tcl_ConvertCountedElement. */
492    {
493        return Tcl_ScanCountedElement(string, -1, flagPtr);
494    }
495    
496    /*
497     *----------------------------------------------------------------------
498     *
499     * Tcl_ScanCountedElement --
500     *
501     *      This procedure is a companion procedure to
502     *      Tcl_ConvertCountedElement.  It scans a string to see what
503     *      needs to be done to it (e.g. add backslashes or enclosing
504     *      braces) to make the string into a valid Tcl list element.
505     *      If length is -1, then the string is scanned up to the first
506     *      null byte.
507     *
508     * Results:
509     *      The return value is an overestimate of the number of characters
510     *      that will be needed by Tcl_ConvertCountedElement to produce a
511     *      valid list element from string.  The word at *flagPtr is
512     *      filled in with a value needed by Tcl_ConvertCountedElement
513     *      when doing the actual conversion.
514     *
515     * Side effects:
516     *      None.
517     *
518     *----------------------------------------------------------------------
519     */
520    
521    int
522    Tcl_ScanCountedElement(string, length, flagPtr)
523        CONST char *string;         /* String to convert to Tcl list element. */
524        int length;                 /* Number of bytes in string, or -1. */
525        int *flagPtr;               /* Where to store information to guide
526                                     * Tcl_ConvertElement. */
527    {
528        int flags, nestingLevel;
529        register CONST char *p, *lastChar;
530    
531        /*
532         * This procedure and Tcl_ConvertElement together do two things:
533         *
534         * 1. They produce a proper list, one that will yield back the
535         * argument strings when evaluated or when disassembled with
536         * Tcl_SplitList.  This is the most important thing.
537         *
538         * 2. They try to produce legible output, which means minimizing the
539         * use of backslashes (using braces instead).  However, there are
540         * some situations where backslashes must be used (e.g. an element
541         * like "{abc": the leading brace will have to be backslashed.
542         * For each element, one of three things must be done:
543         *
544         * (a) Use the element as-is (it doesn't contain any special
545         * characters).  This is the most desirable option.
546         *
547         * (b) Enclose the element in braces, but leave the contents alone.
548         * This happens if the element contains embedded space, or if it
549         * contains characters with special interpretation ($, [, ;, or \),
550         * or if it starts with a brace or double-quote, or if there are
551         * no characters in the element.
552         *
553         * (c) Don't enclose the element in braces, but add backslashes to
554         * prevent special interpretation of special characters.  This is a
555         * last resort used when the argument would normally fall under case
556         * (b) but contains unmatched braces.  It also occurs if the last
557         * character of the argument is a backslash or if the element contains
558         * a backslash followed by newline.
559         *
560         * The procedure figures out how many bytes will be needed to store
561         * the result (actually, it overestimates). It also collects information
562         * about the element in the form of a flags word.
563         *
564         * Note: list elements produced by this procedure and
565         * Tcl_ConvertCountedElement must have the property that they can be
566         * enclosing in curly braces to make sub-lists.  This means, for
567         * example, that we must not leave unmatched curly braces in the
568         * resulting list element.  This property is necessary in order for
569         * procedures like Tcl_DStringStartSublist to work.
570         */
571    
572        nestingLevel = 0;
573        flags = 0;
574        if (string == NULL) {
575            string = "";
576        }
577        if (length == -1) {
578            length = strlen(string);
579        }
580        lastChar = string + length;
581        p = string;
582        if ((p == lastChar) || (*p == '{') || (*p == '"')) {
583            flags |= USE_BRACES;
584        }
585        for ( ; p < lastChar; p++) {
586            switch (*p) {
587                case '{':
588                    nestingLevel++;
589                    break;
590                case '}':
591                    nestingLevel--;
592                    if (nestingLevel < 0) {
593                        flags |= TCL_DONT_USE_BRACES|BRACES_UNMATCHED;
594                    }
595                    break;
596                case '[':
597                case '$':
598                case ';':
599                case ' ':
600                case '\f':
601                case '\n':
602                case '\r':
603                case '\t':
604                case '\v':
605                    flags |= USE_BRACES;
606                    break;
607                case '\\':
608                    if ((p+1 == lastChar) || (p[1] == '\n')) {
609                        flags = TCL_DONT_USE_BRACES | BRACES_UNMATCHED;
610                    } else {
611                        int size;
612    
613                        Tcl_UtfBackslash(p, &size, NULL);
614                        p += size-1;
615                        flags |= USE_BRACES;
616                    }
617                    break;
618            }
619        }
620        if (nestingLevel != 0) {
621            flags = TCL_DONT_USE_BRACES | BRACES_UNMATCHED;
622        }
623        *flagPtr = flags;
624    
625        /*
626         * Allow enough space to backslash every character plus leave
627         * two spaces for braces.
628         */
629    
630        return 2*(p-string) + 2;
631    }
632    
633    /*
634     *----------------------------------------------------------------------
635     *
636     * Tcl_ConvertElement --
637     *
638     *      This is a companion procedure to Tcl_ScanElement.  Given
639     *      the information produced by Tcl_ScanElement, this procedure
640     *      converts a string to a list element equal to that string.
641     *
642     * Results:
643     *      Information is copied to *dst in the form of a list element
644     *      identical to src (i.e. if Tcl_SplitList is applied to dst it
645     *      will produce a string identical to src).  The return value is
646     *      a count of the number of characters copied (not including the
647     *      terminating NULL character).
648     *
649     * Side effects:
650     *      None.
651     *
652     *----------------------------------------------------------------------
653     */
654    
655    int
656    Tcl_ConvertElement(src, dst, flags)
657        register CONST char *src;   /* Source information for list element. */
658        register char *dst;         /* Place to put list-ified element. */
659        register int flags;         /* Flags produced by Tcl_ScanElement. */
660    {
661        return Tcl_ConvertCountedElement(src, -1, dst, flags);
662    }
663    
664    /*
665     *----------------------------------------------------------------------
666     *
667     * Tcl_ConvertCountedElement --
668     *
669     *      This is a companion procedure to Tcl_ScanCountedElement.  Given
670     *      the information produced by Tcl_ScanCountedElement, this
671     *      procedure converts a string to a list element equal to that
672     *      string.
673     *
674     * Results:
675     *      Information is copied to *dst in the form of a list element
676     *      identical to src (i.e. if Tcl_SplitList is applied to dst it
677     *      will produce a string identical to src).  The return value is
678     *      a count of the number of characters copied (not including the
679     *      terminating NULL character).
680     *
681     * Side effects:
682     *      None.
683     *
684     *----------------------------------------------------------------------
685     */
686    
687    int
688    Tcl_ConvertCountedElement(src, length, dst, flags)
689        register CONST char *src;   /* Source information for list element. */
690        int length;                 /* Number of bytes in src, or -1. */
691        char *dst;                  /* Place to put list-ified element. */
692        int flags;                  /* Flags produced by Tcl_ScanElement. */
693    {
694        register char *p = dst;
695        register CONST char *lastChar;
696    
697        /*
698         * See the comment block at the beginning of the Tcl_ScanElement
699         * code for details of how this works.
700         */
701    
702        if (src && length == -1) {
703            length = strlen(src);
704        }
705        if ((src == NULL) || (length == 0)) {
706            p[0] = '{';
707            p[1] = '}';
708            p[2] = 0;
709            return 2;
710        }
711        lastChar = src + length;
712        if ((flags & USE_BRACES) && !(flags & TCL_DONT_USE_BRACES)) {
713            *p = '{';
714            p++;
715            for ( ; src != lastChar; src++, p++) {
716                *p = *src;
717            }
718            *p = '}';
719            p++;
720        } else {
721            if (*src == '{') {
722                /*
723                 * Can't have a leading brace unless the whole element is
724                 * enclosed in braces.  Add a backslash before the brace.
725                 * Furthermore, this may destroy the balance between open
726                 * and close braces, so set BRACES_UNMATCHED.
727                 */
728    
729                p[0] = '\\';
730                p[1] = '{';
731                p += 2;
732                src++;
733                flags |= BRACES_UNMATCHED;
734            }
735            for (; src != lastChar; src++) {
736                switch (*src) {
737                    case ']':
738                    case '[':
739                    case '$':
740                    case ';':
741                    case ' ':
742                    case '\\':
743                    case '"':
744                        *p = '\\';
745                        p++;
746                        break;
747                    case '{':
748                    case '}':
749                        /*
750                         * It may not seem necessary to backslash braces, but
751                         * it is.  The reason for this is that the resulting
752                         * list element may actually be an element of a sub-list
753                         * enclosed in braces (e.g. if Tcl_DStringStartSublist
754                         * has been invoked), so there may be a brace mismatch
755                         * if the braces aren't backslashed.
756                         */
757    
758                        if (flags & BRACES_UNMATCHED) {
759                            *p = '\\';
760                            p++;
761                        }
762                        break;
763                    case '\f':
764                        *p = '\\';
765                        p++;
766                        *p = 'f';
767                        p++;
768                        continue;
769                    case '\n':
770                        *p = '\\';
771                        p++;
772                        *p = 'n';
773                        p++;
774                        continue;
775                    case '\r':
776                        *p = '\\';
777                        p++;
778                        *p = 'r';
779                        p++;
780                        continue;
781                    case '\t':
782                        *p = '\\';
783                        p++;
784                        *p = 't';
785                        p++;
786                        continue;
787                    case '\v':
788                        *p = '\\';
789                        p++;
790                        *p = 'v';
791                        p++;
792                        continue;
793                }
794                *p = *src;
795                p++;
796            }
797        }
798        *p = '\0';
799        return p-dst;
800    }
801    
802    /*
803     *----------------------------------------------------------------------
804     *
805     * Tcl_Merge --
806     *
807     *      Given a collection of strings, merge them together into a
808     *      single string that has proper Tcl list structured (i.e.
809     *      Tcl_SplitList may be used to retrieve strings equal to the
810     *      original elements, and Tcl_Eval will parse the string back
811     *      into its original elements).
812     *
813     * Results:
814     *      The return value is the address of a dynamically-allocated
815     *      string containing the merged list.
816     *
817     * Side effects:
818     *      None.
819     *
820     *----------------------------------------------------------------------
821     */
822    
823    char *
824    Tcl_Merge(argc, argv)
825        int argc;                   /* How many strings to merge. */
826        char **argv;                /* Array of string values. */
827    {
828    #   define LOCAL_SIZE 20
829        int localFlags[LOCAL_SIZE], *flagPtr;
830        int numChars;
831        char *result;
832        char *dst;
833        int i;
834    
835        /*
836         * Pass 1: estimate space, gather flags.
837         */
838    
839        if (argc <= LOCAL_SIZE) {
840            flagPtr = localFlags;
841        } else {
842            flagPtr = (int *) ckalloc((unsigned) argc*sizeof(int));
843        }
844        numChars = 1;
845        for (i = 0; i < argc; i++) {
846            numChars += Tcl_ScanElement(argv[i], &flagPtr[i]) + 1;
847        }
848    
849        /*
850         * Pass two: copy into the result area.
851         */
852    
853        result = (char *) ckalloc((unsigned) numChars);
854        dst = result;
855        for (i = 0; i < argc; i++) {
856            numChars = Tcl_ConvertElement(argv[i], dst, flagPtr[i]);
857            dst += numChars;
858            *dst = ' ';
859            dst++;
860        }
861        if (dst == result) {
862            *dst = 0;
863        } else {
864            dst[-1] = 0;
865        }
866    
867        if (flagPtr != localFlags) {
868            ckfree((char *) flagPtr);
869        }
870        return result;
871    }
872    
873    /*
874     *----------------------------------------------------------------------
875     *
876     * Tcl_Backslash --
877     *
878     *      Figure out how to handle a backslash sequence.
879     *
880     * Results:
881     *      The return value is the character that should be substituted
882     *      in place of the backslash sequence that starts at src.  If
883     *      readPtr isn't NULL then it is filled in with a count of the
884     *      number of characters in the backslash sequence.
885     *
886     * Side effects:
887     *      None.
888     *
889     *----------------------------------------------------------------------
890     */
891    
892    char
893    Tcl_Backslash(src, readPtr)
894        CONST char *src;            /* Points to the backslash character of
895                                     * a backslash sequence. */
896        int *readPtr;               /* Fill in with number of characters read
897                                     * from src, unless NULL. */
898    {
899        char buf[TCL_UTF_MAX];
900        Tcl_UniChar ch;
901    
902        Tcl_UtfBackslash(src, readPtr, buf);
903        Tcl_UtfToUniChar(buf, &ch);
904        return (char) ch;
905    }
906    
907    /*
908     *----------------------------------------------------------------------
909     *
910     * Tcl_Concat --
911     *
912     *      Concatenate a set of strings into a single large string.
913     *
914     * Results:
915     *      The return value is dynamically-allocated string containing
916     *      a concatenation of all the strings in argv, with spaces between
917     *      the original argv elements.
918     *
919     * Side effects:
920     *      Memory is allocated for the result;  the caller is responsible
921     *      for freeing the memory.
922     *
923     *----------------------------------------------------------------------
924     */
925    
926    char *
927    Tcl_Concat(argc, argv)
928        int argc;                   /* Number of strings to concatenate. */
929        char **argv;                /* Array of strings to concatenate. */
930    {
931        int totalSize, i;
932        char *p;
933        char *result;
934    
935        for (totalSize = 1, i = 0; i < argc; i++) {
936            totalSize += strlen(argv[i]) + 1;
937        }
938        result = (char *) ckalloc((unsigned) totalSize);
939        if (argc == 0) {
940            *result = '\0';
941            return result;
942        }
943        for (p = result, i = 0; i < argc; i++) {
944            char *element;
945            int length;
946    
947            /*
948             * Clip white space off the front and back of the string
949             * to generate a neater result, and ignore any empty
950             * elements.
951             */
952    
953            element = argv[i];
954            while (isspace(UCHAR(*element))) { /* INTL: ISO space. */
955                element++;
956            }
957            for (length = strlen(element);
958                    (length > 0)
959                    && (isspace(UCHAR(element[length-1]))) /* INTL: ISO space. */
960                    && ((length < 2) || (element[length-2] != '\\'));
961                    length--) {
962                /* Null loop body. */
963            }
964            if (length == 0) {
965                continue;
966            }
967            memcpy((VOID *) p, (VOID *) element, (size_t) length);
968            p += length;
969            *p = ' ';
970            p++;
971        }
972        if (p != result) {
973            p[-1] = 0;
974        } else {
975            *p = 0;
976        }
977        return result;
978    }
979    
980    /*
981     *----------------------------------------------------------------------
982     *
983     * Tcl_ConcatObj --
984     *
985     *      Concatenate the strings from a set of objects into a single string
986     *      object with spaces between the original strings.
987     *
988     * Results:
989     *      The return value is a new string object containing a concatenation
990     *      of the strings in objv. Its ref count is zero.
991     *
992     * Side effects:
993     *      A new object is created.
994     *
995     *----------------------------------------------------------------------
996     */
997    
998    Tcl_Obj *
999    Tcl_ConcatObj(objc, objv)
1000        int objc;                   /* Number of objects to concatenate. */
1001        Tcl_Obj *CONST objv[];      /* Array of objects to concatenate. */
1002    {
1003        int allocSize, finalSize, length, elemLength, i;
1004        char *p;
1005        char *element;
1006        char *concatStr;
1007        Tcl_Obj *objPtr;
1008    
1009        /*
1010         * Check first to see if all the items are of list type.  If so,
1011         * we will concat them together as lists, and return a list object.
1012         * This is only valid when the lists have no current string
1013         * representation, since we don't know what the original type was.
1014         * An original string rep may have lost some whitespace info when
1015         * converted which could be important.
1016         */
1017        for (i = 0;  i < objc;  i++) {
1018            objPtr = objv[i];
1019            if ((objPtr->typePtr != &tclListType) || (objPtr->bytes != NULL)) {
1020                break;
1021            }
1022        }
1023        if (i == objc) {
1024            Tcl_Obj **listv;
1025            int listc;
1026    
1027            objPtr = Tcl_NewListObj(0, NULL);
1028            for (i = 0;  i < objc;  i++) {
1029                /*
1030                 * Tcl_ListObjAppendList could be used here, but this saves
1031                 * us a bit of type checking (since we've already done it)
1032                 * Use of INT_MAX tells us to always put the new stuff on
1033                 * the end.  It will be set right in Tcl_ListObjReplace.
1034                 */
1035                Tcl_ListObjGetElements(NULL, objv[i], &listc, &listv);
1036                Tcl_ListObjReplace(NULL, objPtr, INT_MAX, 0, listc, listv);
1037            }
1038            return objPtr;
1039        }
1040    
1041        allocSize = 0;
1042        for (i = 0;  i < objc;  i++) {
1043            objPtr = objv[i];
1044            element = Tcl_GetStringFromObj(objPtr, &length);
1045            if ((element != NULL) && (length > 0)) {
1046                allocSize += (length + 1);
1047            }
1048        }
1049        if (allocSize == 0) {
1050            allocSize = 1;          /* enough for the NULL byte at end */
1051        }
1052    
1053        /*
1054         * Allocate storage for the concatenated result. Note that allocSize
1055         * is one more than the total number of characters, and so includes
1056         * room for the terminating NULL byte.
1057         */
1058        
1059        concatStr = (char *) ckalloc((unsigned) allocSize);
1060    
1061        /*
1062         * Now concatenate the elements. Clip white space off the front and back
1063         * to generate a neater result, and ignore any empty elements. Also put
1064         * a null byte at the end.
1065         */
1066    
1067        finalSize = 0;
1068        if (objc == 0) {
1069            *concatStr = '\0';
1070        } else {
1071            p = concatStr;
1072            for (i = 0;  i < objc;  i++) {
1073                objPtr = objv[i];
1074                element = Tcl_GetStringFromObj(objPtr, &elemLength);
1075                while ((elemLength > 0)
1076                        && (isspace(UCHAR(*element)))) { /* INTL: ISO space. */
1077                     element++;
1078                     elemLength--;
1079                }
1080    
1081                /*
1082                 * Trim trailing white space.  But, be careful not to trim
1083                 * a space character if it is preceded by a backslash: in
1084                 * this case it could be significant.
1085                 */
1086    
1087                while ((elemLength > 0)
1088                        && isspace(UCHAR(element[elemLength-1])) /* INTL: ISO space. */
1089                        && ((elemLength < 2) || (element[elemLength-2] != '\\'))) {
1090                    elemLength--;
1091                }
1092                if (elemLength == 0) {
1093                     continue;      /* nothing left of this element */
1094                }
1095                memcpy((VOID *) p, (VOID *) element, (size_t) elemLength);
1096                p += elemLength;
1097                *p = ' ';
1098                p++;
1099                finalSize += (elemLength + 1);
1100            }
1101            if (p != concatStr) {
1102                p[-1] = 0;
1103                finalSize -= 1;     /* we overwrote the final ' ' */
1104            } else {
1105                *p = 0;
1106            }
1107        }
1108        
1109        TclNewObj(objPtr);
1110        objPtr->bytes  = concatStr;
1111        objPtr->length = finalSize;
1112        return objPtr;
1113    }
1114    
1115    /*
1116     *----------------------------------------------------------------------
1117     *
1118     * Tcl_StringMatch --
1119     *
1120     *      See if a particular string matches a particular pattern.
1121     *
1122     * Results:
1123     *      The return value is 1 if string matches pattern, and
1124     *      0 otherwise.  The matching operation permits the following
1125     *      special characters in the pattern: *?\[] (see the manual
1126     *      entry for details on what these mean).
1127     *
1128     * Side effects:
1129     *      None.
1130     *
1131     *----------------------------------------------------------------------
1132     */
1133    
1134    int
1135    Tcl_StringMatch(string, pattern)
1136        CONST char *string;         /* String. */
1137        CONST char *pattern;        /* Pattern, which may contain special
1138                                     * characters. */
1139    {
1140        int p, s;
1141        CONST char *pstart = pattern;
1142        
1143        while (1) {
1144            p = *pattern;
1145            s = *string;
1146            
1147            /*
1148             * See if we're at the end of both the pattern and the string.  If
1149             * so, we succeeded.  If we're at the end of the pattern but not at
1150             * the end of the string, we failed.
1151             */
1152            
1153            if (p == '\0') {
1154                if (s == '\0') {
1155                    return 1;
1156                } else {
1157                    return 0;
1158                }
1159            }
1160            if ((s == '\0') && (p != '*')) {
1161                return 0;
1162            }
1163    
1164            /* Check for a "*" as the next pattern character.  It matches
1165             * any substring.  We handle this by calling ourselves
1166             * recursively for each postfix of string, until either we
1167             * match or we reach the end of the string.
1168             */
1169            
1170            if (p == '*') {
1171                pattern++;
1172                if (*pattern == '\0') {
1173                    return 1;
1174                }
1175                while (1) {
1176                    if (Tcl_StringMatch(string, pattern)) {
1177                        return 1;
1178                    }
1179                    if (*string == '\0') {
1180                        return 0;
1181                    }
1182                    string++;
1183                }
1184            }
1185    
1186            /* Check for a "?" as the next pattern character.  It matches
1187             * any single character.
1188             */
1189    
1190            if (p == '?') {
1191                Tcl_UniChar ch;
1192                
1193                pattern++;
1194                string += Tcl_UtfToUniChar(string, &ch);
1195                continue;
1196            }
1197    
1198            /* Check for a "[" as the next pattern character.  It is followed
1199             * by a list of characters that are acceptable, or by a range
1200             * (two characters separated by "-").
1201             */
1202            
1203            if (p == '[') {
1204                Tcl_UniChar ch, startChar, endChar;
1205    
1206                pattern++;
1207                string += Tcl_UtfToUniChar(string, &ch);
1208    
1209                while (1) {
1210                    if ((*pattern == ']') || (*pattern == '\0')) {
1211                        return 0;
1212                    }
1213                    pattern += Tcl_UtfToUniChar(pattern, &startChar);
1214                    if (*pattern == '-') {
1215                        pattern++;
1216                        if (*pattern == '\0') {
1217                            return 0;
1218                        }
1219                        pattern += Tcl_UtfToUniChar(pattern, &endChar);
1220                        if (((startChar <= ch) && (ch <= endChar))
1221                                || ((endChar <= ch) && (ch <= startChar))) {
1222                            /*
1223                             * Matches ranges of form [a-z] or [z-a].
1224                             */
1225    
1226                            break;
1227                        }
1228                    } else if (startChar == ch) {
1229                        break;
1230                    }
1231                }
1232                while (*pattern != ']') {
1233                    if (*pattern == '\0') {
1234                        pattern = Tcl_UtfPrev(pattern, pstart);
1235                        break;
1236                    }
1237                    pattern++;
1238                }
1239                pattern++;
1240                continue;
1241            }
1242        
1243            /* If the next pattern character is '\', just strip off the '\'
1244             * so we do exact matching on the character that follows.
1245             */
1246            
1247            if (p == '\\') {
1248                pattern++;
1249                p = *pattern;
1250                if (p == '\0') {
1251                    return 0;
1252                }
1253            }
1254    
1255            /* There's no special character.  Just make sure that the next
1256             * bytes of each string match.
1257             */
1258            
1259            if (s != p) {
1260                return 0;
1261            }
1262            pattern++;
1263            string++;
1264        }
1265    }
1266    
1267    /*
1268     *----------------------------------------------------------------------
1269     *
1270     * Tcl_StringCaseMatch --
1271     *
1272     *      See if a particular string matches a particular pattern.
1273     *      Allows case insensitivity.
1274     *
1275     * Results:
1276     *      The return value is 1 if string matches pattern, and
1277     *      0 otherwise.  The matching operation permits the following
1278     *      special characters in the pattern: *?\[] (see the manual
1279     *      entry for details on what these mean).
1280     *
1281     * Side effects:
1282     *      None.
1283     *
1284     *----------------------------------------------------------------------
1285     */
1286    
1287    int
1288    Tcl_StringCaseMatch(string, pattern, nocase)
1289        CONST char *string;         /* String. */
1290        CONST char *pattern;        /* Pattern, which may contain special
1291                                     * characters. */
1292        int nocase;                 /* 0 for case sensitive, 1 for insensitive */
1293    {
1294        int p, s;
1295        CONST char *pstart = pattern;
1296        Tcl_UniChar ch1, ch2;
1297        
1298        while (1) {
1299            p = *pattern;
1300            s = *string;
1301            
1302            /*
1303             * See if we're at the end of both the pattern and the string.  If
1304             * so, we succeeded.  If we're at the end of the pattern but not at
1305             * the end of the string, we failed.
1306             */
1307            
1308            if (p == '\0') {
1309                return (s == '\0');
1310            }
1311            if ((s == '\0') && (p != '*')) {
1312                return 0;
1313            }
1314    
1315            /* Check for a "*" as the next pattern character.  It matches
1316             * any substring.  We handle this by calling ourselves
1317             * recursively for each postfix of string, until either we
1318             * match or we reach the end of the string.
1319             */
1320            
1321            if (p == '*') {
1322                pattern++;
1323                if (*pattern == '\0') {
1324                    return 1;
1325                }
1326                while (1) {
1327                    if (Tcl_StringCaseMatch(string, pattern, nocase)) {
1328                        return 1;
1329                    }
1330                    if (*string == '\0') {
1331                        return 0;
1332                    }
1333                    string++;
1334                }
1335            }
1336    
1337            /* Check for a "?" as the next pattern character.  It matches
1338             * any single character.
1339             */
1340    
1341            if (p == '?') {
1342                pattern++;
1343                string += Tcl_UtfToUniChar(string, &ch1);
1344                continue;
1345            }
1346    
1347            /* Check for a "[" as the next pattern character.  It is followed
1348             * by a list of characters that are acceptable, or by a range
1349             * (two characters separated by "-").
1350             */
1351            
1352            if (p == '[') {
1353                Tcl_UniChar startChar, endChar;
1354    
1355                pattern++;
1356                string += Tcl_UtfToUniChar(string, &ch1);
1357                if (nocase) {
1358                    ch1 = Tcl_UniCharToLower(ch1);
1359                }
1360                while (1) {
1361                    if ((*pattern == ']') || (*pattern == '\0')) {
1362                        return 0;
1363                    }
1364                    pattern += Tcl_UtfToUniChar(pattern, &startChar);
1365                    if (nocase) {
1366                        startChar = Tcl_UniCharToLower(startChar);
1367                    }
1368                    if (*pattern == '-') {
1369                        pattern++;
1370                        if (*pattern == '\0') {
1371                            return 0;
1372                        }
1373                        pattern += Tcl_UtfToUniChar(pattern, &endChar);
1374                        if (nocase) {
1375                            endChar = Tcl_UniCharToLower(endChar);
1376                        }
1377                        if (((startChar <= ch1) && (ch1 <= endChar))
1378                                || ((endChar <= ch1) && (ch1 <= startChar))) {
1379                            /*
1380                             * Matches ranges of form [a-z] or [z-a].
1381                             */
1382    
1383                            break;
1384                        }
1385                    } else if (startChar == ch1) {
1386                        break;
1387                    }
1388                }
1389                while (*pattern != ']') {
1390                    if (*pattern == '\0') {
1391                        pattern = Tcl_UtfPrev(pattern, pstart);
1392                        break;
1393                    }
1394                    pattern++;
1395                }
1396                pattern++;
1397                continue;
1398            }
1399        
1400            /* If the next pattern character is '\', just strip off the '\'
1401             * so we do exact matching on the character that follows.
1402             */
1403            
1404            if (p == '\\') {
1405                pattern++;
1406                p = *pattern;
1407                if (p == '\0') {
1408                    return 0;
1409                }
1410            }
1411    
1412            /* There's no special character.  Just make sure that the next
1413             * bytes of each string match.
1414             */
1415            
1416            string  += Tcl_UtfToUniChar(string, &ch1);
1417            pattern += Tcl_UtfToUniChar(pattern, &ch2);
1418            if (nocase) {
1419                if (Tcl_UniCharToLower(ch1) != Tcl_UniCharToLower(ch2)) {
1420                    return 0;
1421                }
1422            } else if (ch1 != ch2) {
1423                return 0;
1424            }
1425        }
1426    }
1427    
1428    /*
1429     *----------------------------------------------------------------------
1430     *
1431     * Tcl_DStringInit --
1432     *
1433     *      Initializes a dynamic string, discarding any previous contents
1434     *      of the string (Tcl_DStringFree should have been called already
1435     *      if the dynamic string was previously in use).
1436     *
1437     * Results:
1438     *      None.
1439     *
1440     * Side effects:
1441     *      The dynamic string is initialized to be empty.
1442     *
1443     *----------------------------------------------------------------------
1444     */
1445    
1446    void
1447    Tcl_DStringInit(dsPtr)
1448        Tcl_DString *dsPtr;         /* Pointer to structure for dynamic string. */
1449    {
1450        dsPtr->string = dsPtr->staticSpace;
1451        dsPtr->length = 0;
1452        dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
1453        dsPtr->staticSpace[0] = '\0';
1454    }
1455    
1456    /*
1457     *----------------------------------------------------------------------
1458     *
1459     * Tcl_DStringAppend --
1460     *
1461     *      Append more characters to the current value of a dynamic string.
1462     *
1463     * Results:
1464     *      The return value is a pointer to the dynamic string's new value.
1465     *
1466     * Side effects:
1467     *      Length bytes from string (or all of string if length is less
1468     *      than zero) are added to the current value of the string. Memory
1469     *      gets reallocated if needed to accomodate the string's new size.
1470     *
1471     *----------------------------------------------------------------------
1472     */
1473    
1474    char *
1475    Tcl_DStringAppend(dsPtr, string, length)
1476        Tcl_DString *dsPtr;         /* Structure describing dynamic string. */
1477        CONST char *string;         /* String to append.  If length is -1 then
1478                                     * this must be null-terminated. */
1479        int length;                 /* Number of characters from string to
1480                                     * append.  If < 0, then append all of string,
1481                                     * up to null at end. */
1482    {
1483        int newSize;
1484        char *dst;
1485        CONST char *end;
1486    
1487        if (length < 0) {
1488            length = strlen(string);
1489        }
1490        newSize = length + dsPtr->length;
1491    
1492        /*
1493         * Allocate a larger buffer for the string if the current one isn't
1494         * large enough. Allocate extra space in the new buffer so that there
1495         * will be room to grow before we have to allocate again.
1496         */
1497    
1498        if (newSize >= dsPtr->spaceAvl) {
1499            dsPtr->spaceAvl = newSize * 2;
1500            if (dsPtr->string == dsPtr->staticSpace) {
1501                char *newString;
1502    
1503                newString = (char *) ckalloc((unsigned) dsPtr->spaceAvl);
1504                memcpy((VOID *) newString, (VOID *) dsPtr->string,
1505                        (size_t) dsPtr->length);
1506                dsPtr->string = newString;
1507            } else {
1508                dsPtr->string = (char *) ckrealloc((VOID *) dsPtr->string,
1509                        (size_t) dsPtr->spaceAvl);
1510            }
1511        }
1512    
1513        /*
1514         * Copy the new string into the buffer at the end of the old
1515         * one.
1516         */
1517    
1518        for (dst = dsPtr->string + dsPtr->length, end = string+length;
1519                string < end; string++, dst++) {
1520            *dst = *string;
1521        }
1522        *dst = '\0';
1523        dsPtr->length += length;
1524        return dsPtr->string;
1525    }
1526    
1527    /*
1528     *----------------------------------------------------------------------
1529     *
1530     * Tcl_DStringAppendElement --
1531     *
1532     *      Append a list element to the current value of a dynamic string.
1533     *
1534     * Results:
1535     *      The return value is a pointer to the dynamic string's new value.
1536     *
1537     * Side effects:
1538     *      String is reformatted as a list element and added to the current
1539     *      value of the string.  Memory gets reallocated if needed to
1540     *      accomodate the string's new size.
1541     *
1542     *----------------------------------------------------------------------
1543     */
1544    
1545    char *
1546    Tcl_DStringAppendElement(dsPtr, string)
1547        Tcl_DString *dsPtr;         /* Structure describing dynamic string. */
1548        CONST char *string;         /* String to append.  Must be
1549                                     * null-terminated. */
1550    {
1551        int newSize, flags;
1552        char *dst;
1553    
1554        newSize = Tcl_ScanElement(string, &flags) + dsPtr->length + 1;
1555    
1556        /*
1557         * Allocate a larger buffer for the string if the current one isn't
1558         * large enough.  Allocate extra space in the new buffer so that there
1559         * will be room to grow before we have to allocate again.
1560         * SPECIAL NOTE: must use memcpy, not strcpy, to copy the string
1561         * to a larger buffer, since there may be embedded NULLs in the
1562         * string in some cases.
1563         */
1564    
1565        if (newSize >= dsPtr->spaceAvl) {
1566            dsPtr->spaceAvl = newSize * 2;
1567            if (dsPtr->string == dsPtr->staticSpace) {
1568                char *newString;
1569    
1570                newString = (char *) ckalloc((unsigned) dsPtr->spaceAvl);
1571                memcpy((VOID *) newString, (VOID *) dsPtr->string,
1572                        (size_t) dsPtr->length);
1573                dsPtr->string = newString;
1574            } else {
1575                dsPtr->string = (char *) ckrealloc((VOID *) dsPtr->string,
1576                        (size_t) dsPtr->spaceAvl);
1577            }
1578        }
1579    
1580        /*
1581         * Convert the new string to a list element and copy it into the
1582         * buffer at the end, with a space, if needed.
1583         */
1584    
1585        dst = dsPtr->string + dsPtr->length;
1586        if (TclNeedSpace(dsPtr->string, dst)) {
1587            *dst = ' ';
1588            dst++;
1589            dsPtr->length++;
1590        }
1591        dsPtr->length += Tcl_ConvertElement(string, dst, flags);
1592        return dsPtr->string;
1593    }
1594    
1595    /*
1596     *----------------------------------------------------------------------
1597     *
1598     * Tcl_DStringSetLength --
1599     *
1600     *      Change the length of a dynamic string.  This can cause the
1601     *      string to either grow or shrink, depending on the value of
1602     *      length.
1603     *
1604     * Results:
1605     *      None.
1606     *
1607     * Side effects:
1608     *      The length of dsPtr is changed to length and a null byte is
1609     *      stored at that position in the string.  If length is larger
1610     *      than the space allocated for dsPtr, then a panic occurs.
1611     *
1612     *----------------------------------------------------------------------
1613     */
1614    
1615    void
1616    Tcl_DStringSetLength(dsPtr, length)
1617        Tcl_DString *dsPtr;         /* Structure describing dynamic string. */
1618        int length;                 /* New length for dynamic string. */
1619    {
1620        int newsize;
1621    
1622        if (length < 0) {
1623            length = 0;
1624        }
1625        if (length >= dsPtr->spaceAvl) {
1626            /*
1627             * There are two interesting cases here.  In the first case, the user
1628             * may be trying to allocate a large buffer of a specific size.  It
1629             * would be wasteful to overallocate that buffer, so we just allocate
1630             * enough for the requested size plus the trailing null byte.  In the
1631             * second case, we are growing the buffer incrementally, so we need
1632             * behavior similar to Tcl_DStringAppend.  The requested length will
1633             * usually be a small delta above the current spaceAvl, so we'll end up
1634             * doubling the old size.  This won't grow the buffer quite as quickly,
1635             * but it should be close enough.
1636             */
1637    
1638            newsize = dsPtr->spaceAvl * 2;
1639            if (length < newsize) {
1640                dsPtr->spaceAvl = newsize;
1641            } else {
1642                dsPtr->spaceAvl = length + 1;
1643            }
1644            if (dsPtr->string == dsPtr->staticSpace) {
1645                char *newString;
1646    
1647                newString = (char *) ckalloc((unsigned) dsPtr->spaceAvl);
1648                memcpy((VOID *) newString, (VOID *) dsPtr->string,
1649                        (size_t) dsPtr->length);
1650                dsPtr->string = newString;
1651            } else {
1652                dsPtr->string = (char *) ckrealloc((VOID *) dsPtr->string,
1653                        (size_t) dsPtr->spaceAvl);
1654            }
1655        }
1656        dsPtr->length = length;
1657        dsPtr->string[length] = 0;
1658    }
1659    
1660    /*
1661     *----------------------------------------------------------------------
1662     *
1663     * Tcl_DStringFree --
1664     *
1665     *      Frees up any memory allocated for the dynamic string and
1666     *      reinitializes the string to an empty state.
1667     *
1668     * Results:
1669     *      None.
1670     *
1671     * Side effects:
1672     *      The previous contents of the dynamic string are lost, and
1673     *      the new value is an empty string.
1674     *
1675     *---------------------------------------------------------------------- */
1676    
1677    void
1678    Tcl_DStringFree(dsPtr)
1679        Tcl_DString *dsPtr;         /* Structure describing dynamic string. */
1680    {
1681        if (dsPtr->string != dsPtr->staticSpace) {
1682            ckfree(dsPtr->string);
1683        }
1684        dsPtr->string = dsPtr->staticSpace;
1685        dsPtr->length = 0;
1686        dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
1687        dsPtr->staticSpace[0] = '\0';
1688    }
1689    
1690    /*
1691     *----------------------------------------------------------------------
1692     *
1693     * Tcl_DStringResult --
1694     *
1695     *      This procedure moves the value of a dynamic string into an
1696     *      interpreter as its string result. Afterwards, the dynamic string
1697     *      is reset to an empty string.
1698     *
1699     * Results:
1700     *      None.
1701     *
1702     * Side effects:
1703     *      The string is "moved" to interp's result, and any existing
1704     *      string result for interp is freed. dsPtr is reinitialized to
1705     *      an empty string.
1706     *
1707     *----------------------------------------------------------------------
1708     */
1709    
1710    void
1711    Tcl_DStringResult(interp, dsPtr)
1712        Tcl_Interp *interp;         /* Interpreter whose result is to be reset. */
1713        Tcl_DString *dsPtr;         /* Dynamic string that is to become the
1714                                     * result of interp. */
1715    {
1716        Tcl_ResetResult(interp);
1717        
1718        if (dsPtr->string != dsPtr->staticSpace) {
1719            interp->result = dsPtr->string;
1720            interp->freeProc = TCL_DYNAMIC;
1721        } else if (dsPtr->length < TCL_RESULT_SIZE) {
1722            interp->result = ((Interp *) interp)->resultSpace;
1723            strcpy(interp->result, dsPtr->string);
1724        } else {
1725            Tcl_SetResult(interp, dsPtr->string, TCL_VOLATILE);
1726        }
1727        
1728        dsPtr->string = dsPtr->staticSpace;
1729        dsPtr->length = 0;
1730        dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
1731        dsPtr->staticSpace[0] = '\0';
1732    }
1733    
1734    /*
1735     *----------------------------------------------------------------------
1736     *
1737     * Tcl_DStringGetResult --
1738     *
1739     *      This procedure moves an interpreter's result into a dynamic string.
1740     *
1741     * Results:
1742     *      None.
1743     *
1744     * Side effects:
1745     *      The interpreter's string result is cleared, and the previous
1746     *      contents of dsPtr are freed.
1747     *
1748     *      If the string result is empty, the object result is moved to the
1749     *      string result, then the object result is reset.
1750     *
1751     *----------------------------------------------------------------------
1752     */
1753    
1754    void
1755    Tcl_DStringGetResult(interp, dsPtr)
1756        Tcl_Interp *interp;         /* Interpreter whose result is to be reset. */
1757        Tcl_DString *dsPtr;         /* Dynamic string that is to become the
1758                                     * result of interp. */
1759    {
1760        Interp *iPtr = (Interp *) interp;
1761        
1762        if (dsPtr->string != dsPtr->staticSpace) {
1763            ckfree(dsPtr->string);
1764        }
1765    
1766        /*
1767         * If the string result is empty, move the object result to the
1768         * string result, then reset the object result.
1769         */
1770    
1771        if (*(iPtr->result) == 0) {
1772            Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
1773                    TCL_VOLATILE);
1774        }
1775    
1776        dsPtr->length = strlen(iPtr->result);
1777        if (iPtr->freeProc != NULL) {
1778            if ((iPtr->freeProc == TCL_DYNAMIC)
1779                    || (iPtr->freeProc == (Tcl_FreeProc *) free)) {
1780                dsPtr->string = iPtr->result;
1781                dsPtr->spaceAvl = dsPtr->length+1;
1782            } else {
1783                dsPtr->string = (char *) ckalloc((unsigned) (dsPtr->length+1));
1784                strcpy(dsPtr->string, iPtr->result);
1785                (*iPtr->freeProc)(iPtr->result);
1786            }
1787            dsPtr->spaceAvl = dsPtr->length+1;
1788            iPtr->freeProc = NULL;
1789        } else {
1790            if (dsPtr->length < TCL_DSTRING_STATIC_SIZE) {
1791                dsPtr->string = dsPtr->staticSpace;
1792                dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
1793            } else {
1794                dsPtr->string = (char *) ckalloc((unsigned) (dsPtr->length + 1));
1795                dsPtr->spaceAvl = dsPtr->length + 1;
1796            }
1797            strcpy(dsPtr->string, iPtr->result);
1798        }
1799        
1800        iPtr->result = iPtr->resultSpace;
1801        iPtr->resultSpace[0] = 0;
1802    }
1803    
1804    /*
1805     *----------------------------------------------------------------------
1806     *
1807     * Tcl_DStringStartSublist --
1808     *
1809     *      This procedure adds the necessary information to a dynamic
1810     *      string (e.g. " {" to start a sublist.  Future element
1811     *      appends will be in the sublist rather than the main list.
1812     *
1813     * Results:
1814     *      None.
1815     *
1816     * Side effects:
1817     *      Characters get added to the dynamic string.
1818     *
1819     *----------------------------------------------------------------------
1820     */
1821    
1822    void
1823    Tcl_DStringStartSublist(dsPtr)
1824        Tcl_DString *dsPtr;                 /* Dynamic string. */
1825    {
1826        if (TclNeedSpace(dsPtr->string, dsPtr->string + dsPtr->length)) {
1827            Tcl_DStringAppend(dsPtr, " {", -1);
1828        } else {
1829            Tcl_DStringAppend(dsPtr, "{", -1);
1830        }
1831    }
1832    
1833    /*
1834     *----------------------------------------------------------------------
1835     *
1836     * Tcl_DStringEndSublist --
1837     *
1838     *      This procedure adds the necessary characters to a dynamic
1839     *      string to end a sublist (e.g. "}").  Future element appends
1840     *      will be in the enclosing (sub)list rather than the current
1841     *      sublist.
1842     *
1843     * Results:
1844     *      None.
1845     *
1846     * Side effects:
1847     *      None.
1848     *
1849     *----------------------------------------------------------------------
1850     */
1851    
1852    void
1853    Tcl_DStringEndSublist(dsPtr)
1854        Tcl_DString *dsPtr;                 /* Dynamic string. */
1855    {
1856        Tcl_DStringAppend(dsPtr, "}", -1);
1857    }
1858    
1859    /*
1860     *----------------------------------------------------------------------
1861     *
1862     * Tcl_PrintDouble --
1863     *
1864     *      Given a floating-point value, this procedure converts it to
1865     *      an ASCII string using.
1866     *
1867     * Results:
1868     *      The ASCII equivalent of "value" is written at "dst".  It is
1869     *      written using the current precision, and it is guaranteed to
1870     *      contain a decimal point or exponent, so that it looks like
1871     *      a floating-point value and not an integer.
1872     *
1873     * Side effects:
1874     *      None.
1875     *
1876     *----------------------------------------------------------------------
1877     */
1878    
1879    void
1880    Tcl_PrintDouble(interp, value, dst)
1881        Tcl_Interp *interp;                 /* Interpreter whose tcl_precision
1882                                             * variable used to be used to control
1883                                             * printing.  It's ignored now. */
1884        double value;                       /* Value to print as string. */
1885        char *dst;                          /* Where to store converted value;
1886                                             * must have at least TCL_DOUBLE_SPACE
1887                                             * characters. */
1888    {
1889        char *p, c;
1890        Tcl_UniChar ch;
1891    
1892        Tcl_MutexLock(&precisionMutex);
1893        sprintf(dst, precisionFormat, value);
1894        Tcl_MutexUnlock(&precisionMutex);
1895    
1896        /*
1897         * If the ASCII result looks like an integer, add ".0" so that it
1898         * doesn't look like an integer anymore.  This prevents floating-point
1899         * values from being converted to integers unintentionally.
1900         */
1901    
1902        for (p = dst; *p != 0; ) {
1903            p += Tcl_UtfToUniChar(p, &ch);
1904            c = UCHAR(ch);
1905            if ((c == '.') || isalpha(UCHAR(c))) {  /* INTL: ISO only. */
1906                return;
1907            }
1908        }
1909        p[0] = '.';
1910        p[1] = '0';
1911        p[2] = 0;
1912    }
1913    
1914    /*
1915     *----------------------------------------------------------------------
1916     *
1917     * TclPrecTraceProc --
1918     *
1919     *      This procedure is invoked whenever the variable "tcl_precision"
1920     *      is written.
1921     *
1922     * Results:
1923     *      Returns NULL if all went well, or an error message if the
1924     *      new value for the variable doesn't make sense.
1925     *
1926     * Side effects:
1927     *      If the new value doesn't make sense then this procedure
1928     *      undoes the effect of the variable modification.  Otherwise
1929     *      it modifies the format string that's used by Tcl_PrintDouble.
1930     *
1931     *----------------------------------------------------------------------
1932     */
1933    
1934            /* ARGSUSED */
1935    char *
1936    TclPrecTraceProc(clientData, interp, name1, name2, flags)
1937        ClientData clientData;      /* Not used. */
1938        Tcl_Interp *interp;         /* Interpreter containing variable. */
1939        char *name1;                /* Name of variable. */
1940        char *name2;                /* Second part of variable name. */
1941        int flags;                  /* Information about what happened. */
1942    {
1943        char *value, *end;
1944        int prec;
1945    
1946        /*
1947         * If the variable is unset, then recreate the trace.
1948         */
1949    
1950        if (flags & TCL_TRACE_UNSETS) {
1951            if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) {
1952                Tcl_TraceVar2(interp, name1, name2,
1953                        TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES
1954                        |TCL_TRACE_UNSETS, TclPrecTraceProc, clientData);
1955            }
1956            return (char *) NULL;
1957        }
1958    
1959        /*
1960         * When the variable is read, reset its value from our shared
1961         * value.  This is needed in case the variable was modified in
1962         * some other interpreter so that this interpreter's value is
1963         * out of date.
1964         */
1965    
1966        Tcl_MutexLock(&precisionMutex);
1967    
1968        if (flags & TCL_TRACE_READS) {
1969            Tcl_SetVar2(interp, name1, name2, precisionString,
1970                    flags & TCL_GLOBAL_ONLY);
1971            Tcl_MutexUnlock(&precisionMutex);
1972            return (char *) NULL;
1973        }
1974    
1975        /*
1976         * The variable is being written.  Check the new value and disallow
1977         * it if it isn't reasonable or if this is a safe interpreter (we
1978         * don't want safe interpreters messing up the precision of other
1979         * interpreters).
1980         */
1981    
1982        if (Tcl_IsSafe(interp)) {
1983            Tcl_SetVar2(interp, name1, name2, precisionString,
1984                    flags & TCL_GLOBAL_ONLY);
1985            Tcl_MutexUnlock(&precisionMutex);
1986            return "can't modify precision from a safe interpreter";
1987        }
1988        value = Tcl_GetVar2(interp, name1, name2, flags & TCL_GLOBAL_ONLY);
1989        if (value == NULL) {
1990            value = "";
1991        }
1992        prec = strtoul(value, &end, 10);
1993        if ((prec <= 0) || (prec > TCL_MAX_PREC) || (prec > 100) ||
1994                (end == value) || (*end != 0)) {
1995            Tcl_SetVar2(interp, name1, name2, precisionString,
1996                    flags & TCL_GLOBAL_ONLY);
1997            Tcl_MutexUnlock(&precisionMutex);
1998            return "improper value for precision";
1999        }
2000        TclFormatInt(precisionString, prec);
2001        sprintf(precisionFormat, "%%.%dg", prec);
2002        Tcl_MutexUnlock(&precisionMutex);
2003        return (char *) NULL;
2004    }
2005    
2006    /*
2007     *----------------------------------------------------------------------
2008     *
2009     * TclNeedSpace --
2010     *
2011     *      This procedure checks to see whether it is appropriate to
2012     *      add a space before appending a new list element to an
2013     *      existing string.
2014     *
2015     * Results:
2016     *      The return value is 1 if a space is appropriate, 0 otherwise.
2017     *
2018     * Side effects:
2019     *      None.
2020     *
2021     *----------------------------------------------------------------------
2022     */
2023    
2024    int
2025    TclNeedSpace(start, end)
2026        char *start;                /* First character in string. */
2027        char *end;                  /* End of string (place where space will
2028                                     * be added, if appropriate). */
2029    {
2030        /*
2031         * A space is needed unless either
2032         * (a) we're at the start of the string, or
2033         * (b) the trailing characters of the string consist of one or more
2034         *     open curly braces preceded by a space or extending back to
2035         *     the beginning of the string.
2036         * (c) the trailing characters of the string consist of a space
2037         *     preceded by a character other than backslash.
2038         */
2039    
2040        if (end == start) {
2041            return 0;
2042        }
2043        end--;
2044        if (*end != '{') {
2045            if (isspace(UCHAR(*end)) /* INTL: ISO space. */
2046                    && ((end == start) || (end[-1] != '\\'))) {
2047                return 0;
2048            }
2049            return 1;
2050        }
2051        do {
2052            if (end == start) {
2053                return 0;
2054            }
2055            end--;
2056        } while (*end == '{');
2057        if (isspace(UCHAR(*end))) { /* INTL: ISO space. */
2058            return 0;
2059        }
2060        return 1;
2061    }
2062    
2063    /*
2064     *----------------------------------------------------------------------
2065     *
2066     * TclFormatInt --
2067     *
2068     *      This procedure formats an integer into a sequence of decimal digit
2069     *      characters in a buffer. If the integer is negative, a minus sign is
2070     *      inserted at the start of the buffer. A null character is inserted at
2071     *      the end of the formatted characters. It is the caller's
2072     *      responsibility to ensure that enough storage is available. This
2073     *      procedure has the effect of sprintf(buffer, "%d", n) but is faster.
2074     *
2075     * Results:
2076     *      An integer representing the number of characters formatted, not
2077     *      including the terminating \0.
2078     *
2079     * Side effects:
2080     *      The formatted characters are written into the storage pointer to
2081     *      by the "buffer" argument.
2082     *
2083     *----------------------------------------------------------------------
2084     */
2085    
2086    int
2087    TclFormatInt(buffer, n)
2088        char *buffer;               /* Points to the storage into which the
2089                                     * formatted characters are written. */
2090        long n;                     /* The integer to format. */
2091    {
2092        long intVal;
2093        int i;
2094        int numFormatted, j;
2095        char *digits = "0123456789";
2096    
2097        /*
2098         * Check first whether "n" is zero.
2099         */
2100    
2101        if (n == 0) {
2102            buffer[0] = '0';
2103            buffer[1] = 0;
2104            return 1;
2105        }
2106    
2107        /*
2108         * Check whether "n" is the maximum negative value. This is
2109         * -2^(m-1) for an m-bit word, and has no positive equivalent;
2110         * negating it produces the same value.
2111         */
2112    
2113        if (n == -n) {
2114            sprintf(buffer, "%ld", n);
2115            return strlen(buffer);
2116        }
2117    
2118        /*
2119         * Generate the characters of the result backwards in the buffer.
2120         */
2121    
2122        intVal = (n < 0? -n : n);
2123        i = 0;
2124        buffer[0] = '\0';
2125        do {
2126            i++;
2127            buffer[i] = digits[intVal % 10];
2128            intVal = intVal/10;
2129        } while (intVal > 0);
2130        if (n < 0) {
2131            i++;
2132            buffer[i] = '-';
2133        }
2134        numFormatted = i;
2135    
2136        /*
2137         * Now reverse the characters.
2138         */
2139    
2140        for (j = 0;  j < i;  j++, i--) {
2141            char tmp = buffer[i];
2142            buffer[i] = buffer[j];
2143            buffer[j] = tmp;
2144        }
2145        return numFormatted;
2146    }
2147    
2148    /*
2149     *----------------------------------------------------------------------
2150     *
2151     * TclLooksLikeInt --
2152     *
2153     *      This procedure decides whether the leading characters of a
2154     *      string look like an integer or something else (such as a
2155     *      floating-point number or string).
2156     *
2157     * Results:
2158     *      The return value is 1 if the leading characters of p look
2159     *      like a valid Tcl integer.  If they look like a floating-point
2160     *      number (e.g. "e01" or "2.4"), or if they don't look like a
2161     *      number at all, then 0 is returned.
2162     *
2163     * Side effects:
2164     *      None.
2165     *
2166     *----------------------------------------------------------------------
2167     */
2168    
2169    int
2170    TclLooksLikeInt(bytes, length)
2171        register char *bytes;       /* Points to first byte of the string. */
2172        int length;                 /* Number of bytes in the string. If < 0
2173                                     * bytes up to the first null byte are
2174                                     * considered (if they may appear in an
2175                                     * integer). */
2176    {
2177        register char *p, *end;
2178    
2179        if (length < 0) {
2180            length = (bytes? strlen(bytes) : 0);
2181        }
2182        end = (bytes + length);
2183    
2184        p = bytes;
2185        while ((p < end) && isspace(UCHAR(*p))) { /* INTL: ISO space. */
2186            p++;
2187        }
2188        if (p == end) {
2189            return 0;
2190        }
2191        
2192        if ((*p == '+') || (*p == '-')) {
2193            p++;
2194        }
2195        if ((p == end) || !isdigit(UCHAR(*p))) { /* INTL: digit */
2196            return 0;
2197        }
2198        p++;
2199        while ((p < end) && isdigit(UCHAR(*p))) { /* INTL: digit */
2200            p++;
2201        }
2202        if (p == end) {
2203            return 1;
2204        }
2205        if ((*p != '.') && (*p != 'e') && (*p != 'E')) {
2206            return 1;
2207        }
2208        return 0;
2209    }
2210    
2211    /*
2212     *----------------------------------------------------------------------
2213     *
2214     * TclGetIntForIndex --
2215     *
2216     *      This procedure returns an integer corresponding to the list index
2217     *      held in a Tcl object. The Tcl object's value is expected to be
2218     *      either an integer or a string of the form "end([+-]integer)?".
2219     *
2220     * Results:
2221     *      The return value is normally TCL_OK, which means that the index was
2222     *      successfully stored into the location referenced by "indexPtr".  If
2223     *      the Tcl object referenced by "objPtr" has the value "end", the
2224     *      value stored is "endValue". If "objPtr"s values is not of the form
2225     *      "end([+-]integer)?" and
2226     *      can not be converted to an integer, TCL_ERROR is returned and, if
2227     *      "interp" is non-NULL, an error message is left in the interpreter's
2228     *      result object.
2229     *
2230     * Side effects:
2231     *      The object referenced by "objPtr" might be converted to an
2232     *      integer object.
2233     *
2234     *----------------------------------------------------------------------
2235     */
2236    
2237    int
2238    TclGetIntForIndex(interp, objPtr, endValue, indexPtr)
2239        Tcl_Interp *interp;         /* Interpreter to use for error reporting.
2240                                     * If NULL, then no error message is left
2241                                     * after errors. */
2242        Tcl_Obj *objPtr;            /* Points to an object containing either
2243                                     * "end" or an integer. */
2244        int endValue;               /* The value to be stored at "indexPtr" if
2245                                     * "objPtr" holds "end". */
2246        int *indexPtr;              /* Location filled in with an integer
2247                                     * representing an index. */
2248    {
2249        char *bytes;
2250        int length, offset;
2251    
2252        if (objPtr->typePtr == &tclIntType) {
2253            *indexPtr = (int)objPtr->internalRep.longValue;
2254            return TCL_OK;
2255        }
2256    
2257        bytes = Tcl_GetStringFromObj(objPtr, &length);
2258    
2259        if ((*bytes != 'e') || (strncmp(bytes, "end",
2260                (size_t)((length > 3) ? 3 : length)) != 0)) {
2261            if (Tcl_GetIntFromObj(NULL, objPtr, &offset) != TCL_OK) {
2262                goto intforindex_error;
2263            }
2264            *indexPtr = offset;
2265            return TCL_OK;
2266        }
2267    
2268        if (length <= 3) {
2269            *indexPtr = endValue;
2270        } else if (bytes[3] == '-') {
2271            /*
2272             * This is our limited string expression evaluator
2273             */
2274            if (Tcl_GetInt(interp, bytes+3, &offset) != TCL_OK) {
2275                return TCL_ERROR;
2276            }
2277            *indexPtr = endValue + offset;
2278        } else {
2279            intforindex_error:
2280            if ((Interp *)interp != NULL) {
2281                Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
2282                        "bad index \"", bytes,
2283                        "\": must be integer or end?-integer?", (char *) NULL);
2284                TclCheckBadOctal(interp, bytes);
2285            }
2286            return TCL_ERROR;
2287        }
2288        return TCL_OK;
2289    }
2290    
2291    /*
2292     *----------------------------------------------------------------------
2293     *
2294     * TclCheckBadOctal --
2295     *
2296     *      This procedure checks for a bad octal value and appends a
2297     *      meaningful error to the interp's result.
2298     *
2299     * Results:
2300     *      1 if the argument was a bad octal, else 0.
2301     *
2302     * Side effects:
2303     *      The interpreter's result is modified.
2304     *
2305     *----------------------------------------------------------------------
2306     */
2307    
2308    int
2309    TclCheckBadOctal(interp, value)
2310        Tcl_Interp *interp;         /* Interpreter to use for error reporting.
2311                                     * If NULL, then no error message is left
2312                                     * after errors. */
2313        char *value;                /* String to check. */
2314    {
2315        register char *p = value;
2316    
2317        /*
2318         * A frequent mistake is invalid octal values due to an unwanted
2319         * leading zero. Try to generate a meaningful error message.
2320         */
2321    
2322        while (isspace(UCHAR(*p))) {        /* INTL: ISO space. */
2323            p++;
2324        }
2325        if (*p == '+' || *p == '-') {
2326            p++;
2327        }
2328        if (*p == '0') {
2329            while (isdigit(UCHAR(*p))) {    /* INTL: digit. */
2330                p++;
2331            }
2332            while (isspace(UCHAR(*p))) {    /* INTL: ISO space. */
2333                p++;
2334            }
2335            if (*p == '\0') {
2336                /* Reached end of string */
2337                if (interp != NULL) {
2338                    Tcl_AppendResult(interp, " (looks like invalid octal number)",
2339                            (char *) NULL);
2340                }
2341                return 1;
2342            }
2343        }
2344        return 0;
2345    }
2346    
2347    /*
2348     *----------------------------------------------------------------------
2349     *
2350     * Tcl_GetNameOfExecutable --
2351     *
2352     *      This procedure simply returns a pointer to the internal full
2353     *      path name of the executable file as computed by
2354     *      Tcl_FindExecutable.  This procedure call is the C API
2355     *      equivalent to the "info nameofexecutable" command.
2356     *
2357     * Results:
2358     *      A pointer to the internal string or NULL if the internal full
2359     *      path name has not been computed or unknown.
2360     *
2361     * Side effects:
2362     *      The object referenced by "objPtr" might be converted to an
2363     *      integer object.
2364     *
2365     *----------------------------------------------------------------------
2366     */
2367    
2368    CONST char *
2369    Tcl_GetNameOfExecutable()
2370    {
2371        return (tclExecutableName);
2372    }
2373    
2374    /*
2375     *----------------------------------------------------------------------
2376     *
2377     * Tcl_GetCwd --
2378     *
2379     *      This function replaces the library version of getcwd().
2380     *
2381     * Results:
2382     *      The result is a pointer to a string specifying the current
2383     *      directory, or NULL if the current directory could not be
2384     *      determined.  If NULL is returned, an error message is left in the
2385     *      interp's result.  Storage for the result string is allocated in
2386     *      bufferPtr; the caller must call Tcl_DStringFree() when the result
2387     *      is no longer needed.
2388     *
2389     * Side effects:
2390     *      None.
2391     *
2392     *----------------------------------------------------------------------
2393     */
2394    
2395    char *
2396    Tcl_GetCwd(interp, cwdPtr)
2397        Tcl_Interp *interp;
2398        Tcl_DString *cwdPtr;
2399    {
2400        return TclpGetCwd(interp, cwdPtr);
2401    }
2402    
2403    /*
2404     *----------------------------------------------------------------------
2405     *
2406     * Tcl_Chdir --
2407     *
2408     *      This function replaces the library version of chdir().
2409     *
2410     * Results:
2411     *      See chdir() documentation.
2412     *
2413     * Side effects:
2414     *      See chdir() documentation.  
2415     *
2416     *----------------------------------------------------------------------
2417     */
2418    
2419    int
2420    Tcl_Chdir(dirName)
2421        CONST char *dirName;
2422    {
2423        return TclpChdir(dirName);
2424    }
2425    
2426    /*
2427     *----------------------------------------------------------------------
2428     *
2429     * Tcl_Access --
2430     *
2431     *      This function replaces the library version of access().
2432     *
2433     * Results:
2434     *      See access() documentation.
2435     *
2436     * Side effects:
2437     *      See access() documentation.
2438     *
2439     *----------------------------------------------------------------------
2440     */
2441    
2442    int
2443    Tcl_Access(path, mode)
2444        CONST char *path;           /* Path of file to access (UTF-8). */
2445        int mode;                   /* Permission setting. */
2446    {
2447        return TclAccess(path, mode);
2448    }
2449    
2450    /*
2451     *----------------------------------------------------------------------
2452     *
2453     * Tcl_Stat --
2454     *
2455     *      This function replaces the library version of stat().
2456     *
2457     * Results:
2458     *      See stat() documentation.
2459     *
2460     * Side effects:
2461     *      See stat() documentation.
2462     *
2463     *----------------------------------------------------------------------
2464     */
2465    
2466    int
2467    Tcl_Stat(path, bufPtr)
2468        CONST char *path;           /* Path of file to stat (in UTF-8). */
2469        struct stat *bufPtr;        /* Filled with results of stat call. */
2470    {
2471        return TclStat(path, bufPtr);
2472    }
2473    
2474    /* End of tclutil.c */
Legend:
Removed from v.64  
changed lines
  Added in v.98
dashley@gmail.com
 ViewVC Help
Powered by ViewVC 1.1.25