OpenCores
URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tcl/] [generic/] [tclFileName.c] - Blame information for rev 1765

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom
/*
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: tclFileName.c,v 1.1.1.1 2002-01-16 10:25:27 markom Exp $
13
 */
14
 
15
#include "tclInt.h"
16
#include "tclPort.h"
17
#include "tclRegexp.h"
18
 
19
/*
20
 * This variable indicates whether the cleanup procedure has been
21
 * registered for this file yet.
22
 */
23
 
24
static int initialized = 0;
25
 
26
/*
27
 * The following regular expression matches the root portion of a Windows
28
 * absolute or volume relative path.  It will match both UNC and drive relative
29
 * paths.
30
 */
31
 
32
#define WIN_ROOT_PATTERN "^(([a-zA-Z]:)|[/\\][/\\]+([^/\\]+)[/\\]+([^/\\]+)|([/\\]))([/\\])*"
33
 
34
/*
35
 * The following regular expression matches the root portion of a Macintosh
36
 * absolute path.  It will match degenerate Unix-style paths, tilde paths,
37
 * Unix-style paths, and Mac paths.
38
 */
39
 
40
#define MAC_ROOT_PATTERN "^((/+([.][.]?/+)*([.][.]?)?)|(~[^:/]*)(/[^:]*)?|(~[^:]*)(:.*)?|/+([.][.]?/+)*([^:/]+)(/[^:]*)?|([^:]+):.*)$"
41
 
42
/*
43
 * The following variables are used to hold precompiled regular expressions
44
 * for use in filename matching.
45
 */
46
 
47
static regexp *winRootPatternPtr = NULL;
48
static regexp *macRootPatternPtr = NULL;
49
 
50
/*
51
 * The following variable is set in the TclPlatformInit call to one
52
 * of: TCL_PLATFORM_UNIX, TCL_PLATFORM_MAC, or TCL_PLATFORM_WINDOWS.
53
 */
54
 
55
TclPlatformType tclPlatform = TCL_PLATFORM_UNIX;
56
 
57
/*
58
 * Prototypes for local procedures defined in this file:
59
 */
60
 
61
static char *           DoTildeSubst _ANSI_ARGS_((Tcl_Interp *interp,
62
                            char *user, Tcl_DString *resultPtr));
63
static char *           ExtractWinRoot _ANSI_ARGS_((char *path,
64
                            Tcl_DString *resultPtr, int offset));
65
static void             FileNameCleanup _ANSI_ARGS_((ClientData clientData));
66
static int              SkipToChar _ANSI_ARGS_((char **stringPtr,
67
                            char *match));
68
static char *           SplitMacPath _ANSI_ARGS_((char *path,
69
                            Tcl_DString *bufPtr));
70
static char *           SplitWinPath _ANSI_ARGS_((char *path,
71
                            Tcl_DString *bufPtr));
72
static char *           SplitUnixPath _ANSI_ARGS_((char *path,
73
                            Tcl_DString *bufPtr));
74
 
75
/*
76
 *----------------------------------------------------------------------
77
 *
78
 * FileNameCleanup --
79
 *
80
 *      This procedure is a Tcl_ExitProc used to clean up the static
81
 *      data structures used in this file.
82
 *
83
 * Results:
84
 *      None.
85
 *
86
 * Side effects:
87
 *      Deallocates storage used by the procedures in this file.
88
 *
89
 *----------------------------------------------------------------------
90
 */
91
 
92
static void
93
FileNameCleanup(clientData)
94
    ClientData clientData;      /* Not used. */
95
{
96
    if (winRootPatternPtr != NULL) {
97
        ckfree((char *)winRootPatternPtr);
98
        winRootPatternPtr = (regexp *) NULL;
99
    }
100
    if (macRootPatternPtr != NULL) {
101
        ckfree((char *)macRootPatternPtr);
102
        macRootPatternPtr = (regexp *) NULL;
103
    }
104
    initialized = 0;
105
}
106
 
107
/*
108
 *----------------------------------------------------------------------
109
 *
110
 * ExtractWinRoot --
111
 *
112
 *      Matches the root portion of a Windows path and appends it
113
 *      to the specified Tcl_DString.
114
 *
115
 * Results:
116
 *      Returns the position in the path immediately after the root
117
 *      including any trailing slashes.
118
 *      Appends a cleaned up version of the root to the Tcl_DString
119
 *      at the specified offest.
120
 *
121
 * Side effects:
122
 *      Modifies the specified Tcl_DString.
123
 *
124
 *----------------------------------------------------------------------
125
 */
126
 
127
static char *
128
ExtractWinRoot(path, resultPtr, offset)
129
    char *path;                 /* Path to parse. */
130
    Tcl_DString *resultPtr;     /* Buffer to hold result. */
131
    int offset;                 /* Offset in buffer where result should be
132
                                 * stored. */
133
{
134
    int length;
135
 
136
    /*
137
     * Initialize the path name parser for Windows path names.
138
     */
139
 
140
    if (winRootPatternPtr == NULL) {
141
        winRootPatternPtr = TclRegComp(WIN_ROOT_PATTERN);
142
        if (!initialized) {
143
            Tcl_CreateExitHandler(FileNameCleanup, NULL);
144
            initialized = 1;
145
        }
146
    }
147
 
148
    /*
149
     * Match the root portion of a Windows path name.
150
     */
151
 
152
    if (!TclRegExec(winRootPatternPtr, path, path)) {
153
        return path;
154
    }
155
 
156
    Tcl_DStringSetLength(resultPtr, offset);
157
 
158
    if (winRootPatternPtr->startp[2] != NULL) {
159
        Tcl_DStringAppend(resultPtr, winRootPatternPtr->startp[2], 2);
160
        if (winRootPatternPtr->startp[6] != NULL) {
161
            Tcl_DStringAppend(resultPtr, "/", 1);
162
        }
163
    } else if (winRootPatternPtr->startp[4] != NULL) {
164
        Tcl_DStringAppend(resultPtr, "//", 2);
165
        length = winRootPatternPtr->endp[3]
166
            - winRootPatternPtr->startp[3];
167
        Tcl_DStringAppend(resultPtr, winRootPatternPtr->startp[3], length);
168
        Tcl_DStringAppend(resultPtr, "/", 1);
169
        length = winRootPatternPtr->endp[4]
170
            - winRootPatternPtr->startp[4];
171
        Tcl_DStringAppend(resultPtr, winRootPatternPtr->startp[4], length);
172
    } else {
173
        Tcl_DStringAppend(resultPtr, "/", 1);
174
    }
175
    return winRootPatternPtr->endp[0];
176
}
177
 
178
/*
179
 *----------------------------------------------------------------------
180
 *
181
 * Tcl_GetPathType --
182
 *
183
 *      Determines whether a given path is relative to the current
184
 *      directory, relative to the current volume, or absolute.
185
 *
186
 * Results:
187
 *      Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or
188
 *      TCL_PATH_VOLUME_RELATIVE.
189
 *
190
 * Side effects:
191
 *      None.
192
 *
193
 *----------------------------------------------------------------------
194
 */
195
 
196
Tcl_PathType
197
Tcl_GetPathType(path)
198
    char *path;
199
{
200
    Tcl_PathType type = TCL_PATH_ABSOLUTE;
201
 
202
    switch (tclPlatform) {
203
        case TCL_PLATFORM_UNIX:
204
            /*
205
             * Paths that begin with / or ~ are absolute.
206
             */
207
 
208
            if ((path[0] != '/') && (path[0] != '~')) {
209
                type = TCL_PATH_RELATIVE;
210
            }
211
            break;
212
 
213
        case TCL_PLATFORM_MAC:
214
            if (path[0] == ':') {
215
                type = TCL_PATH_RELATIVE;
216
            } else if (path[0] != '~') {
217
 
218
                /*
219
                 * Since we have eliminated the easy cases, use the
220
                 * root pattern to look for the other types.
221
                 */
222
 
223
                if (!macRootPatternPtr) {
224
                    macRootPatternPtr = TclRegComp(MAC_ROOT_PATTERN);
225
                    if (!initialized) {
226
                        Tcl_CreateExitHandler(FileNameCleanup, NULL);
227
                        initialized = 1;
228
                    }
229
                }
230
                if (!TclRegExec(macRootPatternPtr, path, path)
231
                        || (macRootPatternPtr->startp[2] != NULL)) {
232
                    type = TCL_PATH_RELATIVE;
233
                }
234
            }
235
            break;
236
 
237
        case TCL_PLATFORM_WINDOWS:
238
            if (path[0] != '~') {
239
 
240
                /*
241
                 * Since we have eliminated the easy cases, check for
242
                 * drive relative paths using the regular expression.
243
                 */
244
 
245
                if (!winRootPatternPtr) {
246
                    winRootPatternPtr = TclRegComp(WIN_ROOT_PATTERN);
247
                    if (!initialized) {
248
                        Tcl_CreateExitHandler(FileNameCleanup, NULL);
249
                        initialized = 1;
250
                    }
251
                }
252
                if (TclRegExec(winRootPatternPtr, path, path)) {
253
                    if (winRootPatternPtr->startp[5]
254
                            || (winRootPatternPtr->startp[2]
255
                                    && !(winRootPatternPtr->startp[6]))) {
256
                        type = TCL_PATH_VOLUME_RELATIVE;
257
                    }
258
                } else {
259
                    type = TCL_PATH_RELATIVE;
260
                }
261
            }
262
            break;
263
    }
264
    return type;
265
}
266
 
267
/*
268
 *----------------------------------------------------------------------
269
 *
270
 * Tcl_SplitPath --
271
 *
272
 *      Split a path into a list of path components.  The first element
273
 *      of the list will have the same path type as the original path.
274
 *
275
 * Results:
276
 *      Returns a standard Tcl result.  The interpreter result contains
277
 *      a list of path components.
278
 *      *argvPtr will be filled in with the address of an array
279
 *      whose elements point to the elements of path, in order.
280
 *      *argcPtr will get filled in with the number of valid elements
281
 *      in the array.  A single block of memory is dynamically allocated
282
 *      to hold both the argv array and a copy of the path elements.
283
 *      The caller must eventually free this memory by calling ckfree()
284
 *      on *argvPtr.  Note:  *argvPtr and *argcPtr are only modified
285
 *      if the procedure returns normally.
286
 *
287
 * Side effects:
288
 *      Allocates memory.
289
 *
290
 *----------------------------------------------------------------------
291
 */
292
 
293
void
294
Tcl_SplitPath(path, argcPtr, argvPtr)
295
    char *path;                 /* Pointer to string containing a path. */
296
    int *argcPtr;               /* Pointer to location to fill in with
297
                                 * the number of elements in the path. */
298
    char ***argvPtr;            /* Pointer to place to store pointer to array
299
                                 * of pointers to path elements. */
300
{
301
    int i, size;
302
    char *p;
303
    Tcl_DString buffer;
304
    Tcl_DStringInit(&buffer);
305
 
306
    /*
307
     * Perform platform specific splitting.  These routines will leave the
308
     * result in the specified buffer.  Individual elements are terminated
309
     * with a null character.
310
     */
311
 
312
    p = NULL;                   /* Needed only to prevent gcc warnings. */
313
    switch (tclPlatform) {
314
        case TCL_PLATFORM_UNIX:
315
            p = SplitUnixPath(path, &buffer);
316
            break;
317
 
318
        case TCL_PLATFORM_WINDOWS:
319
            p = SplitWinPath(path, &buffer);
320
            break;
321
 
322
        case TCL_PLATFORM_MAC:
323
            p = SplitMacPath(path, &buffer);
324
            break;
325
    }
326
 
327
    /*
328
     * Compute the number of elements in the result.
329
     */
330
 
331
    size = Tcl_DStringLength(&buffer);
332
    *argcPtr = 0;
333
    for (i = 0; i < size; i++) {
334
        if (p[i] == '\0') {
335
            (*argcPtr)++;
336
        }
337
    }
338
 
339
    /*
340
     * Allocate a buffer large enough to hold the contents of the
341
     * DString plus the argv pointers and the terminating NULL pointer.
342
     */
343
 
344
    *argvPtr = (char **) ckalloc((unsigned)
345
            ((((*argcPtr) + 1) * sizeof(char *)) + size));
346
 
347
    /*
348
     * Position p after the last argv pointer and copy the contents of
349
     * the DString.
350
     */
351
 
352
    p = (char *) &(*argvPtr)[(*argcPtr) + 1];
353
    memcpy((VOID *) p, (VOID *) Tcl_DStringValue(&buffer), (size_t) size);
354
 
355
    /*
356
     * Now set up the argv pointers.
357
     */
358
 
359
    for (i = 0; i < *argcPtr; i++) {
360
        (*argvPtr)[i] = p;
361
        while ((*p++) != '\0') {}
362
    }
363
    (*argvPtr)[i] = NULL;
364
 
365
    Tcl_DStringFree(&buffer);
366
}
367
 
368
/*
369
 *----------------------------------------------------------------------
370
 *
371
 * SplitUnixPath --
372
 *
373
 *      This routine is used by Tcl_SplitPath to handle splitting
374
 *      Unix paths.
375
 *
376
 * Results:
377
 *      Stores a null separated array of strings in the specified
378
 *      Tcl_DString.
379
 *
380
 * Side effects:
381
 *      None.
382
 *
383
 *----------------------------------------------------------------------
384
 */
385
 
386
static char *
387
SplitUnixPath(path, bufPtr)
388
    char *path;                 /* Pointer to string containing a path. */
389
    Tcl_DString *bufPtr;        /* Pointer to DString to use for the result. */
390
{
391
    int length;
392
    char *p, *elementStart;
393
 
394
    /*
395
     * Deal with the root directory as a special case.
396
     */
397
 
398
    if (path[0] == '/') {
399
        Tcl_DStringAppend(bufPtr, "/", 2);
400
        p = path+1;
401
    } else {
402
        p = path;
403
    }
404
 
405
    /*
406
     * Split on slashes.  Embedded elements that start with tilde will be
407
     * prefixed with "./" so they are not affected by tilde substitution.
408
     */
409
 
410
    for (;;) {
411
        elementStart = p;
412
        while ((*p != '\0') && (*p != '/')) {
413
            p++;
414
        }
415
        length = p - elementStart;
416
        if (length > 0) {
417
            if ((elementStart[0] == '~') && (elementStart != path)) {
418
                Tcl_DStringAppend(bufPtr, "./", 2);
419
            }
420
            Tcl_DStringAppend(bufPtr, elementStart, length);
421
            Tcl_DStringAppend(bufPtr, "", 1);
422
        }
423
        if (*p++ == '\0') {
424
            break;
425
        }
426
    }
427
    return Tcl_DStringValue(bufPtr);
428
}
429
 
430
/*
431
 *----------------------------------------------------------------------
432
 *
433
 * SplitWinPath --
434
 *
435
 *      This routine is used by Tcl_SplitPath to handle splitting
436
 *      Windows paths.
437
 *
438
 * Results:
439
 *      Stores a null separated array of strings in the specified
440
 *      Tcl_DString.
441
 *
442
 * Side effects:
443
 *      None.
444
 *
445
 *----------------------------------------------------------------------
446
 */
447
 
448
static char *
449
SplitWinPath(path, bufPtr)
450
    char *path;                 /* Pointer to string containing a path. */
451
    Tcl_DString *bufPtr;        /* Pointer to DString to use for the result. */
452
{
453
    int length;
454
    char *p, *elementStart;
455
 
456
    p = ExtractWinRoot(path, bufPtr, 0);
457
 
458
    /*
459
     * Terminate the root portion, if we matched something.
460
     */
461
 
462
    if (p != path) {
463
        Tcl_DStringAppend(bufPtr, "", 1);
464
    }
465
 
466
    /*
467
     * Split on slashes.  Embedded elements that start with tilde will be
468
     * prefixed with "./" so they are not affected by tilde substitution.
469
     */
470
 
471
    do {
472
        elementStart = p;
473
        while ((*p != '\0') && (*p != '/') && (*p != '\\')) {
474
            p++;
475
        }
476
        length = p - elementStart;
477
        if (length > 0) {
478
            if ((elementStart[0] == '~') && (elementStart != path)) {
479
                Tcl_DStringAppend(bufPtr, "./", 2);
480
            }
481
            Tcl_DStringAppend(bufPtr, elementStart, length);
482
            Tcl_DStringAppend(bufPtr, "", 1);
483
        }
484
    } while (*p++ != '\0');
485
 
486
    return Tcl_DStringValue(bufPtr);
487
}
488
 
489
/*
490
 *----------------------------------------------------------------------
491
 *
492
 * SplitMacPath --
493
 *
494
 *      This routine is used by Tcl_SplitPath to handle splitting
495
 *      Macintosh paths.
496
 *
497
 * Results:
498
 *      Returns a newly allocated argv array.
499
 *
500
 * Side effects:
501
 *      None.
502
 *
503
 *----------------------------------------------------------------------
504
 */
505
 
506
static char *
507
SplitMacPath(path, bufPtr)
508
    char *path;                 /* Pointer to string containing a path. */
509
    Tcl_DString *bufPtr;        /* Pointer to DString to use for the result. */
510
{
511
    int isMac = 0;               /* 1 if is Mac-style, 0 if Unix-style path. */
512
    int i, length;
513
    char *p, *elementStart;
514
 
515
    /*
516
     * Initialize the path name parser for Macintosh path names.
517
     */
518
 
519
    if (macRootPatternPtr == NULL) {
520
        macRootPatternPtr = TclRegComp(MAC_ROOT_PATTERN);
521
        if (!initialized) {
522
            Tcl_CreateExitHandler(FileNameCleanup, NULL);
523
            initialized = 1;
524
        }
525
    }
526
 
527
    /*
528
     * Match the root portion of a Mac path name.
529
     */
530
 
531
    i = 0;                       /* Needed only to prevent gcc warnings. */
532
    if (TclRegExec(macRootPatternPtr, path, path) == 1) {
533
        /*
534
         * Treat degenerate absolute paths like / and /../.. as
535
         * Mac relative file names for lack of anything else to do.
536
         */
537
 
538
        if (macRootPatternPtr->startp[2] != NULL) {
539
            Tcl_DStringAppend(bufPtr, ":", 1);
540
            Tcl_DStringAppend(bufPtr, path, macRootPatternPtr->endp[0]
541
                    - macRootPatternPtr->startp[0] + 1);
542
            return Tcl_DStringValue(bufPtr);
543
        }
544
 
545
        if (macRootPatternPtr->startp[5] != NULL) {
546
 
547
            /*
548
             * Unix-style tilde prefixed paths.
549
             */
550
 
551
            isMac = 0;
552
            i = 5;
553
        } else if (macRootPatternPtr->startp[7] != NULL) {
554
 
555
            /*
556
             * Mac-style tilde prefixed paths.
557
             */
558
 
559
            isMac = 1;
560
            i = 7;
561
        } else if (macRootPatternPtr->startp[10] != NULL) {
562
 
563
            /*
564
             * Normal Unix style paths.
565
             */
566
 
567
            isMac = 0;
568
            i = 10;
569
        } else if (macRootPatternPtr->startp[12] != NULL) {
570
 
571
            /*
572
             * Normal Mac style paths.
573
             */
574
 
575
            isMac = 1;
576
            i = 12;
577
        }
578
 
579
        length = macRootPatternPtr->endp[i]
580
            - macRootPatternPtr->startp[i];
581
 
582
        /*
583
         * Append the element and terminate it with a : and a null.  Note that
584
         * we are forcing the DString to contain an extra null at the end.
585
         */
586
 
587
        Tcl_DStringAppend(bufPtr, macRootPatternPtr->startp[i], length);
588
        Tcl_DStringAppend(bufPtr, ":", 2);
589
        p = macRootPatternPtr->endp[i];
590
    } else {
591
        isMac = (strchr(path, ':') != NULL);
592
        p = path;
593
    }
594
 
595
    if (isMac) {
596
 
597
        /*
598
         * p is pointing at the first colon in the path.  There
599
         * will always be one, since this is a Mac-style path.
600
         */
601
 
602
        elementStart = p++;
603
        while ((p = strchr(p, ':')) != NULL) {
604
            length = p - elementStart;
605
            if (length == 1) {
606
                while (*p == ':') {
607
                    Tcl_DStringAppend(bufPtr, "::", 3);
608
                    elementStart = p++;
609
                }
610
            } else {
611
                /*
612
                 * If this is a simple component, drop the leading colon.
613
                 */
614
 
615
                if ((elementStart[1] != '~')
616
                        && (strchr(elementStart+1, '/') == NULL)) {
617
                    elementStart++;
618
                    length--;
619
                }
620
                Tcl_DStringAppend(bufPtr, elementStart, length);
621
                Tcl_DStringAppend(bufPtr, "", 1);
622
                elementStart = p++;
623
            }
624
        }
625
        if (elementStart[1] != '\0' || elementStart == path) {
626
            if ((elementStart[1] != '~') && (elementStart[1] != '\0')
627
                        && (strchr(elementStart+1, '/') == NULL)) {
628
                    elementStart++;
629
            }
630
            Tcl_DStringAppend(bufPtr, elementStart, -1);
631
            Tcl_DStringAppend(bufPtr, "", 1);
632
        }
633
    } else {
634
 
635
        /*
636
         * Split on slashes, suppress extra /'s, and convert .. to ::.
637
         */
638
 
639
        for (;;) {
640
            elementStart = p;
641
            while ((*p != '\0') && (*p != '/')) {
642
                p++;
643
            }
644
            length = p - elementStart;
645
            if (length > 0) {
646
                if ((length == 1) && (elementStart[0] == '.')) {
647
                    Tcl_DStringAppend(bufPtr, ":", 2);
648
                } else if ((length == 2) && (elementStart[0] == '.')
649
                        && (elementStart[1] == '.')) {
650
                    Tcl_DStringAppend(bufPtr, "::", 3);
651
                } else {
652
                    if (*elementStart == '~') {
653
                        Tcl_DStringAppend(bufPtr, ":", 1);
654
                    }
655
                    Tcl_DStringAppend(bufPtr, elementStart, length);
656
                    Tcl_DStringAppend(bufPtr, "", 1);
657
                }
658
            }
659
            if (*p++ == '\0') {
660
                break;
661
            }
662
        }
663
    }
664
    return Tcl_DStringValue(bufPtr);
665
}
666
 
667
/*
668
 *----------------------------------------------------------------------
669
 *
670
 * Tcl_JoinPath --
671
 *
672
 *      Combine a list of paths in a platform specific manner.
673
 *
674
 * Results:
675
 *      Appends the joined path to the end of the specified
676
 *      returning a pointer to the resulting string.  Note that
677
 *      the Tcl_DString must already be initialized.
678
 *
679
 * Side effects:
680
 *      Modifies the Tcl_DString.
681
 *
682
 *----------------------------------------------------------------------
683
 */
684
 
685
char *
686
Tcl_JoinPath(argc, argv, resultPtr)
687
    int argc;
688
    char **argv;
689
    Tcl_DString *resultPtr;     /* Pointer to previously initialized DString. */
690
{
691
    int oldLength, length, i, needsSep;
692
    Tcl_DString buffer;
693
    char *p, c, *dest;
694
 
695
    Tcl_DStringInit(&buffer);
696
    oldLength = Tcl_DStringLength(resultPtr);
697
 
698
    switch (tclPlatform) {
699
        case TCL_PLATFORM_UNIX:
700
            for (i = 0; i < argc; i++) {
701
                p = argv[i];
702
                /*
703
                 * If the path is absolute, reset the result buffer.
704
                 * Consume any duplicate leading slashes or a ./ in
705
                 * front of a tilde prefixed path that isn't at the
706
                 * beginning of the path.
707
                 */
708
 
709
                if (*p == '/') {
710
                    Tcl_DStringSetLength(resultPtr, oldLength);
711
                    Tcl_DStringAppend(resultPtr, "/", 1);
712
                    while (*p == '/') {
713
                        p++;
714
                    }
715
                } else if (*p == '~') {
716
                    Tcl_DStringSetLength(resultPtr, oldLength);
717
                } else if ((Tcl_DStringLength(resultPtr) != oldLength)
718
                        && (p[0] == '.') && (p[1] == '/')
719
                        && (p[2] == '~')) {
720
                    p += 2;
721
                }
722
 
723
                if (*p == '\0') {
724
                    continue;
725
                }
726
 
727
                /*
728
                 * Append a separator if needed.
729
                 */
730
 
731
                length = Tcl_DStringLength(resultPtr);
732
                if ((length != oldLength)
733
                        && (Tcl_DStringValue(resultPtr)[length-1] != '/')) {
734
                    Tcl_DStringAppend(resultPtr, "/", 1);
735
                    length++;
736
                }
737
 
738
                /*
739
                 * Append the element, eliminating duplicate and trailing
740
                 * slashes.
741
                 */
742
 
743
                Tcl_DStringSetLength(resultPtr, (int) (length + strlen(p)));
744
                dest = Tcl_DStringValue(resultPtr) + length;
745
                for (; *p != '\0'; p++) {
746
                    if (*p == '/') {
747
                        while (p[1] == '/') {
748
                            p++;
749
                        }
750
                        if (p[1] != '\0') {
751
                            *dest++ = '/';
752
                        }
753
                    } else {
754
                        *dest++ = *p;
755
                    }
756
                }
757
                length = dest - Tcl_DStringValue(resultPtr);
758
                Tcl_DStringSetLength(resultPtr, length);
759
            }
760
            break;
761
 
762
        case TCL_PLATFORM_WINDOWS:
763
            /*
764
             * Iterate over all of the components.  If a component is
765
             * absolute, then reset the result and start building the
766
             * path from the current component on.
767
             */
768
 
769
            for (i = 0; i < argc; i++) {
770
                p = ExtractWinRoot(argv[i], resultPtr, oldLength);
771
                length = Tcl_DStringLength(resultPtr);
772
 
773
                /*
774
                 * If the pointer didn't move, then this is a relative path
775
                 * or a tilde prefixed path.
776
                 */
777
 
778
                if (p == argv[i]) {
779
                    /*
780
                     * Remove the ./ from tilde prefixed elements unless
781
                     * it is the first component.
782
                     */
783
 
784
                    if ((length != oldLength)
785
                            && (p[0] == '.')
786
                            && ((p[1] == '/') || (p[1] == '\\'))
787
                            && (p[2] == '~')) {
788
                        p += 2;
789
                    } else if (*p == '~') {
790
                        Tcl_DStringSetLength(resultPtr, oldLength);
791
                        length = oldLength;
792
                    }
793
                }
794
 
795
                if (*p != '\0') {
796
                    /*
797
                     * Check to see if we need to append a separator.
798
                     */
799
 
800
 
801
                    if (length != oldLength) {
802
                        c = Tcl_DStringValue(resultPtr)[length-1];
803
                        if ((c != '/') && (c != ':')) {
804
                            Tcl_DStringAppend(resultPtr, "/", 1);
805
                        }
806
                    }
807
 
808
                    /*
809
                     * Append the element, eliminating duplicate and
810
                     * trailing slashes.
811
                     */
812
 
813
                    length = Tcl_DStringLength(resultPtr);
814
                    Tcl_DStringSetLength(resultPtr, (int) (length + strlen(p)));
815
                    dest = Tcl_DStringValue(resultPtr) + length;
816
                    for (; *p != '\0'; p++) {
817
                        if ((*p == '/') || (*p == '\\')) {
818
                            while ((p[1] == '/') || (p[1] == '\\')) {
819
                                p++;
820
                            }
821
                            if (p[1] != '\0') {
822
                                *dest++ = '/';
823
                            }
824
                        } else {
825
                            *dest++ = *p;
826
                        }
827
                    }
828
                    length = dest - Tcl_DStringValue(resultPtr);
829
                    Tcl_DStringSetLength(resultPtr, length);
830
                }
831
            }
832
            break;
833
 
834
        case TCL_PLATFORM_MAC:
835
            needsSep = 1;
836
            for (i = 0; i < argc; i++) {
837
                Tcl_DStringSetLength(&buffer, 0);
838
                p = SplitMacPath(argv[i], &buffer);
839
                if ((*p != ':') && (*p != '\0')
840
                        && (strchr(p, ':') != NULL)) {
841
                    Tcl_DStringSetLength(resultPtr, oldLength);
842
                    length = strlen(p);
843
                    Tcl_DStringAppend(resultPtr, p, length);
844
                    needsSep = 0;
845
                    p += length+1;
846
                }
847
 
848
                /*
849
                 * Now append the rest of the path elements, skipping
850
                 * : unless it is the first element of the path, and
851
                 * watching out for :: et al. so we don't end up with
852
                 * too many colons in the result.
853
                 */
854
 
855
                for (; *p != '\0'; p += length+1) {
856
                    if (p[0] == ':' && p[1] == '\0') {
857
                        if (Tcl_DStringLength(resultPtr) != oldLength) {
858
                            p++;
859
                        } else {
860
                            needsSep = 0;
861
                        }
862
                    } else {
863
                        c = p[1];
864
                        if (*p == ':') {
865
                            if (!needsSep) {
866
                                p++;
867
                            }
868
                        } else {
869
                            if (needsSep) {
870
                                Tcl_DStringAppend(resultPtr, ":", 1);
871
                            }
872
                        }
873
                        needsSep = (c == ':') ? 0 : 1;
874
                    }
875
                    length = strlen(p);
876
                    Tcl_DStringAppend(resultPtr, p, length);
877
                }
878
            }
879
            break;
880
 
881
    }
882
    Tcl_DStringFree(&buffer);
883
    return Tcl_DStringValue(resultPtr);
884
}
885
 
886
/*
887
 *----------------------------------------------------------------------
888
 *
889
 * Tcl_TranslateFileName --
890
 *
891
 *      Converts a file name into a form usable by the native system
892
 *      interfaces.  If the name starts with a tilde, it will produce
893
 *      a name where the tilde and following characters have been
894
 *      replaced by the home directory location for the named user.
895
 *
896
 * Results:
897
 *      The result is a pointer to a static string containing
898
 *      the new name.  If there was an error in processing the
899
 *      name, then an error message is left in interp->result
900
 *      and the return value is NULL.  The result will be stored
901
 *      in bufferPtr; the caller must call Tcl_DStringFree(bufferPtr)
902
 *      to free the name if the return value was not NULL.
903
 *
904
 * Side effects:
905
 *      Information may be left in bufferPtr.
906
 *
907
 *----------------------------------------------------------------------
908
 */
909
 
910
char *
911
Tcl_TranslateFileName(interp, name, bufferPtr)
912
    Tcl_Interp *interp;         /* Interpreter in which to store error
913
                                 * message (if necessary). */
914
    char *name;                 /* File name, which may begin with "~"
915
                                 * (to indicate current user's home directory)
916
                                 * or "~<user>" (to indicate any user's
917
                                 * home directory). */
918
    Tcl_DString *bufferPtr;     /* May be used to hold result.  Must not hold
919
                                 * anything at the time of the call, and need
920
                                 * not even be initialized. */
921
{
922
    register char *p;
923
 
924
    /*
925
     * Handle tilde substitutions, if needed.
926
     */
927
 
928
    if (name[0] == '~') {
929
        int argc, length;
930
        char **argv;
931
        Tcl_DString temp;
932
 
933
        Tcl_SplitPath(name, &argc, &argv);
934
 
935
        /*
936
         * Strip the trailing ':' off of a Mac path
937
         * before passing the user name to DoTildeSubst.
938
         */
939
 
940
        if (tclPlatform == TCL_PLATFORM_MAC) {
941
            length = strlen(argv[0]);
942
            argv[0][length-1] = '\0';
943
        }
944
 
945
        Tcl_DStringInit(&temp);
946
        argv[0] = DoTildeSubst(interp, argv[0]+1, &temp);
947
        if (argv[0] == NULL) {
948
            Tcl_DStringFree(&temp);
949
            ckfree((char *)argv);
950
            return NULL;
951
        }
952
        Tcl_DStringInit(bufferPtr);
953
        Tcl_JoinPath(argc, argv, bufferPtr);
954
        Tcl_DStringFree(&temp);
955
        ckfree((char*)argv);
956
    } else {
957
        Tcl_DStringInit(bufferPtr);
958
        Tcl_JoinPath(1, &name, bufferPtr);
959
    }
960
 
961
    /*
962
     * Convert forward slashes to backslashes in Windows paths because
963
     * some system interfaces don't accept forward slashes.
964
     */
965
 
966
#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
 
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
 
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
 
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
 
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
 
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
}

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.