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