root/tcl-8.0/trunk/generic/tclFileName.c @ 1147

Revision 1147, 40.1 KB (checked in by ucacoxh, 14 years ago)

- print name of environment variable not found on win32 (HOMEDIR, not

HOME) so user can figure out what is actually wrong when it fails.

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