2 * CDE - Common Desktop Environment
4 * Copyright (c) 1993-2012, The Open Group. All rights reserved.
6 * These libraries and programs are free software; you can
7 * redistribute them and/or modify them under the terms of the GNU
8 * Lesser General Public License as published by the Free Software
9 * Foundation; either version 2 of the License, or (at your option)
12 * These libraries and programs are distributed in the hope that
13 * they will be useful, but WITHOUT ANY WARRANTY; without even the
14 * implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
15 * PURPOSE. See the GNU Lesser General Public License for more
18 * You should have received a copy of the GNU Lesser General Public
19 * License along with these libraries and programs; if not, write
20 * to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
21 * Floor, Boston, MA 02110-1301 USA
23 /* $XConsortium: tclFileName.c /main/2 1996/08/08 14:43:59 cde-hp $ */
27 * This file contains routines for converting file names betwen
28 * native and network form.
30 * Copyright (c) 1995-1996 Sun Microsystems, Inc.
32 * See the file "license.terms" for information on usage and redistribution
33 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
35 * SCCS: @(#) tclFileName.c 1.23 96/04/19 12:34:28
40 #include "tclRegexp.h"
43 * This variable indicates whether the cleanup procedure has been
44 * registered for this file yet.
47 static int initialized = 0;
50 * The following regular expression matches the root portion of a Windows
51 * absolute or volume relative path. It will match both UNC and drive relative
55 #define WIN_ROOT_PATTERN "^(([a-zA-Z]:)|[/\\][/\\]+([^/\\]+)[/\\]+([^/\\]+)|([/\\]))([/\\])*"
58 * The following regular expression matches the root portion of a Macintosh
59 * absolute path. It will match degenerate Unix-style paths, tilde paths,
60 * Unix-style paths, and Mac paths.
63 #define MAC_ROOT_PATTERN "^((/+([.][.]?/+)*([.][.]?)?)|(~[^:/]*)(/[^:]*)?|(~[^:]*)(:.*)?|/+([.][.]?/+)*([^:/]+)(/[^:]*)?|([^:]+):.*)$"
66 * The following variables are used to hold precompiled regular expressions
67 * for use in filename matching.
70 static regexp *winRootPatternPtr = NULL;
71 static regexp *macRootPatternPtr = NULL;
74 * The following variable is set in the TclPlatformInit call to one
75 * of: TCL_PLATFORM_UNIX, TCL_PLATFORM_MAC, or TCL_PLATFORM_WINDOWS.
78 TclPlatformType tclPlatform = TCL_PLATFORM_UNIX;
81 * Prototypes for local procedures defined in this file:
84 static char * DoTildeSubst _ANSI_ARGS_((Tcl_Interp *interp,
85 char *user, Tcl_DString *resultPtr));
86 static char * ExtractWinRoot _ANSI_ARGS_((char *path,
87 Tcl_DString *resultPtr, int offset));
88 static void FileNameCleanup _ANSI_ARGS_((ClientData clientData));
89 static int SkipToChar _ANSI_ARGS_((char **stringPtr,
91 static char * SplitMacPath _ANSI_ARGS_((char *path,
92 Tcl_DString *bufPtr));
93 static char * SplitWinPath _ANSI_ARGS_((char *path,
94 Tcl_DString *bufPtr));
95 static char * SplitUnixPath _ANSI_ARGS_((char *path,
96 Tcl_DString *bufPtr));
99 *----------------------------------------------------------------------
103 * This procedure is a Tcl_ExitProc used to clean up the static
104 * data structures used in this file.
110 * Deallocates storage used by the procedures in this file.
112 *----------------------------------------------------------------------
116 FileNameCleanup(clientData)
117 ClientData clientData; /* Not used. */
119 if (winRootPatternPtr != NULL) {
120 ckfree((char *)winRootPatternPtr);
122 if (macRootPatternPtr != NULL) {
123 ckfree((char *)macRootPatternPtr);
128 *----------------------------------------------------------------------
132 * Matches the root portion of a Windows path and appends it
133 * to the specified Tcl_DString.
136 * Returns the position in the path immediately after the root
137 * including any trailing slashes.
138 * Appends a cleaned up version of the root to the Tcl_DString
139 * at the specified offest.
142 * Modifies the specified Tcl_DString.
144 *----------------------------------------------------------------------
148 ExtractWinRoot(path, resultPtr, offset)
149 char *path; /* Path to parse. */
150 Tcl_DString *resultPtr; /* Buffer to hold result. */
151 int offset; /* Offset in buffer where result should be
157 * Initialize the path name parser for Windows path names.
160 if (winRootPatternPtr == NULL) {
161 winRootPatternPtr = TclRegComp(WIN_ROOT_PATTERN);
163 Tcl_CreateExitHandler(FileNameCleanup, NULL);
169 * Match the root portion of a Windows path name.
172 if (!TclRegExec(winRootPatternPtr, path, path)) {
176 Tcl_DStringSetLength(resultPtr, offset);
178 if (winRootPatternPtr->startp[2] != NULL) {
179 Tcl_DStringAppend(resultPtr, winRootPatternPtr->startp[2], 2);
180 if (winRootPatternPtr->startp[6] != NULL) {
181 Tcl_DStringAppend(resultPtr, "/", 1);
183 } else if (winRootPatternPtr->startp[4] != NULL) {
184 Tcl_DStringAppend(resultPtr, "//", 2);
185 length = winRootPatternPtr->endp[3]
186 - winRootPatternPtr->startp[3];
187 Tcl_DStringAppend(resultPtr, winRootPatternPtr->startp[3], length);
188 Tcl_DStringAppend(resultPtr, "/", 1);
189 length = winRootPatternPtr->endp[4]
190 - winRootPatternPtr->startp[4];
191 Tcl_DStringAppend(resultPtr, winRootPatternPtr->startp[4], length);
193 Tcl_DStringAppend(resultPtr, "/", 1);
195 return winRootPatternPtr->endp[0];
199 *----------------------------------------------------------------------
203 * Determines whether a given path is relative to the current
204 * directory, relative to the current volume, or absolute.
207 * Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or
208 * TCL_PATH_VOLUME_RELATIVE.
213 *----------------------------------------------------------------------
217 Tcl_GetPathType(path)
220 Tcl_PathType type = TCL_PATH_ABSOLUTE;
222 switch (tclPlatform) {
223 case TCL_PLATFORM_UNIX:
225 * Paths that begin with / or ~ are absolute.
228 if ((path[0] != '/') && (path[0] != '~')) {
229 type = TCL_PATH_RELATIVE;
233 case TCL_PLATFORM_MAC:
234 if (path[0] == ':') {
235 type = TCL_PATH_RELATIVE;
236 } else if (path[0] != '~') {
239 * Since we have eliminated the easy cases, use the
240 * root pattern to look for the other types.
243 if (!macRootPatternPtr) {
244 macRootPatternPtr = TclRegComp(MAC_ROOT_PATTERN);
246 Tcl_CreateExitHandler(FileNameCleanup, NULL);
250 if (!TclRegExec(macRootPatternPtr, path, path)
251 || (macRootPatternPtr->startp[2] != NULL)) {
252 type = TCL_PATH_RELATIVE;
257 case TCL_PLATFORM_WINDOWS:
258 if (path[0] != '~') {
261 * Since we have eliminated the easy cases, check for
262 * drive relative paths using the regular expression.
265 if (!winRootPatternPtr) {
266 winRootPatternPtr = TclRegComp(WIN_ROOT_PATTERN);
268 Tcl_CreateExitHandler(FileNameCleanup, NULL);
272 if (TclRegExec(winRootPatternPtr, path, path)) {
273 if (winRootPatternPtr->startp[5]
274 || (winRootPatternPtr->startp[2]
275 && !(winRootPatternPtr->startp[6]))) {
276 type = TCL_PATH_VOLUME_RELATIVE;
279 type = TCL_PATH_RELATIVE;
288 *----------------------------------------------------------------------
292 * Split a path into a list of path components. The first element
293 * of the list will have the same path type as the original path.
296 * Returns a standard Tcl result. The interpreter result contains
297 * a list of path components.
298 * *argvPtr will be filled in with the address of an array
299 * whose elements point to the elements of path, in order.
300 * *argcPtr will get filled in with the number of valid elements
301 * in the array. A single block of memory is dynamically allocated
302 * to hold both the argv array and a copy of the path elements.
303 * The caller must eventually free this memory by calling ckfree()
304 * on *argvPtr. Note: *argvPtr and *argcPtr are only modified
305 * if the procedure returns normally.
310 *----------------------------------------------------------------------
314 Tcl_SplitPath(path, argcPtr, argvPtr)
315 char *path; /* Pointer to string containing a path. */
316 int *argcPtr; /* Pointer to location to fill in with
317 * the number of elements in the path. */
318 char ***argvPtr; /* Pointer to place to store pointer to array
319 * of pointers to path elements. */
324 Tcl_DStringInit(&buffer);
327 * Perform platform specific splitting. These routines will leave the
328 * result in the specified buffer. Individual elements are terminated
329 * with a null character.
332 p = NULL; /* Needed only to prevent gcc warnings. */
333 switch (tclPlatform) {
334 case TCL_PLATFORM_UNIX:
335 p = SplitUnixPath(path, &buffer);
338 case TCL_PLATFORM_WINDOWS:
339 p = SplitWinPath(path, &buffer);
342 case TCL_PLATFORM_MAC:
343 p = SplitMacPath(path, &buffer);
348 * Compute the number of elements in the result.
351 size = Tcl_DStringLength(&buffer);
353 for (i = 0; i < size; i++) {
360 * Allocate a buffer large enough to hold the contents of the
361 * DString plus the argv pointers and the terminating NULL pointer.
364 *argvPtr = (char **) ckalloc((unsigned)
365 ((((*argcPtr) + 1) * sizeof(char *)) + size));
368 * Position p after the last argv pointer and copy the contents of
372 p = (char *) &(*argvPtr)[(*argcPtr) + 1];
373 memcpy((VOID *) p, (VOID *) Tcl_DStringValue(&buffer), (size_t) size);
376 * Now set up the argv pointers.
379 for (i = 0; i < *argcPtr; i++) {
381 while ((*p++) != '\0') {}
383 (*argvPtr)[i] = NULL;
385 Tcl_DStringFree(&buffer);
389 *----------------------------------------------------------------------
393 * This routine is used by Tcl_SplitPath to handle splitting
397 * Stores a null separated array of strings in the specified
403 *----------------------------------------------------------------------
407 SplitUnixPath(path, bufPtr)
408 char *path; /* Pointer to string containing a path. */
409 Tcl_DString *bufPtr; /* Pointer to DString to use for the result. */
412 char *p, *elementStart;
415 * Deal with the root directory as a special case.
418 if (path[0] == '/') {
419 Tcl_DStringAppend(bufPtr, "/", 2);
426 * Split on slashes. Embedded elements that start with tilde will be
427 * prefixed with "./" so they are not affected by tilde substitution.
432 while ((*p != '\0') && (*p != '/')) {
435 length = p - elementStart;
437 if ((elementStart[0] == '~') && (elementStart != path)) {
438 Tcl_DStringAppend(bufPtr, "./", 2);
440 Tcl_DStringAppend(bufPtr, elementStart, length);
441 Tcl_DStringAppend(bufPtr, "", 1);
447 return Tcl_DStringValue(bufPtr);
451 *----------------------------------------------------------------------
455 * This routine is used by Tcl_SplitPath to handle splitting
459 * Stores a null separated array of strings in the specified
465 *----------------------------------------------------------------------
469 SplitWinPath(path, bufPtr)
470 char *path; /* Pointer to string containing a path. */
471 Tcl_DString *bufPtr; /* Pointer to DString to use for the result. */
474 char *p, *elementStart;
476 p = ExtractWinRoot(path, bufPtr, 0);
479 * Terminate the root portion, if we matched something.
483 Tcl_DStringAppend(bufPtr, "", 1);
487 * Split on slashes. Embedded elements that start with tilde will be
488 * prefixed with "./" so they are not affected by tilde substitution.
493 while ((*p != '\0') && (*p != '/') && (*p != '\\')) {
496 length = p - elementStart;
498 if ((elementStart[0] == '~') && (elementStart != path)) {
499 Tcl_DStringAppend(bufPtr, "./", 2);
501 Tcl_DStringAppend(bufPtr, elementStart, length);
502 Tcl_DStringAppend(bufPtr, "", 1);
504 } while (*p++ != '\0');
506 return Tcl_DStringValue(bufPtr);
510 *----------------------------------------------------------------------
514 * This routine is used by Tcl_SplitPath to handle splitting
518 * Returns a newly allocated argv array.
523 *----------------------------------------------------------------------
527 SplitMacPath(path, bufPtr)
528 char *path; /* Pointer to string containing a path. */
529 Tcl_DString *bufPtr; /* Pointer to DString to use for the result. */
531 int isMac = 0; /* 1 if is Mac-style, 0 if Unix-style path. */
533 char *p, *elementStart;
536 * Initialize the path name parser for Macintosh path names.
539 if (macRootPatternPtr == NULL) {
540 macRootPatternPtr = TclRegComp(MAC_ROOT_PATTERN);
542 Tcl_CreateExitHandler(FileNameCleanup, NULL);
548 * Match the root portion of a Mac path name.
551 i = 0; /* Needed only to prevent gcc warnings. */
552 if (TclRegExec(macRootPatternPtr, path, path) == 1) {
554 * Treat degenerate absolute paths like / and /../.. as
555 * Mac relative file names for lack of anything else to do.
558 if (macRootPatternPtr->startp[2] != NULL) {
559 Tcl_DStringAppend(bufPtr, ":", 1);
560 Tcl_DStringAppend(bufPtr, path, macRootPatternPtr->endp[0]
561 - macRootPatternPtr->startp[0] + 1);
562 return Tcl_DStringValue(bufPtr);
565 if (macRootPatternPtr->startp[5] != NULL) {
568 * Unix-style tilde prefixed paths.
573 } else if (macRootPatternPtr->startp[7] != NULL) {
576 * Mac-style tilde prefixed paths.
581 } else if (macRootPatternPtr->startp[10] != NULL) {
584 * Normal Unix style paths.
589 } else if (macRootPatternPtr->startp[12] != NULL) {
592 * Normal Mac style paths.
599 length = macRootPatternPtr->endp[i]
600 - macRootPatternPtr->startp[i];
603 * Append the element and terminate it with a : and a null. Note that
604 * we are forcing the DString to contain an extra null at the end.
607 Tcl_DStringAppend(bufPtr, macRootPatternPtr->startp[i], length);
608 Tcl_DStringAppend(bufPtr, ":", 2);
609 p = macRootPatternPtr->endp[i];
611 isMac = (strchr(path, ':') != NULL);
618 * p is pointing at the first colon in the path. There
619 * will always be one, since this is a Mac-style path.
623 while ((p = strchr(p, ':')) != NULL) {
624 length = p - elementStart;
627 Tcl_DStringAppend(bufPtr, "::", 3);
632 * If this is a simple component, drop the leading colon.
635 if ((elementStart[1] != '~')
636 && (strchr(elementStart+1, '/') == NULL)) {
640 Tcl_DStringAppend(bufPtr, elementStart, length);
641 Tcl_DStringAppend(bufPtr, "", 1);
645 if (elementStart[1] != '\0' || elementStart == path) {
646 if ((elementStart[1] != '~') && (elementStart[1] != '\0')
647 && (strchr(elementStart+1, '/') == NULL)) {
650 Tcl_DStringAppend(bufPtr, elementStart, -1);
651 Tcl_DStringAppend(bufPtr, "", 1);
656 * Split on slashes, suppress extra /'s, and convert .. to ::.
661 while ((*p != '\0') && (*p != '/')) {
664 length = p - elementStart;
666 if ((length == 1) && (elementStart[0] == '.')) {
667 Tcl_DStringAppend(bufPtr, ":", 2);
668 } else if ((length == 2) && (elementStart[0] == '.')
669 && (elementStart[1] == '.')) {
670 Tcl_DStringAppend(bufPtr, "::", 3);
672 if (*elementStart == '~') {
673 Tcl_DStringAppend(bufPtr, ":", 1);
675 Tcl_DStringAppend(bufPtr, elementStart, length);
676 Tcl_DStringAppend(bufPtr, "", 1);
684 return Tcl_DStringValue(bufPtr);
688 *----------------------------------------------------------------------
692 * Combine a list of paths in a platform specific manner.
695 * Appends the joined path to the end of the specified
696 * returning a pointer to the resulting string. Note that
697 * the Tcl_DString must already be initialized.
700 * Modifies the Tcl_DString.
702 *----------------------------------------------------------------------
706 Tcl_JoinPath(argc, argv, resultPtr)
709 Tcl_DString *resultPtr; /* Pointer to previously initialized DString. */
711 int oldLength, length, i, needsSep;
715 Tcl_DStringInit(&buffer);
716 oldLength = Tcl_DStringLength(resultPtr);
718 switch (tclPlatform) {
719 case TCL_PLATFORM_UNIX:
720 for (i = 0; i < argc; i++) {
723 * If the path is absolute, reset the result buffer.
724 * Consume any duplicate leading slashes or a ./ in
725 * front of a tilde prefixed path that isn't at the
726 * beginning of the path.
730 Tcl_DStringSetLength(resultPtr, oldLength);
731 Tcl_DStringAppend(resultPtr, "/", 1);
735 } else if (*p == '~') {
736 Tcl_DStringSetLength(resultPtr, oldLength);
737 } else if ((Tcl_DStringLength(resultPtr) != oldLength)
738 && (p[0] == '.') && (p[1] == '/')
748 * Append a separator if needed.
751 length = Tcl_DStringLength(resultPtr);
752 if ((length != oldLength)
753 && (Tcl_DStringValue(resultPtr)[length-1] != '/')) {
754 Tcl_DStringAppend(resultPtr, "/", 1);
759 * Append the element, eliminating duplicate and trailing
763 Tcl_DStringSetLength(resultPtr, (int) (length + strlen(p)));
764 dest = Tcl_DStringValue(resultPtr) + length;
765 for (; *p != '\0'; p++) {
767 while (p[1] == '/') {
777 length = dest - Tcl_DStringValue(resultPtr);
778 Tcl_DStringSetLength(resultPtr, length);
782 case TCL_PLATFORM_WINDOWS:
784 * Iterate over all of the components. If a component is
785 * absolute, then reset the result and start building the
786 * path from the current component on.
789 for (i = 0; i < argc; i++) {
790 p = ExtractWinRoot(argv[i], resultPtr, oldLength);
791 length = Tcl_DStringLength(resultPtr);
794 * If the pointer didn't move, then this is a relative path
795 * or a tilde prefixed path.
800 * Remove the ./ from tilde prefixed elements unless
801 * it is the first component.
804 if ((length != oldLength)
806 && ((p[1] == '/') || (p[1] == '\\'))
809 } else if (*p == '~') {
810 Tcl_DStringSetLength(resultPtr, oldLength);
817 * Check to see if we need to append a separator.
821 if (length != oldLength) {
822 c = Tcl_DStringValue(resultPtr)[length-1];
823 if ((c != '/') && (c != ':')) {
824 Tcl_DStringAppend(resultPtr, "/", 1);
829 * Append the element, eliminating duplicate and
833 length = Tcl_DStringLength(resultPtr);
834 Tcl_DStringSetLength(resultPtr, (int) (length + strlen(p)));
835 dest = Tcl_DStringValue(resultPtr) + length;
836 for (; *p != '\0'; p++) {
837 if ((*p == '/') || (*p == '\\')) {
838 while ((p[1] == '/') || (p[1] == '\\')) {
848 length = dest - Tcl_DStringValue(resultPtr);
849 Tcl_DStringSetLength(resultPtr, length);
854 case TCL_PLATFORM_MAC:
856 for (i = 0; i < argc; i++) {
857 Tcl_DStringSetLength(&buffer, 0);
858 p = SplitMacPath(argv[i], &buffer);
859 if ((*p != ':') && (*p != '\0')
860 && (strchr(p, ':') != NULL)) {
861 Tcl_DStringSetLength(resultPtr, oldLength);
863 Tcl_DStringAppend(resultPtr, p, length);
869 * Now append the rest of the path elements, skipping
870 * : unless it is the first element of the path, and
871 * watching out for :: et al. so we don't end up with
872 * too many colons in the result.
875 for (; *p != '\0'; p += length+1) {
876 if (p[0] == ':' && p[1] == '\0') {
877 if (Tcl_DStringLength(resultPtr) != oldLength) {
890 Tcl_DStringAppend(resultPtr, ":", 1);
893 needsSep = (c == ':') ? 0 : 1;
896 Tcl_DStringAppend(resultPtr, p, length);
902 Tcl_DStringFree(&buffer);
903 return Tcl_DStringValue(resultPtr);
907 *----------------------------------------------------------------------
909 * Tcl_TranslateFileName --
911 * Converts a file name into a form usable by the native system
912 * interfaces. If the name starts with a tilde, it will produce
913 * a name where the tilde and following characters have been
914 * replaced by the home directory location for the named user.
917 * The result is a pointer to a static string containing
918 * the new name. If there was an error in processing the
919 * name, then an error message is left in interp->result
920 * and the return value is NULL. The result will be stored
921 * in bufferPtr; the caller must call Tcl_DStringFree(bufferPtr)
922 * to free the name if the return value was not NULL.
925 * Information may be left in bufferPtr.
927 *---------------------------------------------------------------------- */
930 Tcl_TranslateFileName(interp, name, bufferPtr)
931 Tcl_Interp *interp; /* Interpreter in which to store error
932 * message (if necessary). */
933 char *name; /* File name, which may begin with "~"
934 * (to indicate current user's home directory)
935 * or "~<user>" (to indicate any user's
936 * home directory). */
937 Tcl_DString *bufferPtr; /* May be used to hold result. Must not hold
938 * anything at the time of the call, and need
939 * not even be initialized. */
944 * Handle tilde substitutions, if needed.
947 if (name[0] == '~') {
952 Tcl_SplitPath(name, &argc, &argv);
955 * Strip the trailing ':' off of a Mac path
956 * before passing the user name to DoTildeSubst.
959 if (tclPlatform == TCL_PLATFORM_MAC) {
960 length = strlen(argv[0]);
961 argv[0][length-1] = '\0';
964 Tcl_DStringInit(&temp);
965 argv[0] = DoTildeSubst(interp, argv[0]+1, &temp);
966 if (argv[0] == NULL) {
967 Tcl_DStringFree(&temp);
968 ckfree((char *)argv);
971 Tcl_DStringInit(bufferPtr);
972 Tcl_JoinPath(argc, argv, bufferPtr);
973 Tcl_DStringFree(&temp);
976 Tcl_DStringInit(bufferPtr);
977 Tcl_JoinPath(1, &name, bufferPtr);
981 * Convert forward slashes to backslashes in Windows paths because
982 * some system interfaces don't accept forward slashes.
985 if (tclPlatform == TCL_PLATFORM_WINDOWS) {
986 for (p = Tcl_DStringValue(bufferPtr); *p != '\0'; p++) {
992 return Tcl_DStringValue(bufferPtr);
996 *----------------------------------------------------------------------
1000 * This function returns a pointer to the beginning of the
1001 * extension part of a file name.
1004 * Returns a pointer into name which indicates where the extension
1005 * starts. If there is no extension, returns NULL.
1010 *----------------------------------------------------------------------
1014 TclGetExtension(name)
1015 char *name; /* File name to parse. */
1020 * First find the last directory separator.
1023 lastSep = NULL; /* Needed only to prevent gcc warnings. */
1024 switch (tclPlatform) {
1025 case TCL_PLATFORM_UNIX:
1026 lastSep = strrchr(name, '/');
1029 case TCL_PLATFORM_MAC:
1030 if (strchr(name, ':') == NULL) {
1031 lastSep = strrchr(name, '/');
1033 lastSep = strrchr(name, ':');
1037 case TCL_PLATFORM_WINDOWS:
1039 for (p = name; *p != '\0'; p++) {
1040 if (strchr("/\\:", *p) != NULL) {
1046 p = strrchr(name, '.');
1047 if ((p != NULL) && (lastSep != NULL)
1055 *----------------------------------------------------------------------
1059 * Given a string following a tilde, this routine returns the
1060 * corresponding home directory.
1063 * The result is a pointer to a static string containing the home
1064 * directory in native format. If there was an error in processing
1065 * the substitution, then an error message is left in interp->result
1066 * and the return value is NULL. On success, the results are appended
1067 * to resultPtr, and the contents of resultPtr are returned.
1070 * Information may be left in resultPtr.
1072 *----------------------------------------------------------------------
1076 DoTildeSubst(interp, user, resultPtr)
1077 Tcl_Interp *interp; /* Interpreter in which to store error
1078 * message (if necessary). */
1079 char *user; /* Name of user whose home directory should be
1080 * substituted, or "" for current user. */
1081 Tcl_DString *resultPtr; /* May be used to hold result. Must not hold
1082 * anything at the time of the call, and need
1083 * not even be initialized. */
1087 if (*user == '\0') {
1088 dir = TclGetEnv("HOME");
1091 Tcl_ResetResult(interp);
1092 Tcl_AppendResult(interp, "couldn't find HOME environment ",
1093 "variable to expand path", (char *) NULL);
1097 Tcl_JoinPath(1, &dir, resultPtr);
1099 if (TclGetUserHome(user, resultPtr) == NULL) {
1101 Tcl_ResetResult(interp);
1102 Tcl_AppendResult(interp, "user \"", user, "\" doesn't exist",
1108 return resultPtr->string;
1112 *----------------------------------------------------------------------
1116 * This procedure is invoked to process the "glob" Tcl command.
1117 * See the user documentation for details on what it does.
1120 * A standard Tcl result.
1123 * See the user documentation.
1125 *----------------------------------------------------------------------
1130 Tcl_GlobCmd(dummy, interp, argc, argv)
1131 ClientData dummy; /* Not used. */
1132 Tcl_Interp *interp; /* Current interpreter. */
1133 int argc; /* Number of arguments. */
1134 char **argv; /* Argument strings. */
1136 int i, noComplain, firstArg;
1138 int result = TCL_OK;
1140 char *separators, *head, *tail;
1143 for (firstArg = 1; (firstArg < argc) && (argv[firstArg][0] == '-');
1145 if (strcmp(argv[firstArg], "-nocomplain") == 0) {
1147 } else if (strcmp(argv[firstArg], "--") == 0) {
1151 Tcl_AppendResult(interp, "bad switch \"", argv[firstArg],
1152 "\": must be -nocomplain or --", (char *) NULL);
1156 if (firstArg >= argc) {
1157 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
1158 " ?switches? name ?name ...?\"", (char *) NULL);
1162 Tcl_DStringInit(&buffer);
1163 separators = NULL; /* Needed only to prevent gcc warnings. */
1164 for (i = firstArg; i < argc; i++) {
1167 switch (tclPlatform) {
1168 case TCL_PLATFORM_UNIX:
1171 case TCL_PLATFORM_WINDOWS:
1172 separators = "/\\:";
1174 case TCL_PLATFORM_MAC:
1175 separators = (strchr(argv[i], ':') == NULL) ? "/" : ":";
1179 Tcl_DStringSetLength(&buffer, 0);
1182 * Perform tilde substitution, if needed.
1185 if (argv[i][0] == '~') {
1189 * Find the first path separator after the tilde.
1192 for (tail = argv[i]; *tail != '\0'; tail++) {
1193 if (*tail == '\\') {
1194 if (strchr(separators, tail[1]) != NULL) {
1197 } else if (strchr(separators, *tail) != NULL) {
1203 * Determine the home directory for the specified user. Note that
1204 * we don't allow special characters in the user name.
1209 p = strpbrk(argv[i]+1, "\\[]*?{}");
1211 head = DoTildeSubst(interp, argv[i]+1, &buffer);
1214 Tcl_ResetResult(interp);
1215 Tcl_AppendResult(interp, "globbing characters not ",
1216 "supported in user names", (char *) NULL);
1223 Tcl_ResetResult(interp);
1230 if (head != Tcl_DStringValue(&buffer)) {
1231 Tcl_DStringAppend(&buffer, head, -1);
1237 result = TclDoGlob(interp, separators, &buffer, tail);
1238 if (result != TCL_OK) {
1240 Tcl_ResetResult(interp);
1248 if ((*interp->result == 0) && !noComplain) {
1251 Tcl_AppendResult(interp, "no files matched glob pattern",
1252 (argc == 2) ? " \"" : "s \"", (char *) NULL);
1253 for (i = firstArg; i < argc; i++) {
1254 Tcl_AppendResult(interp, sep, argv[i], (char *) NULL);
1257 Tcl_AppendResult(interp, "\"", (char *) NULL);
1261 Tcl_DStringFree(&buffer);
1266 *----------------------------------------------------------------------
1270 * This function traverses a glob pattern looking for the next
1271 * unquoted occurrence of the specified character at the same braces
1275 * Updates stringPtr to point to the matching character, or to
1276 * the end of the string if nothing matched. The return value
1277 * is 1 if a match was found at the top level, otherwise it is 0.
1282 *----------------------------------------------------------------------
1286 SkipToChar(stringPtr, match)
1287 char **stringPtr; /* Pointer string to check. */
1288 char *match; /* Pointer to character to find. */
1296 for (p = *stringPtr; *p != '\0'; p++) {
1301 if ((level == 0) && (*p == *match)) {
1307 } else if (*p == '}') {
1309 } else if (*p == '\\') {
1318 *----------------------------------------------------------------------
1322 * This recursive procedure forms the heart of the globbing
1323 * code. It performs a depth-first traversal of the tree
1324 * given by the path name to be globbed. The directory and
1325 * remainder are assumed to be native format paths.
1328 * The return value is a standard Tcl result indicating whether
1329 * an error occurred in globbing. After a normal return the
1330 * result in interp will be set to hold all of the file names
1331 * given by the dir and rem arguments. After an error the
1332 * result in interp will hold an error message.
1337 *----------------------------------------------------------------------
1341 TclDoGlob(interp, separators, headPtr, tail)
1342 Tcl_Interp *interp; /* Interpreter to use for error reporting
1343 * (e.g. unmatched brace). */
1344 char *separators; /* String containing separator characters
1345 * that should be used to identify globbing
1347 Tcl_DString *headPtr; /* Completely expanded prefix. */
1348 char *tail; /* The unexpanded remainder of the path. */
1350 int level, baseLength, quoted, count;
1351 int result = TCL_OK;
1352 char *p, *openBrace, *closeBrace, *name, savedChar;
1354 int length = Tcl_DStringLength(headPtr);
1357 lastChar = Tcl_DStringValue(headPtr)[length-1];
1361 * Consume any leading directory separators, leaving tail pointing
1362 * just past the last initial separator.
1367 for (; *tail != '\0'; tail++) {
1368 if ((*tail == '\\') && (strchr(separators, tail[1]) != NULL)) {
1370 } else if (strchr(separators, *tail) == NULL) {
1377 * Deal with path separators. On the Mac, we have to watch out
1378 * for multiple separators, since they are special in Mac-style
1382 switch (tclPlatform) {
1383 case TCL_PLATFORM_MAC:
1384 if (*separators == '/') {
1385 if (((length == 0) && (count == 0))
1386 || ((length > 0) && (lastChar != ':'))) {
1387 Tcl_DStringAppend(headPtr, ":", 1);
1391 if ((length > 0) && (lastChar != ':')) {
1392 Tcl_DStringAppend(headPtr, ":", 1);
1395 if (lastChar == ':') {
1398 while (count-- > 0) {
1399 Tcl_DStringAppend(headPtr, ":", 1);
1404 case TCL_PLATFORM_WINDOWS:
1406 * If this is a drive relative path, add the colon and the
1407 * trailing slash if needed. Otherwise add the slash if
1408 * this is the first absolute element, or a later relative
1409 * element. Add an extra slash if this is a UNC path.
1413 Tcl_DStringAppend(headPtr, ":", 1);
1415 Tcl_DStringAppend(headPtr, "/", 1);
1417 } else if ((*tail != '\0')
1419 && (strchr(separators, lastChar) == NULL))
1420 || ((length == 0) && (count > 0)))) {
1421 Tcl_DStringAppend(headPtr, "/", 1);
1422 if ((length == 0) && (count > 1)) {
1423 Tcl_DStringAppend(headPtr, "/", 1);
1428 case TCL_PLATFORM_UNIX:
1430 * Add a separator if this is the first absolute element, or
1431 * a later relative element.
1436 && (strchr(separators, lastChar) == NULL))
1437 || ((length == 0) && (count > 0)))) {
1438 Tcl_DStringAppend(headPtr, "/", 1);
1444 * Look for the first matching pair of braces or the first
1445 * directory separator that is not inside a pair of braces.
1448 openBrace = closeBrace = NULL;
1451 for (p = tail; *p != '\0'; p++) {
1454 } else if (*p == '\\') {
1456 if (strchr(separators, p[1]) != NULL) {
1457 break; /* Quoted directory separator. */
1459 } else if (strchr(separators, *p) != NULL) {
1460 break; /* Unquoted directory separator. */
1461 } else if (*p == '{') {
1464 if (SkipToChar(&p, "}")) {
1465 closeBrace = p; /* Balanced braces. */
1468 Tcl_ResetResult(interp);
1469 interp->result = "unmatched open-brace in file name";
1471 } else if (*p == '}') {
1472 Tcl_ResetResult(interp);
1473 interp->result = "unmatched close-brace in file name";
1479 * Substitute the alternate patterns from the braces and recurse.
1482 if (openBrace != NULL) {
1484 Tcl_DString newName;
1485 Tcl_DStringInit(&newName);
1488 * For each element within in the outermost pair of braces,
1489 * append the element and the remainder to the fixed portion
1490 * before the first brace and recursively call TclDoGlob.
1493 Tcl_DStringAppend(&newName, tail, openBrace-tail);
1494 baseLength = Tcl_DStringLength(&newName);
1495 length = Tcl_DStringLength(headPtr);
1497 for (p = openBrace; p != closeBrace; ) {
1500 SkipToChar(&p, ",");
1501 Tcl_DStringSetLength(headPtr, length);
1502 Tcl_DStringSetLength(&newName, baseLength);
1503 Tcl_DStringAppend(&newName, element, p-element);
1504 Tcl_DStringAppend(&newName, closeBrace+1, -1);
1505 result = TclDoGlob(interp, separators,
1506 headPtr, Tcl_DStringValue(&newName));
1507 if (result != TCL_OK) {
1512 Tcl_DStringFree(&newName);
1517 * At this point, there are no more brace substitutions to perform on
1518 * this path component. The variable p is pointing at a quoted or
1519 * unquoted directory separator or the end of the string. So we need
1520 * to check for special globbing characters in the current pattern.
1526 if (strpbrk(tail, "*[]?\\") != NULL) {
1529 * Look for matching files in the current directory. The
1530 * implementation of this function is platform specific, but may
1531 * recursively call TclDoGlob. For each file that matches, it will
1532 * add the match onto the interp->result, or call TclDoGlob if there
1533 * are more characters to be processed.
1536 return TclMatchFiles(interp, separators, headPtr, tail, p);
1539 Tcl_DStringAppend(headPtr, tail, p-tail);
1541 return TclDoGlob(interp, separators, headPtr, p);
1545 * There are no more wildcards in the pattern and no more unprocessed
1546 * characters in the tail, so now we can construct the path and verify
1547 * the existence of the file.
1550 switch (tclPlatform) {
1551 case TCL_PLATFORM_MAC:
1552 if (strchr(Tcl_DStringValue(headPtr), ':') == NULL) {
1553 Tcl_DStringAppend(headPtr, ":", 1);
1555 name = Tcl_DStringValue(headPtr);
1556 if (access(name, F_OK) == 0) {
1557 if ((name[1] != '\0') && (strchr(name+1, ':') == NULL)) {
1558 Tcl_AppendElement(interp, name+1);
1560 Tcl_AppendElement(interp, name);
1564 case TCL_PLATFORM_WINDOWS: {
1567 * We need to convert slashes to backslashes before checking
1568 * for the existence of the file. Once we are done, we need
1569 * to convert the slashes back.
1572 if (Tcl_DStringLength(headPtr) == 0) {
1573 if (((*name == '\\') && (name[1] == '/' || name[1] == '\\'))
1574 || (*name == '/')) {
1575 Tcl_DStringAppend(headPtr, "\\", 1);
1577 Tcl_DStringAppend(headPtr, ".", 1);
1580 for (p = Tcl_DStringValue(headPtr); *p != '\0'; p++) {
1586 name = Tcl_DStringValue(headPtr);
1587 exists = (access(name, F_OK) == 0);
1588 for (p = name; *p != '\0'; p++) {
1594 Tcl_AppendElement(interp, name);
1598 case TCL_PLATFORM_UNIX:
1599 if (Tcl_DStringLength(headPtr) == 0) {
1600 if ((*name == '\\' && name[1] == '/') || (*name == '/')) {
1601 Tcl_DStringAppend(headPtr, "/", 1);
1603 Tcl_DStringAppend(headPtr, ".", 1);
1606 name = Tcl_DStringValue(headPtr);
1607 if (access(name, F_OK) == 0) {
1608 Tcl_AppendElement(interp, name);