tcl/generic/tclFileName.c

   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  * RCS: @(#) $Id$
  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 \f
  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 \f
 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 \f
 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 \f
 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 \f
 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 \f
 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 \f
 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 \f
 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 \f
 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 #ifndef __CYGWIN__
 967     if (tclPlatform == TCL_PLATFORM_WINDOWS) {
 968         for (p = Tcl_DStringValue(bufferPtr); *p != '\0'; p++) {
 969             if (*p == '/') {
 970                 *p = '\\';
 971             }
 972         }
 973     }
 974 #endif
 975     return Tcl_DStringValue(bufferPtr);
 976 }
 977 \f
 978 /*
 979  *----------------------------------------------------------------------
 980  *
 981  * TclGetExtension --
 982  *
 983  *      This function returns a pointer to the beginning of the
 984  *      extension part of a file name.
 985  *
 986  * Results:
 987  *      Returns a pointer into name which indicates where the extension
 988  *      starts.  If there is no extension, returns NULL.
 989  *
 990  * Side effects:
 991  *      None.
 992  *
 993  *----------------------------------------------------------------------
 994  */
 995
 996 char *
 997 TclGetExtension(name)
 998     char *name;                 /* File name to parse. */
 999 {
1000     char *p, *lastSep;
1001
1002     /*
1003      * First find the last directory separator.
1004      */
1005
1006     lastSep = NULL;             /* Needed only to prevent gcc warnings. */
1007     switch (tclPlatform) {
1008         case TCL_PLATFORM_UNIX:
1009             lastSep = strrchr(name, '/');
1010             break;
1011
1012         case TCL_PLATFORM_MAC:
1013             if (strchr(name, ':') == NULL) {
1014                 lastSep = strrchr(name, '/');
1015             } else {
1016                 lastSep = strrchr(name, ':');
1017             }
1018             break;
1019
1020         case TCL_PLATFORM_WINDOWS:
1021             lastSep = NULL;
1022             for (p = name; *p != '\0'; p++) {
1023                 if (strchr("/\\:", *p) != NULL) {
1024                     lastSep = p;
1025                 }
1026             }
1027             break;
1028     }
1029     p = strrchr(name, '.');
1030     if ((p != NULL) && (lastSep != NULL)
1031             && (lastSep > p)) {
1032         p = NULL;
1033     }
1034
1035     /*
1036      * Back up to the first period in a series of contiguous dots.
1037      * This is needed so foo..o will be split on the first dot.
1038      */
1039
1040     if (p != NULL) {
1041         while ((p > name) && *(p-1) == '.') {
1042             p--;
1043         }
1044     }
1045     return p;
1046 }
1047 \f
1048 /*
1049  *----------------------------------------------------------------------
1050  *
1051  * DoTildeSubst --
1052  *
1053  *      Given a string following a tilde, this routine returns the
1054  *      corresponding home directory.
1055  *
1056  * Results:
1057  *      The result is a pointer to a static string containing the home
1058  *      directory in native format.  If there was an error in processing
1059  *      the substitution, then an error message is left in interp->result
1060  *      and the return value is NULL.  On success, the results are appended
1061  *      to resultPtr, and the contents of resultPtr are returned.
1062  *
1063  * Side effects:
1064  *      Information may be left in resultPtr.
1065  *
1066  *----------------------------------------------------------------------
1067  */
1068
1069 static char *
1070 DoTildeSubst(interp, user, resultPtr)
1071     Tcl_Interp *interp;         /* Interpreter in which to store error
1072                                  * message (if necessary). */
1073     char *user;                 /* Name of user whose home directory should be
1074                                  * substituted, or "" for current user. */
1075     Tcl_DString *resultPtr;     /* May be used to hold result.  Must not hold
1076                                  * anything at the time of the call, and need
1077                                  * not even be initialized. */
1078 {
1079     char *dir;
1080
1081     if (*user == '\0') {
1082         dir = TclGetEnv("HOME");
1083         if (dir == NULL) {
1084             if (interp) {
1085                 Tcl_ResetResult(interp);
1086                 Tcl_AppendResult(interp, "couldn't find HOME environment ",
1087                         "variable to expand path", (char *) NULL);
1088             }
1089             return NULL;
1090         }
1091         Tcl_JoinPath(1, &dir, resultPtr);
1092     } else {
1093
1094         /* lint, TclGetuserHome() always NULL under windows. */
1095         if (TclGetUserHome(user, resultPtr) == NULL) {
1096             if (interp) {
1097                 Tcl_ResetResult(interp);
1098                 Tcl_AppendResult(interp, "user \"", user, "\" doesn't exist",
1099                         (char *) NULL);
1100             }
1101             return NULL;
1102         }
1103     }
1104     return resultPtr->string;
1105 }
1106 \f
1107 /*
1108  *----------------------------------------------------------------------
1109  *
1110  * Tcl_GlobCmd --
1111  *
1112  *      This procedure is invoked to process the "glob" Tcl command.
1113  *      See the user documentation for details on what it does.
1114  *
1115  * Results:
1116  *      A standard Tcl result.
1117  *
1118  * Side effects:
1119  *      See the user documentation.
1120  *
1121  *----------------------------------------------------------------------
1122  */
1123
1124         /* ARGSUSED */
1125 int
1126 Tcl_GlobCmd(dummy, interp, argc, argv)
1127     ClientData dummy;                   /* Not used. */
1128     Tcl_Interp *interp;                 /* Current interpreter. */
1129     int argc;                           /* Number of arguments. */
1130     char **argv;                        /* Argument strings. */
1131 {
1132     int i, noComplain, firstArg;
1133     char c;
1134     int result = TCL_OK;
1135     Tcl_DString buffer;
1136     char *separators, *head, *tail;
1137
1138     noComplain = 0;
1139     for (firstArg = 1; (firstArg < argc) && (argv[firstArg][0] == '-');
1140             firstArg++) {
1141         if (strcmp(argv[firstArg], "-nocomplain") == 0) {
1142             noComplain = 1;
1143         } else if (strcmp(argv[firstArg], "--") == 0) {
1144             firstArg++;
1145             break;
1146         } else {
1147             Tcl_AppendResult(interp, "bad switch \"", argv[firstArg],
1148                     "\": must be -nocomplain or --", (char *) NULL);
1149             return TCL_ERROR;
1150         }
1151     }
1152     if (firstArg >= argc) {
1153         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
1154                 " ?switches? name ?name ...?\"", (char *) NULL);
1155         return TCL_ERROR;
1156     }
1157
1158     Tcl_DStringInit(&buffer);
1159     separators = NULL;          /* Needed only to prevent gcc warnings. */
1160     for (i = firstArg; i < argc; i++) {
1161         switch (tclPlatform) {
1162         case TCL_PLATFORM_UNIX:
1163             separators = "/";
1164             break;
1165         case TCL_PLATFORM_WINDOWS:
1166             separators = "/\\:";
1167             break;
1168         case TCL_PLATFORM_MAC:
1169             separators = (strchr(argv[i], ':') == NULL) ? "/" : ":";
1170             break;
1171         }
1172
1173         Tcl_DStringSetLength(&buffer, 0);
1174
1175         /*
1176          * Perform tilde substitution, if needed.
1177          */
1178
1179         if (argv[i][0] == '~') {
1180             char *p;
1181
1182             /*
1183              * Find the first path separator after the tilde.
1184              */
1185
1186             for (tail = argv[i]; *tail != '\0'; tail++) {
1187                 if (*tail == '\\') {
1188                     if (strchr(separators, tail[1]) != NULL) {
1189                         break;
1190                     }
1191                 } else if (strchr(separators, *tail) != NULL) {
1192                     break;
1193                 }
1194             }
1195
1196             /*
1197              * Determine the home directory for the specified user.  Note that
1198              * we don't allow special characters in the user name.
1199              */
1200
1201             c = *tail;
1202             *tail = '\0';
1203             p = strpbrk(argv[i]+1, "\\[]*?{}");
1204             if (p == NULL) {
1205                 head = DoTildeSubst(interp, argv[i]+1, &buffer);
1206             } else {
1207                 if (!noComplain) {
1208                     Tcl_ResetResult(interp);
1209                     Tcl_AppendResult(interp, "globbing characters not ",
1210                             "supported in user names", (char *) NULL);
1211                 }
1212                 head = NULL;
1213             }
1214             *tail = c;
1215             if (head == NULL) {
1216                 if (noComplain) {
1217                     Tcl_ResetResult(interp);
1218                     continue;
1219                 } else {
1220                     result = TCL_ERROR;
1221                     goto done;
1222                 }
1223             }
1224             if (head != Tcl_DStringValue(&buffer)) {
1225                 Tcl_DStringAppend(&buffer, head, -1);
1226             }
1227         } else {
1228             tail = argv[i];
1229         }
1230
1231         result = TclDoGlob(interp, separators, &buffer, tail);
1232         if (result != TCL_OK) {
1233             if (noComplain) {
1234                 /*
1235                  * We should in fact pass down the nocomplain flag
1236                  * or save the interp result or use another mecanism
1237                  * so the interp result is not mangled on errors in that case.
1238                  * but that would a bigger change than reasonable for a patch
1239                  * release.
1240                  * (see fileName.test 15.2-15.4 for expected behaviour)
1241                  */
1242                 Tcl_ResetResult(interp);
1243                 result = TCL_OK;
1244                 continue;
1245             } else {
1246                 goto done;
1247             }
1248         }
1249     }
1250
1251     if ((*interp->result == 0) && !noComplain) {
1252         char *sep = "";
1253
1254         Tcl_AppendResult(interp, "no files matched glob pattern",
1255                 (argc == 2) ? " \"" : "s \"", (char *) NULL);
1256         for (i = firstArg; i < argc; i++) {
1257             Tcl_AppendResult(interp, sep, argv[i], (char *) NULL);
1258             sep = " ";
1259         }
1260         Tcl_AppendResult(interp, "\"", (char *) NULL);
1261         result = TCL_ERROR;
1262     }
1263 done:
1264     Tcl_DStringFree(&buffer);
1265     return result;
1266 }
1267 \f
1268 /*
1269  *----------------------------------------------------------------------
1270  *
1271  * SkipToChar --
1272  *
1273  *      This function traverses a glob pattern looking for the next
1274  *      unquoted occurance of the specified character at the same braces
1275  *      nesting level.
1276  *
1277  * Results:
1278  *      Updates stringPtr to point to the matching character, or to
1279  *      the end of the string if nothing matched.  The return value
1280  *      is 1 if a match was found at the top level, otherwise it is 0.
1281  *
1282  * Side effects:
1283  *      None.
1284  *
1285  *----------------------------------------------------------------------
1286  */
1287
1288 static int
1289 SkipToChar(stringPtr, match)
1290     char **stringPtr;                   /* Pointer string to check. */
1291     char *match;                        /* Pointer to character to find. */
1292 {
1293     int quoted, level;
1294     register char *p;
1295
1296     quoted = 0;
1297     level = 0;
1298
1299     for (p = *stringPtr; *p != '\0'; p++) {
1300         if (quoted) {
1301             quoted = 0;
1302             continue;
1303         }
1304         if ((level == 0) && (*p == *match)) {
1305             *stringPtr = p;
1306             return 1;
1307         }
1308         if (*p == '{') {
1309             level++;
1310         } else if (*p == '}') {
1311             level--;
1312         } else if (*p == '\\') {
1313             quoted = 1;
1314         }
1315     }
1316     *stringPtr = p;
1317     return 0;
1318 }
1319 \f
1320 /*
1321  *----------------------------------------------------------------------
1322  *
1323  * TclDoGlob --
1324  *
1325  *      This recursive procedure forms the heart of the globbing
1326  *      code.  It performs a depth-first traversal of the tree
1327  *      given by the path name to be globbed.  The directory and
1328  *      remainder are assumed to be native format paths.
1329  *
1330  * Results:
1331  *      The return value is a standard Tcl result indicating whether
1332  *      an error occurred in globbing.  After a normal return the
1333  *      result in interp will be set to hold all of the file names
1334  *      given by the dir and rem arguments.  After an error the
1335  *      result in interp will hold an error message.
1336  *
1337  * Side effects:
1338  *      None.
1339  *
1340  *----------------------------------------------------------------------
1341  */
1342
1343 int
1344 TclDoGlob(interp, separators, headPtr, tail)
1345     Tcl_Interp *interp;         /* Interpreter to use for error reporting
1346                                  * (e.g. unmatched brace). */
1347     char *separators;           /* String containing separator characters
1348                                  * that should be used to identify globbing
1349                                  * boundaries. */
1350     Tcl_DString *headPtr;       /* Completely expanded prefix. */
1351     char *tail;                 /* The unexpanded remainder of the path. */
1352 {
1353     int baseLength, quoted, count;
1354     int result = TCL_OK;
1355     char *p, *openBrace, *closeBrace, *name, *firstSpecialChar, savedChar;
1356     char lastChar = 0;
1357     int length = Tcl_DStringLength(headPtr);
1358
1359     if (length > 0) {
1360         lastChar = Tcl_DStringValue(headPtr)[length-1];
1361     }
1362
1363     /*
1364      * Consume any leading directory separators, leaving tail pointing
1365      * just past the last initial separator.
1366      */
1367
1368     count = 0;
1369     name = tail;
1370     for (; *tail != '\0'; tail++) {
1371         if ((*tail == '\\') && (strchr(separators, tail[1]) != NULL)) {
1372             tail++;
1373         } else if (strchr(separators, *tail) == NULL) {
1374             break;
1375         }
1376         count++;
1377     }
1378
1379     /*
1380      * Deal with path separators.  On the Mac, we have to watch out
1381      * for multiple separators, since they are special in Mac-style
1382      * paths.
1383      */
1384
1385     switch (tclPlatform) {
1386         case TCL_PLATFORM_MAC:
1387             if (*separators == '/') {
1388                 if (((length == 0) && (count == 0))
1389                         || ((length > 0) && (lastChar != ':'))) {
1390                     Tcl_DStringAppend(headPtr, ":", 1);
1391                 }
1392             } else {
1393                 if (count == 0) {
1394                     if ((length > 0) && (lastChar != ':')) {
1395                         Tcl_DStringAppend(headPtr, ":", 1);
1396                     }
1397                 } else {
1398                     if (lastChar == ':') {
1399                         count--;
1400                     }
1401                     while (count-- > 0) {
1402                         Tcl_DStringAppend(headPtr, ":", 1);
1403                     }
1404                 }
1405             }
1406             break;
1407         case TCL_PLATFORM_WINDOWS:
1408             /*
1409              * If this is a drive relative path, add the colon and the
1410              * trailing slash if needed.  Otherwise add the slash if
1411              * this is the first absolute element, or a later relative
1412              * element.  Add an extra slash if this is a UNC path.
1413              */
1414
1415             if (*name == ':') {
1416                 Tcl_DStringAppend(headPtr, ":", 1);
1417                 if (count > 1) {
1418                     Tcl_DStringAppend(headPtr, "/", 1);
1419                 }
1420             } else if ((*tail != '\0')
1421                     && (((length > 0)
1422                             && (strchr(separators, lastChar) == NULL))
1423                             || ((length == 0) && (count > 0)))) {
1424                 Tcl_DStringAppend(headPtr, "/", 1);
1425                 if ((length == 0) && (count > 1)) {
1426                     Tcl_DStringAppend(headPtr, "/", 1);
1427                 }
1428             }
1429
1430             break;
1431         case TCL_PLATFORM_UNIX:
1432             /*
1433              * Add a separator if this is the first absolute element, or
1434              * a later relative element.
1435              */
1436
1437             if ((*tail != '\0')
1438                     && (((length > 0)
1439                             && (strchr(separators, lastChar) == NULL))
1440                             || ((length == 0) && (count > 0)))) {
1441                 Tcl_DStringAppend(headPtr, "/", 1);
1442             }
1443             break;
1444     }
1445
1446     /*
1447      * Look for the first matching pair of braces or the first
1448      * directory separator that is not inside a pair of braces.
1449      */
1450
1451     openBrace = closeBrace = NULL;
1452     quoted = 0;
1453     for (p = tail; *p != '\0'; p++) {
1454         if (quoted) {
1455             quoted = 0;
1456         } else if (*p == '\\') {
1457             quoted = 1;
1458             if (strchr(separators, p[1]) != NULL) {
1459                 break;                  /* Quoted directory separator. */
1460             }
1461         } else if (strchr(separators, *p) != NULL) {
1462             break;                      /* Unquoted directory separator. */
1463         } else if (*p == '{') {
1464             openBrace = p;
1465             p++;
1466             if (SkipToChar(&p, "}")) {
1467                 closeBrace = p;         /* Balanced braces. */
1468                 break;
1469             }
1470             Tcl_SetResult(interp, "unmatched open-brace in file name",
1471                     TCL_STATIC);
1472             return TCL_ERROR;
1473         } else if (*p == '}') {
1474             Tcl_SetResult(interp, "unmatched close-brace in file name",
1475                     TCL_STATIC);
1476             return TCL_ERROR;
1477         }
1478     }
1479
1480     /*
1481      * Substitute the alternate patterns from the braces and recurse.
1482      */
1483
1484     if (openBrace != NULL) {
1485         char *element;
1486         Tcl_DString newName;
1487         Tcl_DStringInit(&newName);
1488
1489         /*
1490          * For each element within in the outermost pair of braces,
1491          * append the element and the remainder to the fixed portion
1492          * before the first brace and recursively call TclDoGlob.
1493          */
1494
1495         Tcl_DStringAppend(&newName, tail, openBrace-tail);
1496         baseLength = Tcl_DStringLength(&newName);
1497         length = Tcl_DStringLength(headPtr);
1498         *closeBrace = '\0';
1499         for (p = openBrace; p != closeBrace; ) {
1500             p++;
1501             element = p;
1502             SkipToChar(&p, ",");
1503             Tcl_DStringSetLength(headPtr, length);
1504             Tcl_DStringSetLength(&newName, baseLength);
1505             Tcl_DStringAppend(&newName, element, p-element);
1506             Tcl_DStringAppend(&newName, closeBrace+1, -1);
1507             result = TclDoGlob(interp, separators,
1508                     headPtr, Tcl_DStringValue(&newName));
1509             if (result != TCL_OK) {
1510                 break;
1511             }
1512         }
1513         *closeBrace = '}';
1514         Tcl_DStringFree(&newName);
1515         return result;
1516     }
1517
1518     /*
1519      * At this point, there are no more brace substitutions to perform on
1520      * this path component.  The variable p is pointing at a quoted or
1521      * unquoted directory separator or the end of the string.  So we need
1522      * to check for special globbing characters in the current pattern.
1523      * We avoid modifying tail if p is pointing at the end of the string.
1524      */
1525
1526     if (*p != '\0') {
1527          savedChar = *p;
1528          *p = '\0';
1529          firstSpecialChar = strpbrk(tail, "*[]?\\");
1530          *p = savedChar;
1531     } else {
1532         firstSpecialChar = strpbrk(tail, "*[]?\\");
1533     }
1534
1535     if (firstSpecialChar != NULL) {
1536         /*
1537          * Look for matching files in the current directory.  The
1538          * implementation of this function is platform specific, but may
1539          * recursively call TclDoGlob.  For each file that matches, it will
1540          * add the match onto the interp->result, or call TclDoGlob if there
1541          * are more characters to be processed.
1542          */
1543
1544         return TclMatchFiles(interp, separators, headPtr, tail, p);
1545     }
1546     Tcl_DStringAppend(headPtr, tail, p-tail);
1547     if (*p != '\0') {
1548         return TclDoGlob(interp, separators, headPtr, p);
1549     }
1550
1551     /*
1552      * There are no more wildcards in the pattern and no more unprocessed
1553      * characters in the tail, so now we can construct the path and verify
1554      * the existence of the file.
1555      */
1556
1557     switch (tclPlatform) {
1558         case TCL_PLATFORM_MAC:
1559             if (strchr(Tcl_DStringValue(headPtr), ':') == NULL) {
1560                 Tcl_DStringAppend(headPtr, ":", 1);
1561             }
1562             name = Tcl_DStringValue(headPtr);
1563             if (TclAccess(name, F_OK) == 0) {
1564                 if ((name[1] != '\0') && (strchr(name+1, ':') == NULL)) {
1565                     Tcl_AppendElement(interp, name+1);
1566                 } else {
1567                     Tcl_AppendElement(interp, name);
1568                 }
1569             }
1570             break;
1571         case TCL_PLATFORM_WINDOWS: {
1572             int exists;
1573 #ifndef __CYGWIN__
1574             /*
1575              * We need to convert slashes to backslashes before checking
1576              * for the existence of the file.  Once we are done, we need
1577              * to convert the slashes back.
1578              */
1579
1580             if (Tcl_DStringLength(headPtr) == 0) {
1581                 if (((*name == '\\') && (name[1] == '/' || name[1] == '\\'))
1582                         || (*name == '/')) {
1583                     Tcl_DStringAppend(headPtr, "\\", 1);
1584                 } else {
1585                     Tcl_DStringAppend(headPtr, ".", 1);
1586                 }
1587             } else {
1588                 for (p = Tcl_DStringValue(headPtr); *p != '\0'; p++) {
1589                     if (*p == '/') {
1590                         *p = '\\';
1591                     }
1592                 }
1593             }
1594 #endif
1595             name = Tcl_DStringValue(headPtr);
1596             exists = (TclAccess(name, F_OK) == 0);
1597             for (p = name; *p != '\0'; p++) {
1598                 if (*p == '\\') {
1599                     *p = '/';
1600                 }
1601             }
1602             if (exists) {
1603                 Tcl_AppendElement(interp, name);
1604             }
1605             break;
1606         }
1607         case TCL_PLATFORM_UNIX:
1608             if (Tcl_DStringLength(headPtr) == 0) {
1609                 if ((*name == '\\' && name[1] == '/') || (*name == '/')) {
1610                     Tcl_DStringAppend(headPtr, "/", 1);
1611                 } else {
1612                     Tcl_DStringAppend(headPtr, ".", 1);
1613                 }
1614             }
1615             name = Tcl_DStringValue(headPtr);
1616             if (TclAccess(name, F_OK) == 0) {
1617                 Tcl_AppendElement(interp, name);
1618             }
1619             break;
1620     }
1621
1622     return TCL_OK;
1623 }