cde/programs/dtdocbook/tcl/tclFileName.c

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