home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / tkisrc04.zip / tcl / os2 / tclFileName.c < prev    next >
C/C++ Source or Header  |  1998-08-07  |  40KB  |  1,592 lines
  1. /* 
  2.  * tclFileName.c --
  3.  *
  4.  *    This file contains routines for converting file names betwen
  5.  *    native and network form.
  6.  *
  7.  * Copyright (c) 1995-1996 Sun Microsystems, Inc.
  8.  *
  9.  * See the file "license.terms" for information on usage and redistribution
  10.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  11.  *
  12.  * SCCS: @(#) tclFileName.c 1.23 96/04/19 12:34:28
  13.  */
  14.  
  15. #include "tclInt.h"
  16. #include "tclPort.h"
  17. #include "tclRegexp.h"
  18.  
  19. /*
  20.  * This variable indicates whether the cleanup procedure has been
  21.  * registered for this file yet.
  22.  */
  23.  
  24. static int initialized = 0;
  25.  
  26. /*
  27.  * The following regular expression matches the root portion of a Windows
  28.  * absolute or volume relative path.  It will match both UNC and drive relative
  29.  * paths.
  30.  */
  31.  
  32. #define WIN_ROOT_PATTERN "^(([a-zA-Z]:)|[/\\][/\\]+([^/\\]+)[/\\]+([^/\\]+)|([/\\]))([/\\])*"
  33.  
  34. /*
  35.  * The following regular expression matches the root portion of a Macintosh
  36.  * absolute path.  It will match degenerate Unix-style paths, tilde paths,
  37.  * Unix-style paths, and Mac paths.
  38.  */
  39.  
  40. #define MAC_ROOT_PATTERN "^((/+([.][.]?/+)*([.][.]?)?)|(~[^:/]*)(/[^:]*)?|(~[^:]*)(:.*)?|/+([.][.]?/+)*([^:/]+)(/[^:]*)?|([^:]+):.*)$"
  41.  
  42. /*
  43.  * The following variables are used to hold precompiled regular expressions
  44.  * for use in filename matching.
  45.  */
  46.  
  47. static regexp *winRootPatternPtr = NULL;
  48. static regexp *macRootPatternPtr = NULL;
  49.  
  50. /*
  51.  * The following variable is set in the TclPlatformInit call to one
  52.  * of: TCL_PLATFORM_UNIX, TCL_PLATFORM_MAC, or TCL_PLATFORM_WINDOWS.
  53.  */
  54.  
  55. TclPlatformType tclPlatform = TCL_PLATFORM_UNIX;
  56.  
  57. /*
  58.  * Prototypes for local procedures defined in this file:
  59.  */
  60.  
  61. static char *        DoTildeSubst _ANSI_ARGS_((Tcl_Interp *interp,
  62.                 char *user, Tcl_DString *resultPtr));
  63. static char *        ExtractWinRoot _ANSI_ARGS_((char *path,
  64.                 Tcl_DString *resultPtr, int offset));
  65. static void        FileNameCleanup _ANSI_ARGS_((ClientData clientData));
  66. static int        SkipToChar _ANSI_ARGS_((char **stringPtr,
  67.                 char *match));
  68. static char *        SplitMacPath _ANSI_ARGS_((char *path,
  69.                 Tcl_DString *bufPtr));
  70. static char *        SplitWinPath _ANSI_ARGS_((char *path,
  71.                 Tcl_DString *bufPtr));
  72. static char *        SplitUnixPath _ANSI_ARGS_((char *path,
  73.                 Tcl_DString *bufPtr));
  74.  
  75. /*
  76.  *----------------------------------------------------------------------
  77.  *
  78.  * FileNameCleanup --
  79.  *
  80.  *    This procedure is a Tcl_ExitProc used to clean up the static
  81.  *    data structures used in this file.
  82.  *
  83.  * Results:
  84.  *    None.
  85.  *
  86.  * Side effects:
  87.  *    Deallocates storage used by the procedures in this file.
  88.  *
  89.  *----------------------------------------------------------------------
  90.  */
  91.  
  92. static void
  93. FileNameCleanup(clientData)
  94.     ClientData clientData;    /* Not used. */
  95. {
  96.     if (winRootPatternPtr != NULL) {
  97.     ckfree((char *)winRootPatternPtr);
  98.     }
  99.     if (macRootPatternPtr != NULL) {
  100.     ckfree((char *)macRootPatternPtr);
  101.     }
  102. }
  103.  
  104. /*
  105.  *----------------------------------------------------------------------
  106.  *
  107.  * ExtractWinRoot --
  108.  *
  109.  *    Matches the root portion of a Windows path and appends it
  110.  *    to the specified Tcl_DString.
  111.  *    
  112.  * Results:
  113.  *    Returns the position in the path immediately after the root
  114.  *    including any trailing slashes.
  115.  *    Appends a cleaned up version of the root to the Tcl_DString
  116.  *    at the specified offest.
  117.  *
  118.  * Side effects:
  119.  *    Modifies the specified Tcl_DString.
  120.  *
  121.  *----------------------------------------------------------------------
  122.  */
  123.  
  124. static char *
  125. ExtractWinRoot(path, resultPtr, offset)
  126.     char *path;            /* Path to parse. */
  127.     Tcl_DString *resultPtr;    /* Buffer to hold result. */
  128.     int offset;            /* Offset in buffer where result should be
  129.                  * stored. */
  130. {
  131.     int length;
  132.  
  133.     /*
  134.      * Initialize the path name parser for Windows path names.
  135.      */
  136.  
  137.     if (winRootPatternPtr == NULL) {
  138.     winRootPatternPtr = TclRegComp(WIN_ROOT_PATTERN);
  139.     if (!initialized) {
  140.         Tcl_CreateExitHandler(FileNameCleanup, NULL);
  141.         initialized = 1;
  142.     }
  143.     }
  144.  
  145.     /*
  146.      * Match the root portion of a Windows path name.
  147.      */
  148.  
  149.     if (!TclRegExec(winRootPatternPtr, path, path)) {
  150.     return path;
  151.     }
  152.  
  153.     Tcl_DStringSetLength(resultPtr, offset);
  154.  
  155.     if (winRootPatternPtr->startp[2] != NULL) {
  156.     Tcl_DStringAppend(resultPtr, winRootPatternPtr->startp[2], 2);
  157.     if (winRootPatternPtr->startp[6] != NULL) {
  158.         Tcl_DStringAppend(resultPtr, "/", 1);
  159.     }
  160.     } else if (winRootPatternPtr->startp[4] != NULL) {
  161.     Tcl_DStringAppend(resultPtr, "//", 2);
  162.     length = winRootPatternPtr->endp[3]
  163.         - winRootPatternPtr->startp[3];
  164.     Tcl_DStringAppend(resultPtr, winRootPatternPtr->startp[3], length);
  165.     Tcl_DStringAppend(resultPtr, "/", 1);
  166.     length = winRootPatternPtr->endp[4]
  167.         - winRootPatternPtr->startp[4];
  168.     Tcl_DStringAppend(resultPtr, winRootPatternPtr->startp[4], length);
  169.     } else {
  170.     Tcl_DStringAppend(resultPtr, "/", 1);
  171.     }
  172.     return winRootPatternPtr->endp[0];
  173. }
  174.  
  175. /*
  176.  *----------------------------------------------------------------------
  177.  *
  178.  * Tcl_GetPathType --
  179.  *
  180.  *    Determines whether a given path is relative to the current
  181.  *    directory, relative to the current volume, or absolute.
  182.  *
  183.  * Results:
  184.  *    Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or
  185.  *    TCL_PATH_VOLUME_RELATIVE.
  186.  *
  187.  * Side effects:
  188.  *    None.
  189.  *
  190.  *----------------------------------------------------------------------
  191.  */
  192.  
  193. Tcl_PathType
  194. Tcl_GetPathType(path)
  195.     char *path;
  196. {
  197.     Tcl_PathType type = TCL_PATH_ABSOLUTE;
  198.  
  199.     switch (tclPlatform) {
  200.        case TCL_PLATFORM_UNIX:
  201.         /*
  202.          * Paths that begin with / or ~ are absolute.
  203.          */
  204.  
  205.         if ((path[0] != '/') && (path[0] != '~')) {
  206.         type = TCL_PATH_RELATIVE;
  207.         }
  208.         break;
  209.  
  210.     case TCL_PLATFORM_MAC:
  211.         if (path[0] == ':') {
  212.         type = TCL_PATH_RELATIVE;
  213.         } else if (path[0] != '~') {
  214.  
  215.         /*
  216.          * Since we have eliminated the easy cases, use the
  217.          * root pattern to look for the other types.
  218.          */
  219.  
  220.         if (!macRootPatternPtr) {
  221.             macRootPatternPtr = TclRegComp(MAC_ROOT_PATTERN);
  222.             if (!initialized) {
  223.             Tcl_CreateExitHandler(FileNameCleanup, NULL);
  224.             initialized = 1;
  225.             }
  226.         }
  227.         if (!TclRegExec(macRootPatternPtr, path, path)
  228.             || (macRootPatternPtr->startp[2] != NULL)) {
  229.             type = TCL_PATH_RELATIVE;
  230.         }
  231.         }
  232.         break;
  233.     
  234.     case TCL_PLATFORM_WINDOWS:
  235.         if (path[0] != '~') {
  236.  
  237.         /*
  238.          * Since we have eliminated the easy cases, check for
  239.          * drive relative paths using the regular expression.
  240.          */
  241.  
  242.         if (!winRootPatternPtr) {
  243.             winRootPatternPtr = TclRegComp(WIN_ROOT_PATTERN);
  244.             if (!initialized) {
  245.             Tcl_CreateExitHandler(FileNameCleanup, NULL);
  246.             initialized = 1;
  247.             }
  248.         }
  249.         if (TclRegExec(winRootPatternPtr, path, path)) {
  250.             if (winRootPatternPtr->startp[5]
  251.                 || (winRootPatternPtr->startp[2]
  252.                     && !(winRootPatternPtr->startp[6]))) {
  253.             type = TCL_PATH_VOLUME_RELATIVE;
  254.             }
  255.         } else {
  256.             type = TCL_PATH_RELATIVE;
  257.         }
  258.         }
  259.         break;
  260.     }
  261.     return type;
  262. }
  263.  
  264. /*
  265.  *----------------------------------------------------------------------
  266.  *
  267.  * Tcl_SplitPath --
  268.  *
  269.  *    Split a path into a list of path components.  The first element
  270.  *    of the list will have the same path type as the original path.
  271.  *
  272.  * Results:
  273.  *    Returns a standard Tcl result.  The interpreter result contains
  274.  *    a list of path components.
  275.  *    *argvPtr will be filled in with the address of an array
  276.  *    whose elements point to the elements of path, in order.
  277.  *    *argcPtr will get filled in with the number of valid elements
  278.  *    in the array.  A single block of memory is dynamically allocated
  279.  *    to hold both the argv array and a copy of the path elements.
  280.  *    The caller must eventually free this memory by calling ckfree()
  281.  *    on *argvPtr.  Note:  *argvPtr and *argcPtr are only modified
  282.  *    if the procedure returns normally.
  283.  *
  284.  * Side effects:
  285.  *    Allocates memory.
  286.  *
  287.  *----------------------------------------------------------------------
  288.  */
  289.  
  290. void
  291. Tcl_SplitPath(path, argcPtr, argvPtr)
  292.     char *path;            /* Pointer to string containing a path. */
  293.     int *argcPtr;        /* Pointer to location to fill in with
  294.                  * the number of elements in the path. */
  295.     char ***argvPtr;        /* Pointer to place to store pointer to array
  296.                  * of pointers to path elements. */
  297. {
  298.     int i, size;
  299.     char *p;
  300.     Tcl_DString buffer;
  301.     Tcl_DStringInit(&buffer);
  302.  
  303.     /*
  304.      * Perform platform specific splitting.  These routines will leave the
  305.      * result in the specified buffer.  Individual elements are terminated
  306.      * with a null character.
  307.      */
  308.  
  309.     p = NULL;            /* Needed only to prevent gcc warnings. */
  310.     switch (tclPlatform) {
  311.        case TCL_PLATFORM_UNIX:
  312.         p = SplitUnixPath(path, &buffer);
  313.         break;
  314.  
  315.     case TCL_PLATFORM_WINDOWS:
  316.         p = SplitWinPath(path, &buffer);
  317.         break;
  318.         
  319.     case TCL_PLATFORM_MAC:
  320.         p = SplitMacPath(path, &buffer);
  321.         break;
  322.     }
  323.  
  324.     /*
  325.      * Compute the number of elements in the result.
  326.      */
  327.  
  328.     size = Tcl_DStringLength(&buffer);
  329.     *argcPtr = 0;
  330.     for (i = 0; i < size; i++) {
  331.     if (p[i] == '\0') {
  332.         (*argcPtr)++;
  333.     }
  334.     }
  335.     
  336.     /*
  337.      * Allocate a buffer large enough to hold the contents of the
  338.      * DString plus the argv pointers and the terminating NULL pointer.
  339.      */
  340.  
  341.     *argvPtr = (char **) ckalloc((unsigned)
  342.         ((((*argcPtr) + 1) * sizeof(char *)) + size));
  343.  
  344.     /*
  345.      * Position p after the last argv pointer and copy the contents of
  346.      * the DString.
  347.      */
  348.  
  349.     p = (char *) &(*argvPtr)[(*argcPtr) + 1];
  350.     memcpy((VOID *) p, (VOID *) Tcl_DStringValue(&buffer), (size_t) size);
  351.  
  352.     /*
  353.      * Now set up the argv pointers.
  354.      */
  355.  
  356.     for (i = 0; i < *argcPtr; i++) {
  357.     (*argvPtr)[i] = p;
  358.     while ((*p++) != '\0') {}
  359.     }
  360.     (*argvPtr)[i] = NULL;
  361.  
  362.     Tcl_DStringFree(&buffer);
  363. }
  364.  
  365. /*
  366.  *----------------------------------------------------------------------
  367.  *
  368.  * SplitUnixPath --
  369.  *
  370.  *    This routine is used by Tcl_SplitPath to handle splitting
  371.  *    Unix paths.
  372.  *
  373.  * Results:
  374.  *    Stores a null separated array of strings in the specified
  375.  *    Tcl_DString.
  376.  *
  377.  * Side effects:
  378.  *    None.
  379.  *
  380.  *----------------------------------------------------------------------
  381.  */
  382.  
  383. static char *
  384. SplitUnixPath(path, bufPtr)
  385.     char *path;            /* Pointer to string containing a path. */
  386.     Tcl_DString *bufPtr;    /* Pointer to DString to use for the result. */
  387. {
  388.     int length;
  389.     char *p, *elementStart;
  390.  
  391.     /*
  392.      * Deal with the root directory as a special case.
  393.      */
  394.  
  395.     if (path[0] == '/') {
  396.     Tcl_DStringAppend(bufPtr, "/", 2);
  397.     p = path+1;
  398.     } else {
  399.     p = path;
  400.     }
  401.  
  402.     /*
  403.      * Split on slashes.  Embedded elements that start with tilde will be
  404.      * prefixed with "./" so they are not affected by tilde substitution.
  405.      */
  406.  
  407.     for (;;) {
  408.     elementStart = p;
  409.     while ((*p != '\0') && (*p != '/')) {
  410.         p++;
  411.     }
  412.     length = p - elementStart;
  413.     if (length > 0) {
  414.         if ((elementStart[0] == '~') && (elementStart != path)) {
  415.         Tcl_DStringAppend(bufPtr, "./", 2);
  416.         }
  417.         Tcl_DStringAppend(bufPtr, elementStart, length);
  418.         Tcl_DStringAppend(bufPtr, "", 1);
  419.     }
  420.     if (*p++ == '\0') {
  421.         break;
  422.     }
  423.     }
  424.     return Tcl_DStringValue(bufPtr);
  425. }
  426.  
  427. /*
  428.  *----------------------------------------------------------------------
  429.  *
  430.  * SplitWinPath --
  431.  *
  432.  *    This routine is used by Tcl_SplitPath to handle splitting
  433.  *    Windows paths.
  434.  *
  435.  * Results:
  436.  *    Stores a null separated array of strings in the specified
  437.  *    Tcl_DString.
  438.  *
  439.  * Side effects:
  440.  *    None.
  441.  *
  442.  *----------------------------------------------------------------------
  443.  */
  444.  
  445. static char *
  446. SplitWinPath(path, bufPtr)
  447.     char *path;            /* Pointer to string containing a path. */
  448.     Tcl_DString *bufPtr;    /* Pointer to DString to use for the result. */
  449. {
  450.     int length;
  451.     char *p, *elementStart;
  452.  
  453.     p = ExtractWinRoot(path, bufPtr, 0);
  454.  
  455.     /*
  456.      * Terminate the root portion, if we matched something.
  457.      */
  458.  
  459.     if (p != path) {
  460.     Tcl_DStringAppend(bufPtr, "", 1);
  461.     }
  462.  
  463.     /*
  464.      * Split on slashes.  Embedded elements that start with tilde will be
  465.      * prefixed with "./" so they are not affected by tilde substitution.
  466.      */
  467.  
  468.     do {
  469.     elementStart = p;
  470.     while ((*p != '\0') && (*p != '/') && (*p != '\\')) {
  471.         p++;
  472.     }
  473.     length = p - elementStart;
  474.     if (length > 0) {
  475.         if ((elementStart[0] == '~') && (elementStart != path)) {
  476.         Tcl_DStringAppend(bufPtr, "./", 2);
  477.         }
  478.         Tcl_DStringAppend(bufPtr, elementStart, length);
  479.         Tcl_DStringAppend(bufPtr, "", 1);
  480.     }
  481.     } while (*p++ != '\0');
  482.  
  483.     return Tcl_DStringValue(bufPtr);
  484. }
  485.  
  486. /*
  487.  *----------------------------------------------------------------------
  488.  *
  489.  * SplitMacPath --
  490.  *
  491.  *    This routine is used by Tcl_SplitPath to handle splitting
  492.  *    Macintosh paths.
  493.  *
  494.  * Results:
  495.  *    Returns a newly allocated argv array.
  496.  *
  497.  * Side effects:
  498.  *    None.
  499.  *
  500.  *----------------------------------------------------------------------
  501.  */
  502.  
  503. static char *
  504. SplitMacPath(path, bufPtr)
  505.     char *path;            /* Pointer to string containing a path. */
  506.     Tcl_DString *bufPtr;    /* Pointer to DString to use for the result. */
  507. {
  508.     int isMac = 0;        /* 1 if is Mac-style, 0 if Unix-style path. */
  509.     int i, length;
  510.     char *p, *elementStart;
  511.  
  512.     /*
  513.      * Initialize the path name parser for Macintosh path names.
  514.      */
  515.  
  516.     if (macRootPatternPtr == NULL) {
  517.     macRootPatternPtr = TclRegComp(MAC_ROOT_PATTERN);
  518.     if (!initialized) {
  519.         Tcl_CreateExitHandler(FileNameCleanup, NULL);
  520.         initialized = 1;
  521.     }
  522.     }
  523.  
  524.     /*
  525.      * Match the root portion of a Mac path name.
  526.      */
  527.  
  528.     i = 0;            /* Needed only to prevent gcc warnings. */
  529.     if (TclRegExec(macRootPatternPtr, path, path) == 1) {
  530.     /*
  531.      * Treat degenerate absolute paths like / and /../.. as
  532.      * Mac relative file names for lack of anything else to do.
  533.      */
  534.  
  535.     if (macRootPatternPtr->startp[2] != NULL) {
  536.         Tcl_DStringAppend(bufPtr, ":", 1);
  537.         Tcl_DStringAppend(bufPtr, path, macRootPatternPtr->endp[0]
  538.             - macRootPatternPtr->startp[0] + 1);
  539.         return Tcl_DStringValue(bufPtr);
  540.     }
  541.  
  542.     if (macRootPatternPtr->startp[5] != NULL) {
  543.  
  544.         /*
  545.          * Unix-style tilde prefixed paths.
  546.          */
  547.  
  548.         isMac = 0;
  549.         i = 5;
  550.     } else if (macRootPatternPtr->startp[7] != NULL) {
  551.  
  552.         /*
  553.          * Mac-style tilde prefixed paths.
  554.          */
  555.  
  556.         isMac = 1;
  557.         i = 7;
  558.     } else if (macRootPatternPtr->startp[10] != NULL) {
  559.  
  560.         /*
  561.          * Normal Unix style paths.
  562.          */
  563.  
  564.         isMac = 0;
  565.         i = 10;
  566.     } else if (macRootPatternPtr->startp[12] != NULL) {
  567.  
  568.         /*
  569.          * Normal Mac style paths.
  570.          */
  571.  
  572.         isMac = 1;
  573.         i = 12;
  574.     }
  575.  
  576.     length = macRootPatternPtr->endp[i]
  577.         - macRootPatternPtr->startp[i];
  578.  
  579.     /*
  580.      * Append the element and terminate it with a : and a null.  Note that
  581.      * we are forcing the DString to contain an extra null at the end.
  582.      */
  583.  
  584.     Tcl_DStringAppend(bufPtr, macRootPatternPtr->startp[i], length);
  585.     Tcl_DStringAppend(bufPtr, ":", 2);
  586.     p = macRootPatternPtr->endp[i];
  587.     } else {
  588.     isMac = (strchr(path, ':') != NULL);
  589.     p = path;
  590.     }
  591.     
  592.     if (isMac) {
  593.  
  594.     /*
  595.      * p is pointing at the first colon in the path.  There
  596.      * will always be one, since this is a Mac-style path.
  597.      */
  598.  
  599.     elementStart = p++;
  600.     while ((p = strchr(p, ':')) != NULL) {
  601.         length = p - elementStart;
  602.         if (length == 1) {
  603.         while (*p == ':') {
  604.             Tcl_DStringAppend(bufPtr, "::", 3);
  605.             elementStart = p++;
  606.         }
  607.         } else {
  608.         /*
  609.          * If this is a simple component, drop the leading colon.
  610.          */
  611.  
  612.         if ((elementStart[1] != '~')
  613.             && (strchr(elementStart+1, '/') == NULL)) {
  614.             elementStart++;
  615.             length--;
  616.         }
  617.         Tcl_DStringAppend(bufPtr, elementStart, length);
  618.         Tcl_DStringAppend(bufPtr, "", 1);
  619.         elementStart = p++;
  620.         }
  621.     }
  622.     if (elementStart[1] != '\0' || elementStart == path) {
  623.         if ((elementStart[1] != '~') && (elementStart[1] != '\0')
  624.             && (strchr(elementStart+1, '/') == NULL)) {
  625.             elementStart++;
  626.         }
  627.         Tcl_DStringAppend(bufPtr, elementStart, -1);
  628.         Tcl_DStringAppend(bufPtr, "", 1);
  629.     }
  630.     } else {
  631.  
  632.     /*
  633.      * Split on slashes, suppress extra /'s, and convert .. to ::. 
  634.      */
  635.  
  636.     for (;;) {
  637.         elementStart = p;
  638.         while ((*p != '\0') && (*p != '/')) {
  639.         p++;
  640.         }
  641.         length = p - elementStart;
  642.         if (length > 0) {
  643.         if ((length == 1) && (elementStart[0] == '.')) {
  644.             Tcl_DStringAppend(bufPtr, ":", 2);
  645.         } else if ((length == 2) && (elementStart[0] == '.')
  646.             && (elementStart[1] == '.')) {
  647.             Tcl_DStringAppend(bufPtr, "::", 3);
  648.         } else {
  649.             if (*elementStart == '~') {
  650.             Tcl_DStringAppend(bufPtr, ":", 1);
  651.             }
  652.             Tcl_DStringAppend(bufPtr, elementStart, length);
  653.             Tcl_DStringAppend(bufPtr, "", 1);
  654.         }
  655.         }
  656.         if (*p++ == '\0') {
  657.         break;
  658.         }
  659.     }
  660.     }
  661.     return Tcl_DStringValue(bufPtr);
  662. }
  663.  
  664. /*
  665.  *----------------------------------------------------------------------
  666.  *
  667.  * Tcl_JoinPath --
  668.  *
  669.  *    Combine a list of paths in a platform specific manner.
  670.  *
  671.  * Results:
  672.  *    Appends the joined path to the end of the specified
  673.  *    returning a pointer to the resulting string.  Note that
  674.  *    the Tcl_DString must already be initialized.
  675.  *
  676.  * Side effects:
  677.  *    Modifies the Tcl_DString.
  678.  *
  679.  *----------------------------------------------------------------------
  680.  */
  681.  
  682. char *
  683. Tcl_JoinPath(argc, argv, resultPtr)
  684.     int argc;
  685.     char **argv;
  686.     Tcl_DString *resultPtr;    /* Pointer to previously initialized DString. */
  687. {
  688.     int oldLength, length, i, needsSep;
  689.     Tcl_DString buffer;
  690.     char *p, c, *dest;
  691.  
  692.     Tcl_DStringInit(&buffer);
  693.     oldLength = Tcl_DStringLength(resultPtr);
  694.  
  695.     switch (tclPlatform) {
  696.        case TCL_PLATFORM_UNIX:
  697.         for (i = 0; i < argc; i++) {
  698.         p = argv[i];
  699.         /*
  700.          * If the path is absolute, reset the result buffer.
  701.          * Consume any duplicate leading slashes or a ./ in
  702.          * front of a tilde prefixed path that isn't at the
  703.          * beginning of the path.
  704.          */
  705.  
  706.         if (*p == '/') {
  707.             Tcl_DStringSetLength(resultPtr, oldLength);
  708.             Tcl_DStringAppend(resultPtr, "/", 1);
  709.             while (*p == '/') {
  710.             p++;
  711.             }
  712.         } else if (*p == '~') {
  713.             Tcl_DStringSetLength(resultPtr, oldLength);
  714.         } else if ((Tcl_DStringLength(resultPtr) != oldLength)
  715.             && (p[0] == '.') && (p[1] == '/')
  716.             && (p[2] == '~')) {
  717.             p += 2;
  718.         }
  719.  
  720.         if (*p == '\0') {
  721.             continue;
  722.         }
  723.  
  724.         /*
  725.          * Append a separator if needed.
  726.          */
  727.  
  728.         length = Tcl_DStringLength(resultPtr);
  729.         if ((length != oldLength)
  730.             && (Tcl_DStringValue(resultPtr)[length-1] != '/')) {
  731.             Tcl_DStringAppend(resultPtr, "/", 1);
  732.             length++;
  733.         }
  734.  
  735.         /*
  736.          * Append the element, eliminating duplicate and trailing
  737.          * slashes.
  738.          */
  739.  
  740.         Tcl_DStringSetLength(resultPtr, (int) (length + strlen(p)));
  741.         dest = Tcl_DStringValue(resultPtr) + length;
  742.         for (; *p != '\0'; p++) {
  743.             if (*p == '/') {
  744.             while (p[1] == '/') {
  745.                 p++;
  746.             }
  747.             if (p[1] != '\0') {
  748.                 *dest++ = '/';
  749.             }
  750.             } else {
  751.             *dest++ = *p;
  752.             }
  753.         }
  754.         length = dest - Tcl_DStringValue(resultPtr);
  755.         Tcl_DStringSetLength(resultPtr, length);
  756.         }
  757.         break;
  758.  
  759.     case TCL_PLATFORM_WINDOWS:
  760.         /*
  761.          * Iterate over all of the components.  If a component is
  762.          * absolute, then reset the result and start building the
  763.          * path from the current component on.
  764.          */
  765.  
  766.         for (i = 0; i < argc; i++) {
  767.         p = ExtractWinRoot(argv[i], resultPtr, oldLength);
  768.         length = Tcl_DStringLength(resultPtr);
  769.         
  770.         /*
  771.          * If the pointer didn't move, then this is a relative path
  772.          * or a tilde prefixed path.
  773.          */
  774.  
  775.         if (p == argv[i]) {
  776.             /*
  777.              * Remove the ./ from tilde prefixed elements unless
  778.              * it is the first component.
  779.              */
  780.  
  781.             if ((length != oldLength)
  782.                 && (p[0] == '.')
  783.                 && ((p[1] == '/') || (p[1] == '\\'))
  784.                 && (p[2] == '~')) {
  785.             p += 2;
  786.             } else if (*p == '~') {
  787.             Tcl_DStringSetLength(resultPtr, oldLength);
  788.             length = oldLength;
  789.             }
  790.         }
  791.  
  792.         if (*p != '\0') {
  793.             /*
  794.              * Check to see if we need to append a separator.
  795.              */
  796.  
  797.             
  798.             if (length != oldLength) {
  799.             c = Tcl_DStringValue(resultPtr)[length-1];
  800.             if ((c != '/') && (c != ':')) {
  801.                 Tcl_DStringAppend(resultPtr, "/", 1);
  802.             }
  803.             }
  804.  
  805.             /*
  806.              * Append the element, eliminating duplicate and
  807.              * trailing slashes.
  808.              */
  809.  
  810.             length = Tcl_DStringLength(resultPtr);
  811.             Tcl_DStringSetLength(resultPtr, (int) (length + strlen(p)));
  812.             dest = Tcl_DStringValue(resultPtr) + length;
  813.             for (; *p != '\0'; p++) {
  814.             if ((*p == '/') || (*p == '\\')) {
  815.                 while ((p[1] == '/') || (p[1] == '\\')) {
  816.                 p++;
  817.                 }
  818.                 if (p[1] != '\0') {
  819.                 *dest++ = '/';
  820.                 }
  821.             } else {
  822.                 *dest++ = *p;
  823.             }
  824.             }
  825.             length = dest - Tcl_DStringValue(resultPtr);
  826.             Tcl_DStringSetLength(resultPtr, length);
  827.         }
  828.         }
  829.         break;
  830.  
  831.     case TCL_PLATFORM_MAC:
  832.         needsSep = 1;
  833.         for (i = 0; i < argc; i++) {
  834.         Tcl_DStringSetLength(&buffer, 0);
  835.         p = SplitMacPath(argv[i], &buffer);
  836.         if ((*p != ':') && (*p != '\0')
  837.             && (strchr(p, ':') != NULL)) {
  838.             Tcl_DStringSetLength(resultPtr, oldLength);
  839.             length = strlen(p);
  840.             Tcl_DStringAppend(resultPtr, p, length);
  841.             needsSep = 0;
  842.             p += length+1;
  843.         }
  844.  
  845.         /*
  846.          * Now append the rest of the path elements, skipping
  847.          * : unless it is the first element of the path, and
  848.          * watching out for :: et al. so we don't end up with
  849.          * too many colons in the result.
  850.          */
  851.  
  852.         for (; *p != '\0'; p += length+1) {
  853.             if (p[0] == ':' && p[1] == '\0') {
  854.             if (Tcl_DStringLength(resultPtr) != oldLength) {
  855.                 p++;
  856.             } else {
  857.                 needsSep = 0;
  858.             }
  859.             } else {
  860.             c = p[1];
  861.             if (*p == ':') {
  862.                 if (!needsSep) {
  863.                 p++;
  864.                 }
  865.             } else {
  866.                 if (needsSep) {
  867.                 Tcl_DStringAppend(resultPtr, ":", 1);
  868.                 }
  869.             }
  870.             needsSep = (c == ':') ? 0 : 1;
  871.             }
  872.             length = strlen(p);
  873.             Tcl_DStringAppend(resultPtr, p, length);
  874.         }
  875.         }
  876.         break;
  877.                    
  878.     }
  879.     Tcl_DStringFree(&buffer);
  880.     return Tcl_DStringValue(resultPtr);
  881. }
  882.  
  883. /*
  884.  *----------------------------------------------------------------------
  885.  *
  886.  * Tcl_TranslateFileName --
  887.  *
  888.  *    Converts a file name into a form usable by the native system
  889.  *    interfaces.  If the name starts with a tilde, it will produce
  890.  *    a name where the tilde and following characters have been
  891.  *    replaced by the home directory location for the named user.
  892.  *
  893.  * Results:
  894.  *    The result is a pointer to a static string containing
  895.  *    the new name.  If there was an error in processing the
  896.  *    name, then an error message is left in interp->result
  897.  *    and the return value is NULL.  The result will be stored
  898.  *    in bufferPtr; the caller must call Tcl_DStringFree(bufferPtr)
  899.  *    to free the name if the return value was not NULL.
  900.  *
  901.  * Side effects:
  902.  *    Information may be left in bufferPtr.
  903.  *
  904.  *---------------------------------------------------------------------- */
  905.  
  906. char *
  907. Tcl_TranslateFileName(interp, name, bufferPtr)
  908.     Tcl_Interp *interp;        /* Interpreter in which to store error
  909.                  * message (if necessary). */
  910.     char *name;            /* File name, which may begin with "~"
  911.                  * (to indicate current user's home directory)
  912.                  * or "~<user>" (to indicate any user's
  913.                  * home directory). */
  914.     Tcl_DString *bufferPtr;    /* May be used to hold result.  Must not hold
  915.                  * anything at the time of the call, and need
  916.                  * not even be initialized. */
  917. {
  918.     register char *p;
  919.  
  920.     /*
  921.      * Handle tilde substitutions, if needed.
  922.      */
  923.  
  924.     if (name[0] == '~') {
  925.     int argc, length;
  926.     char **argv;
  927.     Tcl_DString temp;
  928.  
  929.     Tcl_SplitPath(name, &argc, &argv);
  930.     
  931.     /*
  932.      * Strip the trailing ':' off of a Mac path
  933.      * before passing the user name to DoTildeSubst.
  934.      */
  935.  
  936.     if (tclPlatform == TCL_PLATFORM_MAC) {
  937.         length = strlen(argv[0]);
  938.         argv[0][length-1] = '\0';
  939.     }
  940.     
  941.     Tcl_DStringInit(&temp);
  942.     argv[0] = DoTildeSubst(interp, argv[0]+1, &temp);
  943.     if (argv[0] == NULL) {
  944.         Tcl_DStringFree(&temp);
  945.         ckfree((char *)argv);
  946.         return NULL;
  947.     }
  948.     Tcl_DStringInit(bufferPtr);
  949.     Tcl_JoinPath(argc, argv, bufferPtr);
  950.     Tcl_DStringFree(&temp);
  951.     ckfree((char*)argv);
  952.     } else {
  953.     Tcl_DStringInit(bufferPtr);
  954.     Tcl_JoinPath(1, &name, bufferPtr);
  955.     }
  956.  
  957.     /*
  958.      * Convert forward slashes to backslashes in Windows paths because
  959.      * some system interfaces don't accept forward slashes.
  960.      */
  961.  
  962.     if (tclPlatform == TCL_PLATFORM_WINDOWS) {
  963.     for (p = Tcl_DStringValue(bufferPtr); *p != '\0'; p++) {
  964.         if (*p == '/') {
  965.         *p = '\\';
  966.         }
  967.     }
  968.     }
  969.     return Tcl_DStringValue(bufferPtr);
  970. }
  971.  
  972. /*
  973.  *----------------------------------------------------------------------
  974.  *
  975.  * TclGetExtension --
  976.  *
  977.  *    This function returns a pointer to the beginning of the
  978.  *    extension part of a file name.
  979.  *
  980.  * Results:
  981.  *    Returns a pointer into name which indicates where the extension
  982.  *    starts.  If there is no extension, returns NULL.
  983.  *
  984.  * Side effects:
  985.  *    None.
  986.  *
  987.  *----------------------------------------------------------------------
  988.  */
  989.  
  990. char *
  991. TclGetExtension(name)
  992.     char *name;            /* File name to parse. */
  993. {
  994.     char *p, *lastSep;
  995.  
  996.     /*
  997.      * First find the last directory separator.
  998.      */
  999.  
  1000.     lastSep = NULL;        /* Needed only to prevent gcc warnings. */
  1001.     switch (tclPlatform) {
  1002.     case TCL_PLATFORM_UNIX:
  1003.         lastSep = strrchr(name, '/');
  1004.         break;
  1005.  
  1006.     case TCL_PLATFORM_MAC:
  1007.         if (strchr(name, ':') == NULL) {
  1008.         lastSep = strrchr(name, '/');
  1009.         } else {
  1010.         lastSep = strrchr(name, ':');
  1011.         }
  1012.         break;
  1013.  
  1014.     case TCL_PLATFORM_WINDOWS:
  1015.         lastSep = NULL;
  1016.         for (p = name; *p != '\0'; p++) {
  1017.         if (strchr("/\\:", *p) != NULL) {
  1018.             lastSep = p;
  1019.         }
  1020.         }
  1021.         break;
  1022.     }
  1023.     p = strrchr(name, '.');
  1024.     if ((p != NULL) && (lastSep != NULL)
  1025.         && (lastSep > p)) {
  1026.     p = NULL;
  1027.     }
  1028.     return p;
  1029. }
  1030.  
  1031. /*
  1032.  *----------------------------------------------------------------------
  1033.  *
  1034.  * DoTildeSubst --
  1035.  *
  1036.  *    Given a string following a tilde, this routine returns the
  1037.  *    corresponding home directory.
  1038.  *
  1039.  * Results:
  1040.  *    The result is a pointer to a static string containing the home
  1041.  *    directory in native format.  If there was an error in processing
  1042.  *    the substitution, then an error message is left in interp->result
  1043.  *    and the return value is NULL.  On success, the results are appended
  1044.  *     to resultPtr, and the contents of resultPtr are returned.
  1045.  *
  1046.  * Side effects:
  1047.  *    Information may be left in resultPtr.
  1048.  *
  1049.  *----------------------------------------------------------------------
  1050.  */
  1051.  
  1052. static char *
  1053. DoTildeSubst(interp, user, resultPtr)
  1054.     Tcl_Interp *interp;        /* Interpreter in which to store error
  1055.                  * message (if necessary). */
  1056.     char *user;            /* Name of user whose home directory should be
  1057.                  * substituted, or "" for current user. */
  1058.     Tcl_DString *resultPtr;    /* May be used to hold result.  Must not hold
  1059.                  * anything at the time of the call, and need
  1060.                  * not even be initialized. */
  1061. {
  1062.     char *dir;
  1063.  
  1064.     if (*user == '\0') {
  1065.     dir = TclGetEnv("HOME");
  1066.     if (dir == NULL) {
  1067.         if (interp) {
  1068.         Tcl_ResetResult(interp);
  1069.         Tcl_AppendResult(interp, "couldn't find HOME environment ",
  1070.             "variable to expand path", (char *) NULL);
  1071.         }
  1072.         return NULL;
  1073.     }
  1074.     Tcl_JoinPath(1, &dir, resultPtr);
  1075.     } else {
  1076.     if (TclGetUserHome(user, resultPtr) == NULL) {
  1077.         if (interp) {
  1078.         Tcl_ResetResult(interp);
  1079.         Tcl_AppendResult(interp, "user \"", user, "\" doesn't exist",
  1080.             (char *) NULL);
  1081.         }
  1082.         return NULL;
  1083.     }
  1084.     }
  1085.     return resultPtr->string;
  1086. }
  1087.  
  1088. /*
  1089.  *----------------------------------------------------------------------
  1090.  *
  1091.  * Tcl_GlobCmd --
  1092.  *
  1093.  *    This procedure is invoked to process the "glob" Tcl command.
  1094.  *    See the user documentation for details on what it does.
  1095.  *
  1096.  * Results:
  1097.  *    A standard Tcl result.
  1098.  *
  1099.  * Side effects:
  1100.  *    See the user documentation.
  1101.  *
  1102.  *----------------------------------------------------------------------
  1103.  */
  1104.  
  1105.     /* ARGSUSED */
  1106. int
  1107. Tcl_GlobCmd(dummy, interp, argc, argv)
  1108.     ClientData dummy;            /* Not used. */
  1109.     Tcl_Interp *interp;            /* Current interpreter. */
  1110.     int argc;                /* Number of arguments. */
  1111.     char **argv;            /* Argument strings. */
  1112. {
  1113.     int i, noComplain, firstArg;
  1114.     char c;
  1115.     int result = TCL_OK;
  1116.     Tcl_DString buffer;
  1117.     char *separators, *head, *tail;
  1118.  
  1119.     noComplain = 0;
  1120.     for (firstArg = 1; (firstArg < argc) && (argv[firstArg][0] == '-');
  1121.         firstArg++) {
  1122.     if (strcmp(argv[firstArg], "-nocomplain") == 0) {
  1123.         noComplain = 1;
  1124.     } else if (strcmp(argv[firstArg], "--") == 0) {
  1125.         firstArg++;
  1126.         break;
  1127.     } else {
  1128.         Tcl_AppendResult(interp, "bad switch \"", argv[firstArg],
  1129.             "\": must be -nocomplain or --", (char *) NULL);
  1130.         return TCL_ERROR;
  1131.     }
  1132.     }
  1133.     if (firstArg >= argc) {
  1134.     Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  1135.         " ?switches? name ?name ...?\"", (char *) NULL);
  1136.     return TCL_ERROR;
  1137.     }
  1138.  
  1139.     Tcl_DStringInit(&buffer);
  1140.     separators = NULL;        /* Needed only to prevent gcc warnings. */
  1141.     for (i = firstArg; i < argc; i++) {
  1142.     head = tail = "";
  1143.  
  1144.     switch (tclPlatform) {
  1145.     case TCL_PLATFORM_UNIX:
  1146.         separators = "/";
  1147.         break;
  1148.     case TCL_PLATFORM_WINDOWS:
  1149.         separators = "/\\:";
  1150.         break;
  1151.     case TCL_PLATFORM_MAC:
  1152.         separators = (strchr(argv[i], ':') == NULL) ? "/" : ":";
  1153.         break;
  1154.     }
  1155.  
  1156.     Tcl_DStringSetLength(&buffer, 0);
  1157.  
  1158.     /*
  1159.      * Perform tilde substitution, if needed.
  1160.      */
  1161.  
  1162.     if (argv[i][0] == '~') {
  1163.         char *p;
  1164.  
  1165.         /*
  1166.          * Find the first path separator after the tilde.
  1167.          */
  1168.  
  1169.         for (tail = argv[i]; *tail != '\0'; tail++) {
  1170.         if (*tail == '\\') {
  1171.             if (strchr(separators, tail[1]) != NULL) {
  1172.             break;
  1173.             }
  1174.         } else if (strchr(separators, *tail) != NULL) {
  1175.             break;
  1176.         }
  1177.         }
  1178.  
  1179.         /*
  1180.          * Determine the home directory for the specified user.  Note that
  1181.          * we don't allow special characters in the user name.
  1182.          */
  1183.  
  1184.         c = *tail;
  1185.         *tail = '\0';
  1186.         p = strpbrk(argv[i]+1, "\\[]*?{}");
  1187.         if (p == NULL) {
  1188.         head = DoTildeSubst(interp, argv[i]+1, &buffer);
  1189.         } else {
  1190.         if (!noComplain) {
  1191.             Tcl_ResetResult(interp);
  1192.             Tcl_AppendResult(interp, "globbing characters not ",
  1193.                 "supported in user names", (char *) NULL);
  1194.         }
  1195.         head = NULL;
  1196.         }
  1197.         *tail = c;
  1198.         if (head == NULL) {
  1199.         if (noComplain) {
  1200.             Tcl_ResetResult(interp);
  1201.             continue;
  1202.         } else {
  1203.             result = TCL_ERROR;
  1204.             goto done;
  1205.         }
  1206.         }
  1207.         if (head != Tcl_DStringValue(&buffer)) {
  1208.         Tcl_DStringAppend(&buffer, head, -1);
  1209.         }
  1210.     } else {
  1211.         tail = argv[i];
  1212.     }
  1213.  
  1214.     result = TclDoGlob(interp, separators, &buffer, tail);
  1215.     if (result != TCL_OK) {
  1216.         if (noComplain) {
  1217.         Tcl_ResetResult(interp);
  1218.         continue;
  1219.         } else {
  1220.         goto done;
  1221.         }
  1222.     }
  1223.     }
  1224.  
  1225.     if ((*interp->result == 0) && !noComplain) {
  1226.     char *sep = "";
  1227.  
  1228.     Tcl_AppendResult(interp, "no files matched glob pattern",
  1229.         (argc == 2) ? " \"" : "s \"", (char *) NULL);
  1230.     for (i = firstArg; i < argc; i++) {
  1231.         Tcl_AppendResult(interp, sep, argv[i], (char *) NULL);
  1232.         sep = " ";
  1233.     }
  1234.     Tcl_AppendResult(interp, "\"", (char *) NULL);
  1235.     result = TCL_ERROR;
  1236.     }
  1237. done:
  1238.     Tcl_DStringFree(&buffer);
  1239.     return result;
  1240. }
  1241.  
  1242. /*
  1243.  *----------------------------------------------------------------------
  1244.  *
  1245.  * SkipToChar --
  1246.  *
  1247.  *    This function traverses a glob pattern looking for the next
  1248.  *    unquoted occurance of the specified character at the same braces
  1249.  *    nesting level.
  1250.  *
  1251.  * Results:
  1252.  *    Updates stringPtr to point to the matching character, or to
  1253.  *    the end of the string if nothing matched.  The return value
  1254.  *    is 1 if a match was found at the top level, otherwise it is 0.
  1255.  *
  1256.  * Side effects:
  1257.  *    None.
  1258.  *
  1259.  *----------------------------------------------------------------------
  1260.  */
  1261.  
  1262. static int
  1263. SkipToChar(stringPtr, match)
  1264.     char **stringPtr;            /* Pointer string to check. */
  1265.     char *match;            /* Pointer to character to find. */
  1266. {
  1267.     int quoted, level;
  1268.     register char *p;
  1269.  
  1270.     quoted = 0;
  1271.     level = 0;
  1272.  
  1273.     for (p = *stringPtr; *p != '\0'; p++) {
  1274.     if (quoted) {
  1275.         quoted = 0;
  1276.         continue;
  1277.     }
  1278.     if ((level == 0) && (*p == *match)) {
  1279.         *stringPtr = p;
  1280.         return 1;
  1281.     }
  1282.     if (*p == '{') {
  1283.         level++;
  1284.     } else if (*p == '}') {
  1285.         level--;
  1286.     } else if (*p == '\\') {
  1287.         quoted = 1;
  1288.     }
  1289.     }
  1290.     *stringPtr = p;
  1291.     return 0;
  1292. }
  1293.  
  1294. /*
  1295.  *----------------------------------------------------------------------
  1296.  *
  1297.  * TclDoGlob --
  1298.  *
  1299.  *    This recursive procedure forms the heart of the globbing
  1300.  *    code.  It performs a depth-first traversal of the tree
  1301.  *    given by the path name to be globbed.  The directory and
  1302.  *    remainder are assumed to be native format paths.
  1303.  *
  1304.  * Results:
  1305.  *    The return value is a standard Tcl result indicating whether
  1306.  *    an error occurred in globbing.  After a normal return the
  1307.  *    result in interp will be set to hold all of the file names
  1308.  *    given by the dir and rem arguments.  After an error the
  1309.  *    result in interp will hold an error message.
  1310.  *
  1311.  * Side effects:
  1312.  *    None.
  1313.  *
  1314.  *----------------------------------------------------------------------
  1315.  */
  1316.  
  1317. int
  1318. TclDoGlob(interp, separators, headPtr, tail)
  1319.     Tcl_Interp *interp;        /* Interpreter to use for error reporting
  1320.                  * (e.g. unmatched brace). */
  1321.     char *separators;        /* String containing separator characters
  1322.                  * that should be used to identify globbing
  1323.                  * boundaries. */
  1324.     Tcl_DString *headPtr;    /* Completely expanded prefix. */
  1325.     char *tail;            /* The unexpanded remainder of the path. */
  1326. {
  1327.     int level, baseLength, quoted, count;
  1328.     int result = TCL_OK;
  1329.     char *p, *openBrace, *closeBrace, *name, savedChar;
  1330.     char lastChar = 0;
  1331.     int length = Tcl_DStringLength(headPtr);
  1332.  
  1333.     if (length > 0) {
  1334.     lastChar = Tcl_DStringValue(headPtr)[length-1];
  1335.     }
  1336.  
  1337.     /*
  1338.      * Consume any leading directory separators, leaving tail pointing
  1339.      * just past the last initial separator.
  1340.      */
  1341.  
  1342.     count = 0;
  1343.     name = tail;
  1344.     for (; *tail != '\0'; tail++) {
  1345.     if ((*tail == '\\') && (strchr(separators, tail[1]) != NULL)) {
  1346.         tail++;
  1347.     } else if (strchr(separators, *tail) == NULL) {
  1348.         break;
  1349.     }
  1350.     count++;
  1351.     }
  1352.  
  1353.     /*
  1354.      * Deal with path separators.  On the Mac, we have to watch out
  1355.      * for multiple separators, since they are special in Mac-style
  1356.      * paths.
  1357.      */
  1358.  
  1359.     switch (tclPlatform) {
  1360.     case TCL_PLATFORM_MAC:
  1361.         if (*separators == '/') {
  1362.         if (((length == 0) && (count == 0))
  1363.             || ((length > 0) && (lastChar != ':'))) {
  1364.             Tcl_DStringAppend(headPtr, ":", 1);
  1365.         }
  1366.         } else {
  1367.         if (count == 0) {
  1368.             if ((length > 0) && (lastChar != ':')) {
  1369.             Tcl_DStringAppend(headPtr, ":", 1);
  1370.             }
  1371.         } else {
  1372.             if (lastChar == ':') {
  1373.             count--;
  1374.             }
  1375.             while (count-- > 0) {
  1376.             Tcl_DStringAppend(headPtr, ":", 1);
  1377.             }
  1378.         }
  1379.         }
  1380.         break;
  1381.     case TCL_PLATFORM_WINDOWS:
  1382.         /*
  1383.          * If this is a drive relative path, add the colon and the
  1384.          * trailing slash if needed.  Otherwise add the slash if
  1385.          * this is the first absolute element, or a later relative
  1386.          * element.  Add an extra slash if this is a UNC path.
  1387.          */
  1388.  
  1389.         if (*name == ':') {
  1390.         Tcl_DStringAppend(headPtr, ":", 1);
  1391.         if (count > 1) {
  1392.             Tcl_DStringAppend(headPtr, "/", 1);
  1393.         }
  1394.         } else if ((*tail != '\0')
  1395.             && (((length > 0)
  1396.                 && (strchr(separators, lastChar) == NULL))
  1397.                 || ((length == 0) && (count > 0)))) {
  1398.         Tcl_DStringAppend(headPtr, "/", 1);
  1399.         if ((length == 0) && (count > 1)) {
  1400.             Tcl_DStringAppend(headPtr, "/", 1);
  1401.         }
  1402.         }
  1403.         
  1404.         break;
  1405.     case TCL_PLATFORM_UNIX:
  1406.         /*
  1407.          * Add a separator if this is the first absolute element, or
  1408.          * a later relative element.
  1409.          */
  1410.  
  1411.         if ((*tail != '\0')
  1412.             && (((length > 0)
  1413.                 && (strchr(separators, lastChar) == NULL))
  1414.                 || ((length == 0) && (count > 0)))) {
  1415.         Tcl_DStringAppend(headPtr, "/", 1);
  1416.         }
  1417.         break;
  1418.     }
  1419.  
  1420.     /*
  1421.      * Look for the first matching pair of braces or the first
  1422.      * directory separator that is not inside a pair of braces.
  1423.      */
  1424.  
  1425.     openBrace = closeBrace = NULL;
  1426.     level = 0;
  1427.     quoted = 0;
  1428.     for (p = tail; *p != '\0'; p++) {
  1429.     if (quoted) {
  1430.         quoted = 0;
  1431.     } else if (*p == '\\') {
  1432.         quoted = 1;
  1433.         if (strchr(separators, p[1]) != NULL) {
  1434.         break;            /* Quoted directory separator. */
  1435.         }
  1436.     } else if (strchr(separators, *p) != NULL) {
  1437.         break;            /* Unquoted directory separator. */
  1438.     } else if (*p == '{') {
  1439.         openBrace = p;
  1440.         p++;
  1441.         if (SkipToChar(&p, "}")) {
  1442.         closeBrace = p;        /* Balanced braces. */
  1443.         break;
  1444.         }
  1445.         Tcl_ResetResult(interp);
  1446.         interp->result = "unmatched open-brace in file name";
  1447.         return TCL_ERROR;
  1448.     } else if (*p == '}') {
  1449.         Tcl_ResetResult(interp);
  1450.         interp->result = "unmatched close-brace in file name";
  1451.         return TCL_ERROR;
  1452.     }
  1453.     }
  1454.  
  1455.     /*
  1456.      * Substitute the alternate patterns from the braces and recurse.
  1457.      */
  1458.  
  1459.     if (openBrace != NULL) {
  1460.     char *element;
  1461.     Tcl_DString newName;
  1462.     Tcl_DStringInit(&newName);
  1463.  
  1464.     /*
  1465.      * For each element within in the outermost pair of braces,
  1466.      * append the element and the remainder to the fixed portion
  1467.      * before the first brace and recursively call TclDoGlob.
  1468.      */
  1469.  
  1470.     Tcl_DStringAppend(&newName, tail, openBrace-tail);
  1471.     baseLength = Tcl_DStringLength(&newName);
  1472.     length = Tcl_DStringLength(headPtr);
  1473.     *closeBrace = '\0';
  1474.     for (p = openBrace; p != closeBrace; ) {
  1475.         p++;
  1476.         element = p;
  1477.         SkipToChar(&p, ",");
  1478.         Tcl_DStringSetLength(headPtr, length);
  1479.         Tcl_DStringSetLength(&newName, baseLength);
  1480.         Tcl_DStringAppend(&newName, element, p-element);
  1481.         Tcl_DStringAppend(&newName, closeBrace+1, -1);
  1482.         result = TclDoGlob(interp, separators,
  1483.             headPtr, Tcl_DStringValue(&newName));
  1484.         if (result != TCL_OK) {
  1485.         break;
  1486.         }
  1487.     }
  1488.     *closeBrace = '}';
  1489.     Tcl_DStringFree(&newName);
  1490.     return result;
  1491.     }
  1492.  
  1493.     /*
  1494.      * At this point, there are no more brace substitutions to perform on
  1495.      * this path component.  The variable p is pointing at a quoted or
  1496.      * unquoted directory separator or the end of the string.  So we need
  1497.      * to check for special globbing characters in the current pattern.
  1498.      */
  1499.  
  1500.     savedChar = *p;
  1501.     *p = '\0';
  1502.  
  1503.     if (strpbrk(tail, "*[]?\\") != NULL) {
  1504.     *p = savedChar;
  1505.     /*
  1506.      * Look for matching files in the current directory.  The
  1507.      * implementation of this function is platform specific, but may
  1508.      * recursively call TclDoGlob.  For each file that matches, it will
  1509.      * add the match onto the interp->result, or call TclDoGlob if there
  1510.      * are more characters to be processed.
  1511.      */
  1512.  
  1513.     return TclMatchFiles(interp, separators, headPtr, tail, p);
  1514.     }
  1515.     *p = savedChar;
  1516.     Tcl_DStringAppend(headPtr, tail, p-tail);
  1517.     if (*p != '\0') {
  1518.     return TclDoGlob(interp, separators, headPtr, p);
  1519.     }
  1520.  
  1521.     /*
  1522.      * There are no more wildcards in the pattern and no more unprocessed
  1523.      * characters in the tail, so now we can construct the path and verify
  1524.      * the existence of the file.
  1525.      */
  1526.  
  1527.     switch (tclPlatform) {
  1528.     case TCL_PLATFORM_MAC:
  1529.         if (strchr(Tcl_DStringValue(headPtr), ':') == NULL) {
  1530.         Tcl_DStringAppend(headPtr, ":", 1);
  1531.         }
  1532.         name = Tcl_DStringValue(headPtr);
  1533.         if (access(name, F_OK) == 0) {
  1534.         if ((name[1] != '\0') && (strchr(name+1, ':') == NULL)) {
  1535.             Tcl_AppendElement(interp, name+1);
  1536.         } else {
  1537.             Tcl_AppendElement(interp, name);
  1538.         }
  1539.         }
  1540.         break;
  1541.     case TCL_PLATFORM_WINDOWS: {
  1542.         int exists;
  1543.         /*
  1544.          * We need to convert slashes to backslashes before checking
  1545.          * for the existence of the file.  Once we are done, we need
  1546.          * to convert the slashes back.
  1547.          */
  1548.  
  1549.         if (Tcl_DStringLength(headPtr) == 0) {
  1550.         if (((*name == '\\') && (name[1] == '/' || name[1] == '\\'))
  1551.             || (*name == '/')) {
  1552.             Tcl_DStringAppend(headPtr, "\\", 1);
  1553.         } else {
  1554.             Tcl_DStringAppend(headPtr, ".", 1);
  1555.         }
  1556.         } else {
  1557.         for (p = Tcl_DStringValue(headPtr); *p != '\0'; p++) {
  1558.             if (*p == '/') {
  1559.             *p = '\\';
  1560.             }
  1561.         }
  1562.         }
  1563.         name = Tcl_DStringValue(headPtr);
  1564.         exists = (access(name, F_OK) == 0);
  1565.         for (p = name; *p != '\0'; p++) {
  1566.         if (*p == '\\') {
  1567.             *p = '/';
  1568.         }
  1569.         }
  1570.         if (exists) {
  1571.         Tcl_AppendElement(interp, name);
  1572.         }
  1573.         break;
  1574.     }
  1575.     case TCL_PLATFORM_UNIX:
  1576.         if (Tcl_DStringLength(headPtr) == 0) {
  1577.         if ((*name == '\\' && name[1] == '/') || (*name == '/')) {
  1578.             Tcl_DStringAppend(headPtr, "/", 1);
  1579.         } else {
  1580.             Tcl_DStringAppend(headPtr, ".", 1);
  1581.         }
  1582.         }
  1583.         name = Tcl_DStringValue(headPtr);
  1584.         if (access(name, F_OK) == 0) {
  1585.         Tcl_AppendElement(interp, name);
  1586.         }
  1587.         break;
  1588.     }
  1589.  
  1590.     return TCL_OK;
  1591. }
  1592.