diff options
author | stanton <stanton> | 1998-09-21 23:39:52 (GMT) |
---|---|---|
committer | stanton <stanton> | 1998-09-21 23:39:52 (GMT) |
commit | 494c2de3a748b449c69ce322a1a741f5a31fd4d5 (patch) | |
tree | c3ece48c0ae3f4ba54787e0e8e729b65752ef3f9 /generic/tclFileName.c | |
parent | 7a698c0488d99c0af42022714638ae1ba2afaa49 (diff) | |
download | tcl-494c2de3a748b449c69ce322a1a741f5a31fd4d5.zip tcl-494c2de3a748b449c69ce322a1a741f5a31fd4d5.tar.gz tcl-494c2de3a748b449c69ce322a1a741f5a31fd4d5.tar.bz2 |
Added contents of Tcl 8.1a2
Diffstat (limited to 'generic/tclFileName.c')
-rw-r--r-- | generic/tclFileName.c | 562 |
1 files changed, 333 insertions, 229 deletions
diff --git a/generic/tclFileName.c b/generic/tclFileName.c index 2024b61..48c2341 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -4,17 +4,16 @@ * This file contains routines for converting file names betwen * native and network form. * - * Copyright (c) 1995-1996 Sun Microsystems, Inc. + * Copyright (c) 1995-1998 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * SCCS: @(#) tclFileName.c 1.32 97/08/19 18:44:03 + * SCCS: @(#) tclFileName.c 1.48 98/02/18 14:42:27 */ #include "tclInt.h" #include "tclPort.h" -#include "tclRegexp.h" /* * This variable indicates whether the cleanup procedure has been @@ -29,7 +28,7 @@ static int initialized = 0; * paths. */ -#define WIN_ROOT_PATTERN "^(([a-zA-Z]:)|[/\\][/\\]+([^/\\]+)[/\\]+([^/\\]+)|([/\\]))([/\\])*" +#define WIN_ROOT_PATTERN "^(([a-zA-Z]:)|[/\\\\][/\\\\]+([^/\\\\]+)[/\\\\]+([^/\\\\]+)|([/\\\\]))([/\\\\])*" /* * The following regular expression matches the root portion of a Macintosh @@ -44,8 +43,9 @@ static int initialized = 0; * for use in filename matching. */ -static regexp *winRootPatternPtr = NULL; -static regexp *macRootPatternPtr = NULL; +static Tcl_Obj *winRootPatternPtr = NULL; +static Tcl_Obj *macRootPatternPtr = NULL; +static Tcl_Mutex nameMutex; /* * The following variable is set in the TclPlatformInit call to one @@ -59,22 +59,51 @@ TclPlatformType tclPlatform = TCL_PLATFORM_UNIX; */ static char * DoTildeSubst _ANSI_ARGS_((Tcl_Interp *interp, - char *user, Tcl_DString *resultPtr)); -static char * ExtractWinRoot _ANSI_ARGS_((char *path, + CONST char *user, Tcl_DString *resultPtr)); +static CONST char * ExtractWinRoot _ANSI_ARGS_((CONST char *path, Tcl_DString *resultPtr, int offset)); static void FileNameCleanup _ANSI_ARGS_((ClientData clientData)); static int SkipToChar _ANSI_ARGS_((char **stringPtr, char *match)); -static char * SplitMacPath _ANSI_ARGS_((char *path, +static char * SplitMacPath _ANSI_ARGS_((CONST char *path, Tcl_DString *bufPtr)); -static char * SplitWinPath _ANSI_ARGS_((char *path, +static char * SplitWinPath _ANSI_ARGS_((CONST char *path, Tcl_DString *bufPtr)); -static char * SplitUnixPath _ANSI_ARGS_((char *path, +static char * SplitUnixPath _ANSI_ARGS_((CONST char *path, Tcl_DString *bufPtr)); /* *---------------------------------------------------------------------- * + * FileNameInit -- + * + * This procedure initializes the patterns used by this module. + * + * Results: + * None. + * + * Side effects: + * Compiles the regular expressions. + * + *---------------------------------------------------------------------- + */ + +static void +FileNameInit() +{ + Tcl_MutexLock(&nameMutex); + if (!initialized) { + winRootPatternPtr = Tcl_NewStringObj(WIN_ROOT_PATTERN, -1); + macRootPatternPtr = Tcl_NewStringObj(MAC_ROOT_PATTERN, -1); + Tcl_CreateExitHandler(FileNameCleanup, NULL); + initialized = 1; + } + Tcl_MutexUnlock(&nameMutex); +} + +/* + *---------------------------------------------------------------------- + * * FileNameCleanup -- * * This procedure is a Tcl_ExitProc used to clean up the static @@ -93,15 +122,17 @@ static void FileNameCleanup(clientData) ClientData clientData; /* Not used. */ { + Tcl_MutexLock(&nameMutex); if (winRootPatternPtr != NULL) { - ckfree((char *)winRootPatternPtr); - winRootPatternPtr = (regexp *) NULL; + Tcl_DecrRefCount(winRootPatternPtr); + winRootPatternPtr = NULL; } if (macRootPatternPtr != NULL) { - ckfree((char *)macRootPatternPtr); - macRootPatternPtr = (regexp *) NULL; + Tcl_DecrRefCount(macRootPatternPtr); + macRootPatternPtr = NULL; } initialized = 0; + Tcl_MutexUnlock(&nameMutex); } /* @@ -124,55 +155,60 @@ FileNameCleanup(clientData) *---------------------------------------------------------------------- */ -static char * +static CONST char * ExtractWinRoot(path, resultPtr, offset) - char *path; /* Path to parse. */ + CONST char *path; /* Path to parse. */ Tcl_DString *resultPtr; /* Buffer to hold result. */ int offset; /* Offset in buffer where result should be * stored. */ { int length; + Tcl_RegExp re; + char *dummy, *tail, *drive, *hostStart, *hostEnd, *shareStart, + *shareEnd, *lastSlash; /* * Initialize the path name parser for Windows path names. */ - if (winRootPatternPtr == NULL) { - winRootPatternPtr = TclRegComp(WIN_ROOT_PATTERN); - if (!initialized) { - Tcl_CreateExitHandler(FileNameCleanup, NULL); - initialized = 1; - } + if (!initialized) { + FileNameInit(); } + re = TclRegCompObj(NULL, winRootPatternPtr, REG_ADVANCED); + /* * Match the root portion of a Windows path name. */ - if (!TclRegExec(winRootPatternPtr, path, path)) { + if (!Tcl_RegExpExec(NULL, re, path, path)) { return path; } Tcl_DStringSetLength(resultPtr, offset); - if (winRootPatternPtr->startp[2] != NULL) { - Tcl_DStringAppend(resultPtr, winRootPatternPtr->startp[2], 2); - if (winRootPatternPtr->startp[6] != NULL) { + Tcl_RegExpRange(re, 0, &dummy, &tail); + Tcl_RegExpRange(re, 2, &drive, &dummy); + Tcl_RegExpRange(re, 3, &hostStart, &hostEnd); + Tcl_RegExpRange(re, 4, &shareStart, &shareEnd); + Tcl_RegExpRange(re, 6, &lastSlash, &dummy); + + if (drive != NULL) { + Tcl_DStringAppend(resultPtr, drive, 2); + if (lastSlash != NULL) { Tcl_DStringAppend(resultPtr, "/", 1); } - } else if (winRootPatternPtr->startp[4] != NULL) { + } else if (shareStart != NULL) { Tcl_DStringAppend(resultPtr, "//", 2); - length = winRootPatternPtr->endp[3] - - winRootPatternPtr->startp[3]; - Tcl_DStringAppend(resultPtr, winRootPatternPtr->startp[3], length); + length = hostEnd - hostStart; + Tcl_DStringAppend(resultPtr, hostStart, length); Tcl_DStringAppend(resultPtr, "/", 1); - length = winRootPatternPtr->endp[4] - - winRootPatternPtr->startp[4]; - Tcl_DStringAppend(resultPtr, winRootPatternPtr->startp[4], length); + length = shareEnd - shareStart; + Tcl_DStringAppend(resultPtr, shareStart, length); } else { Tcl_DStringAppend(resultPtr, "/", 1); } - return winRootPatternPtr->endp[0]; + return tail; } /* @@ -198,6 +234,7 @@ Tcl_GetPathType(path) char *path; { Tcl_PathType type = TCL_PATH_ABSOLUTE; + Tcl_RegExp re; switch (tclPlatform) { case TCL_PLATFORM_UNIX: @@ -220,16 +257,20 @@ Tcl_GetPathType(path) * root pattern to look for the other types. */ - if (!macRootPatternPtr) { - macRootPatternPtr = TclRegComp(MAC_ROOT_PATTERN); - if (!initialized) { - Tcl_CreateExitHandler(FileNameCleanup, NULL); - initialized = 1; - } + if (!initialized) { + FileNameInit(); } - if (!TclRegExec(macRootPatternPtr, path, path) - || (macRootPatternPtr->startp[2] != NULL)) { + re = TclRegCompObj(NULL, macRootPatternPtr, REG_ADVANCED); + + if (!Tcl_RegExpExec(NULL, re, path, path)) { type = TCL_PATH_RELATIVE; + } else { + char *unixRoot, *dummy; + + Tcl_RegExpRange(re, 2, &unixRoot, &dummy); + if (unixRoot) { + type = TCL_PATH_RELATIVE; + } } } break; @@ -242,17 +283,19 @@ Tcl_GetPathType(path) * drive relative paths using the regular expression. */ - if (!winRootPatternPtr) { - winRootPatternPtr = TclRegComp(WIN_ROOT_PATTERN); - if (!initialized) { - Tcl_CreateExitHandler(FileNameCleanup, NULL); - initialized = 1; - } + if (!initialized) { + FileNameInit(); } - if (TclRegExec(winRootPatternPtr, path, path)) { - if (winRootPatternPtr->startp[5] - || (winRootPatternPtr->startp[2] - && !(winRootPatternPtr->startp[6]))) { + re = TclRegCompObj(NULL, winRootPatternPtr, REG_ADVANCED); + + if (Tcl_RegExpExec(NULL, re, path, path)) { + char *drive, *dummy, *unixRoot, *lastSlash; + + Tcl_RegExpRange(re, 2, &drive, &dummy); + Tcl_RegExpRange(re, 5, &unixRoot, &dummy); + Tcl_RegExpRange(re, 6, &lastSlash, &dummy); + + if (unixRoot || (drive && !lastSlash)) { type = TCL_PATH_VOLUME_RELATIVE; } } else { @@ -292,7 +335,7 @@ Tcl_GetPathType(path) void Tcl_SplitPath(path, argcPtr, argvPtr) - char *path; /* Pointer to string containing a path. */ + CONST char *path; /* Pointer to string containing a path. */ int *argcPtr; /* Pointer to location to fill in with * the number of elements in the path. */ char ***argvPtr; /* Pointer to place to store pointer to array @@ -301,6 +344,7 @@ Tcl_SplitPath(path, argcPtr, argvPtr) int i, size; char *p; Tcl_DString buffer; + Tcl_DStringInit(&buffer); /* @@ -385,11 +429,11 @@ Tcl_SplitPath(path, argcPtr, argvPtr) static char * SplitUnixPath(path, bufPtr) - char *path; /* Pointer to string containing a path. */ + CONST char *path; /* Pointer to string containing a path. */ Tcl_DString *bufPtr; /* Pointer to DString to use for the result. */ { int length; - char *p, *elementStart; + CONST char *p, *elementStart; /* * Deal with the root directory as a special case. @@ -447,11 +491,11 @@ SplitUnixPath(path, bufPtr) static char * SplitWinPath(path, bufPtr) - char *path; /* Pointer to string containing a path. */ + CONST char *path; /* Pointer to string containing a path. */ Tcl_DString *bufPtr; /* Pointer to DString to use for the result. */ { int length; - char *p, *elementStart; + CONST char *p, *elementStart; p = ExtractWinRoot(path, bufPtr, 0); @@ -505,23 +549,20 @@ SplitWinPath(path, bufPtr) static char * SplitMacPath(path, bufPtr) - char *path; /* Pointer to string containing a path. */ + CONST char *path; /* Pointer to string containing a path. */ Tcl_DString *bufPtr; /* Pointer to DString to use for the result. */ { int isMac = 0; /* 1 if is Mac-style, 0 if Unix-style path. */ int i, length; - char *p, *elementStart; + CONST char *p, *elementStart; + Tcl_RegExp re; /* * Initialize the path name parser for Macintosh path names. */ - if (macRootPatternPtr == NULL) { - macRootPatternPtr = TclRegComp(MAC_ROOT_PATTERN); - if (!initialized) { - Tcl_CreateExitHandler(FileNameCleanup, NULL); - initialized = 1; - } + if (!initialized) { + FileNameInit(); } /* @@ -529,64 +570,77 @@ SplitMacPath(path, bufPtr) */ i = 0; /* Needed only to prevent gcc warnings. */ - if (TclRegExec(macRootPatternPtr, path, path) == 1) { + re = TclRegCompObj(NULL, macRootPatternPtr, REG_ADVANCED); + + if (Tcl_RegExpExec(NULL, re, path, path) == 1) { + char *start, *end; + /* * Treat degenerate absolute paths like / and /../.. as * Mac relative file names for lack of anything else to do. */ - if (macRootPatternPtr->startp[2] != NULL) { + Tcl_RegExpRange(re, 2, &start, &end); + if (start) { Tcl_DStringAppend(bufPtr, ":", 1); - Tcl_DStringAppend(bufPtr, path, macRootPatternPtr->endp[0] - - macRootPatternPtr->startp[0] + 1); + Tcl_RegExpRange(re, 0, &start, &end); + Tcl_DStringAppend(bufPtr, path, end - start + 1); return Tcl_DStringValue(bufPtr); } - if (macRootPatternPtr->startp[5] != NULL) { - + Tcl_RegExpRange(re, 5, &start, &end); + if (start) { /* * Unix-style tilde prefixed paths. */ isMac = 0; i = 5; - } else if (macRootPatternPtr->startp[7] != NULL) { - - /* - * Mac-style tilde prefixed paths. - */ + } else { + Tcl_RegExpRange(re, 7, &start, &end); + if (start) { + /* + * Mac-style tilde prefixed paths. + */ - isMac = 1; - i = 7; - } else if (macRootPatternPtr->startp[10] != NULL) { + isMac = 1; + i = 7; + } else { + Tcl_RegExpRange(re, 10, &start, &end); + if (start) { - /* - * Normal Unix style paths. - */ + /* + * Normal Unix style paths. + */ - isMac = 0; - i = 10; - } else if (macRootPatternPtr->startp[12] != NULL) { + isMac = 0; + i = 10; + } else { + Tcl_RegExpRange(re, 12, &start, &end); + if (start) { - /* - * Normal Mac style paths. - */ + /* + * Normal Mac style paths. + */ - isMac = 1; - i = 12; + isMac = 1; + i = 12; + } + } + } } - length = macRootPatternPtr->endp[i] - - macRootPatternPtr->startp[i]; + Tcl_RegExpRange(re, i, &start, &end); + length = end - start; /* * Append the element and terminate it with a : and a null. Note that * we are forcing the DString to contain an extra null at the end. */ - Tcl_DStringAppend(bufPtr, macRootPatternPtr->startp[i], length); + Tcl_DStringAppend(bufPtr, start, length); Tcl_DStringAppend(bufPtr, ":", 2); - p = macRootPatternPtr->endp[i]; + p = end; } else { isMac = (strchr(path, ':') != NULL); p = path; @@ -690,7 +744,8 @@ Tcl_JoinPath(argc, argv, resultPtr) { int oldLength, length, i, needsSep; Tcl_DString buffer; - char *p, c, *dest; + char c, *dest; + CONST char *p; Tcl_DStringInit(&buffer); oldLength = Tcl_DStringLength(resultPtr); @@ -884,25 +939,27 @@ Tcl_JoinPath(argc, argv, resultPtr) } /* - *---------------------------------------------------------------------- + *--------------------------------------------------------------------------- * * Tcl_TranslateFileName -- * * Converts a file name into a form usable by the native system - * interfaces. If the name starts with a tilde, it will produce - * a name where the tilde and following characters have been - * replaced by the home directory location for the named user. + * interfaces. If the name starts with a tilde, it will produce a + * name where the tilde and following characters have been replaced + * by the home directory location for the named user. * * Results: - * The result is a pointer to a static string containing - * the new name. If there was an error in processing the - * name, then an error message is left in interp->result - * and the return value is NULL. The result will be stored - * in bufferPtr; the caller must call Tcl_DStringFree(bufferPtr) - * to free the name if the return value was not NULL. + * The return value is a pointer to a string containing the name + * after tilde substitution. If there was no tilde substitution, + * the return value is a pointer to a copy of the original string. + * If there was an error in processing the name, then an error + * message is left in the interp's result (if interp was not NULL) + * and the return value is NULL. Space for the return value is + * allocated in bufferPtr; the caller must call Tcl_DStringFree() + * to free the space if the return value was not NULL. * * Side effects: - * Information may be left in bufferPtr. + * None. * *---------------------------------------------------------------------- */ @@ -911,13 +968,12 @@ char * Tcl_TranslateFileName(interp, name, bufferPtr) Tcl_Interp *interp; /* Interpreter in which to store error * message (if necessary). */ - char *name; /* File name, which may begin with "~" - * (to indicate current user's home directory) - * or "~<user>" (to indicate any user's - * home directory). */ - Tcl_DString *bufferPtr; /* May be used to hold result. Must not hold - * anything at the time of the call, and need - * not even be initialized. */ + char *name; /* File name, which may begin with "~" (to + * indicate current user's home directory) or + * "~<user>" (to indicate any user's home + * directory). */ + Tcl_DString *bufferPtr; /* Uninitialized or free DString filled + * with name after tilde substitution. */ { register char *p; @@ -933,8 +989,8 @@ Tcl_TranslateFileName(interp, name, bufferPtr) Tcl_SplitPath(name, &argc, &argv); /* - * Strip the trailing ':' off of a Mac path - * before passing the user name to DoTildeSubst. + * Strip the trailing ':' off of a Mac path before passing the user + * name to DoTildeSubst. */ if (tclPlatform == TCL_PLATFORM_MAC) { @@ -1054,9 +1110,10 @@ TclGetExtension(name) * Results: * The result is a pointer to a static string containing the home * directory in native format. If there was an error in processing - * the substitution, then an error message is left in interp->result - * and the return value is NULL. On success, the results are appended - * to resultPtr, and the contents of resultPtr are returned. + * the substitution, then an error message is left in the interp's + * result and the return value is NULL. On success, the results + * are appended to resultPtr, and the contents of resultPtr are + * returned. * * Side effects: * Information may be left in resultPtr. @@ -1068,16 +1125,17 @@ static char * DoTildeSubst(interp, user, resultPtr) Tcl_Interp *interp; /* Interpreter in which to store error * message (if necessary). */ - char *user; /* Name of user whose home directory should be + CONST char *user; /* Name of user whose home directory should be * substituted, or "" for current user. */ - Tcl_DString *resultPtr; /* May be used to hold result. Must not hold - * anything at the time of the call, and need - * not even be initialized. */ + Tcl_DString *resultPtr; /* Initialized DString filled with name + * after tilde substitution. */ { char *dir; if (*user == '\0') { - dir = TclGetEnv("HOME"); + Tcl_DString dirString; + + dir = TclGetEnv("HOME", &dirString); if (dir == NULL) { if (interp) { Tcl_ResetResult(interp); @@ -1087,10 +1145,9 @@ DoTildeSubst(interp, user, resultPtr) return NULL; } Tcl_JoinPath(1, &dir, resultPtr); + Tcl_DStringFree(&dirString); } else { - - /* lint, TclGetuserHome() always NULL under windows. */ - if (TclGetUserHome(user, resultPtr) == NULL) { + if (TclpGetUserHome(user, resultPtr) == NULL) { if (interp) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "user \"", user, "\" doesn't exist", @@ -1105,7 +1162,7 @@ DoTildeSubst(interp, user, resultPtr) /* *---------------------------------------------------------------------- * - * Tcl_GlobCmd -- + * Tcl_GlobObjCmd -- * * This procedure is invoked to process the "glob" Tcl command. * See the user documentation for details on what it does. @@ -1121,42 +1178,103 @@ DoTildeSubst(interp, user, resultPtr) /* ARGSUSED */ int -Tcl_GlobCmd(dummy, interp, argc, argv) +Tcl_GlobObjCmd(dummy, interp, objc, objv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ { - int i, noComplain, firstArg; - char c; - int result = TCL_OK; - Tcl_DString buffer; - char *separators, *head, *tail; + int index, i, noComplain, skip, length; + char *string; + static char *options[] = {"-nocomplain", "--", NULL}; + enum options {GLOB_NOCOMPLAIN, GLOB_LAST}; noComplain = 0; - for (firstArg = 1; (firstArg < argc) && (argv[firstArg][0] == '-'); - firstArg++) { - if (strcmp(argv[firstArg], "-nocomplain") == 0) { - noComplain = 1; - } else if (strcmp(argv[firstArg], "--") == 0) { - firstArg++; + for (skip = 1; skip < objc; skip++) { + string = Tcl_GetString(objv[skip]); + if (string[0] != '-') { break; - } else { - Tcl_AppendResult(interp, "bad switch \"", argv[firstArg], - "\": must be -nocomplain or --", (char *) NULL); + } + if (Tcl_GetIndexFromObj(interp, objv[skip], options, "switch", + TCL_EXACT, &index) != TCL_OK) { return TCL_ERROR; } + if (index == GLOB_NOCOMPLAIN) { + noComplain = 1; + } else { + skip++; + break; + } } - if (firstArg >= argc) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " ?switches? name ?name ...?\"", (char *) NULL); + if (skip >= objc) { + Tcl_WrongNumArgs(interp, 1, objv, "?switches? name ?name ...?"); return TCL_ERROR; } - Tcl_DStringInit(&buffer); - separators = NULL; /* Needed only to prevent gcc warnings. */ - for (i = firstArg; i < argc; i++) { - switch (tclPlatform) { + for (i = skip; i < objc; i++) { + string = Tcl_GetString(objv[i]); + if (TclGlob(interp, string, noComplain) != TCL_OK) { + return TCL_ERROR; + } + } + if (noComplain == 0) { + Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &length); + if (length == 0) { + char *sep = ""; + + Tcl_AppendResult(interp, "no files matched glob pattern", + (objc == 2) ? " \"" : "s \"", (char *) NULL); + for (i = skip; i < objc; i++) { + string = Tcl_GetString(objv[i]); + Tcl_AppendResult(interp, sep, string, (char *) NULL); + sep = " "; + } + Tcl_AppendResult(interp, "\"", (char *) NULL); + return TCL_ERROR; + } + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TclGlob -- + * + * This procedure prepares arguments for the TclDoGlob call. + * It sets the separator string based on the platform, performs + * tilde substitution, and calls TclDoGlob. + * + * Results: + * The return value is a standard Tcl result indicating whether + * an error occurred in globbing. After a normal return the + * result in interp (set by TclDoGlob) holds all of the file names + * given by the dir and rem arguments. After an error the + * result in interp will hold an error message. + * + * Side effects: + * The currentArgString is written to. + * + *---------------------------------------------------------------------- + */ + + /* ARGSUSED */ +int +TclGlob(interp, pattern, noComplain) + Tcl_Interp *interp; /* Interpreter for returning error message + * or appending list of matching file names. */ + char *pattern; /* Glob pattern to match. */ + int noComplain; /* Flag to turn off storing error messages + * in interp. */ +{ + char *separators; + char *head, *tail; + char c; + int result; + Tcl_DString buffer; + + separators = NULL; /* lint. */ + switch (tclPlatform) { case TCL_PLATFORM_UNIX: separators = "/"; break; @@ -1164,102 +1282,84 @@ Tcl_GlobCmd(dummy, interp, argc, argv) separators = "/\\:"; break; case TCL_PLATFORM_MAC: - separators = (strchr(argv[i], ':') == NULL) ? "/" : ":"; + separators = (strchr(pattern, ':') == NULL) + ? "/" : ":"; break; - } + } - Tcl_DStringSetLength(&buffer, 0); + Tcl_DStringInit(&buffer); - /* - * Perform tilde substitution, if needed. - */ + /* + * Perform tilde substitution, if needed. + */ - if (argv[i][0] == '~') { - char *p; + if (pattern[0] == '~') { + char *p; - /* - * Find the first path separator after the tilde. - */ + /* + * Find the first path separator after the tilde. + */ - for (tail = argv[i]; *tail != '\0'; tail++) { - if (*tail == '\\') { - if (strchr(separators, tail[1]) != NULL) { - break; - } - } else if (strchr(separators, *tail) != NULL) { + for (tail = pattern; *tail != '\0'; tail++) { + if (*tail == '\\') { + if (strchr(separators, tail[1]) != NULL) { break; } + } else if (strchr(separators, *tail) != NULL) { + break; } + } - /* - * Determine the home directory for the specified user. Note that - * we don't allow special characters in the user name. - */ - - c = *tail; - *tail = '\0'; - p = strpbrk(argv[i]+1, "\\[]*?{}"); - if (p == NULL) { - head = DoTildeSubst(interp, argv[i]+1, &buffer); - } else { - if (!noComplain) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "globbing characters not ", - "supported in user names", (char *) NULL); - } - head = NULL; - } - *tail = c; - if (head == NULL) { - if (noComplain) { - Tcl_ResetResult(interp); - continue; - } else { - result = TCL_ERROR; - goto done; - } - } - if (head != Tcl_DStringValue(&buffer)) { - Tcl_DStringAppend(&buffer, head, -1); - } + /* + * Determine the home directory for the specified user. Note that + * we don't allow special characters in the user name. + */ + + c = *tail; + *tail = '\0'; + p = strpbrk(pattern+1, "\\[]*?{}"); + if (p == NULL) { + head = DoTildeSubst(interp, pattern+1, &buffer); } else { - tail = argv[i]; + if (!noComplain) { + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "globbing characters not ", + "supported in user names", (char *) NULL); + } + head = NULL; } - - result = TclDoGlob(interp, separators, &buffer, tail); - if (result != TCL_OK) { + *tail = c; + if (head == NULL) { if (noComplain) { /* * We should in fact pass down the nocomplain flag - * or save the interp result or use another mecanism + * or save the interp result or use another mechanism * so the interp result is not mangled on errors in that case. * but that would a bigger change than reasonable for a patch * release. * (see fileName.test 15.2-15.4 for expected behaviour) */ Tcl_ResetResult(interp); - result = TCL_OK; - continue; + return TCL_OK; } else { - goto done; + return TCL_ERROR; } } + if (head != Tcl_DStringValue(&buffer)) { + Tcl_DStringAppend(&buffer, head, -1); + } + } else { + tail = pattern; } - if ((*interp->result == 0) && !noComplain) { - char *sep = ""; - - Tcl_AppendResult(interp, "no files matched glob pattern", - (argc == 2) ? " \"" : "s \"", (char *) NULL); - for (i = firstArg; i < argc; i++) { - Tcl_AppendResult(interp, sep, argv[i], (char *) NULL); - sep = " "; + result = TclDoGlob(interp, separators, &buffer, tail); + Tcl_DStringFree(&buffer); + if (result != TCL_OK) { + if (noComplain) { + Tcl_ResetResult(interp); + return TCL_OK; } - Tcl_AppendResult(interp, "\"", (char *) NULL); - result = TCL_ERROR; } -done: - Tcl_DStringFree(&buffer); return result; } @@ -1350,7 +1450,7 @@ TclDoGlob(interp, separators, headPtr, tail) { int baseLength, quoted, count; int result = TCL_OK; - char *p, *openBrace, *closeBrace, *name, *firstSpecialChar, savedChar; + char *name, *p, *openBrace, *closeBrace, *firstSpecialChar, savedChar; char lastChar = 0; int length = Tcl_DStringLength(headPtr); @@ -1535,11 +1635,11 @@ TclDoGlob(interp, separators, headPtr, tail) * Look for matching files in the current directory. The * implementation of this function is platform specific, but may * recursively call TclDoGlob. For each file that matches, it will - * add the match onto the interp->result, or call TclDoGlob if there + * add the match onto the interp's result, or call TclDoGlob if there * are more characters to be processed. */ - return TclMatchFiles(interp, separators, headPtr, tail, p); + return TclpMatchFiles(interp, separators, headPtr, tail, p); } Tcl_DStringAppend(headPtr, tail, p-tail); if (*p != '\0') { @@ -1553,21 +1653,23 @@ TclDoGlob(interp, separators, headPtr, tail) */ switch (tclPlatform) { - case TCL_PLATFORM_MAC: + case TCL_PLATFORM_MAC: { if (strchr(Tcl_DStringValue(headPtr), ':') == NULL) { Tcl_DStringAppend(headPtr, ":", 1); } name = Tcl_DStringValue(headPtr); - if (access(name, F_OK) == 0) { + if (TclpAccess(name, F_OK) == 0) { if ((name[1] != '\0') && (strchr(name+1, ':') == NULL)) { - Tcl_AppendElement(interp, name+1); + Tcl_AppendElement(interp, name + 1); } else { Tcl_AppendElement(interp, name); } } break; + } case TCL_PLATFORM_WINDOWS: { int exists; + /* * We need to convert slashes to backslashes before checking * for the existence of the file. Once we are done, we need @@ -1589,7 +1691,8 @@ TclDoGlob(interp, separators, headPtr, tail) } } name = Tcl_DStringValue(headPtr); - exists = (access(name, F_OK) == 0); + exists = (TclpAccess(name, F_OK) == 0); + for (p = name; *p != '\0'; p++) { if (*p == '\\') { *p = '/'; @@ -1600,7 +1703,7 @@ TclDoGlob(interp, separators, headPtr, tail) } break; } - case TCL_PLATFORM_UNIX: + case TCL_PLATFORM_UNIX: { if (Tcl_DStringLength(headPtr) == 0) { if ((*name == '\\' && name[1] == '/') || (*name == '/')) { Tcl_DStringAppend(headPtr, "/", 1); @@ -1609,10 +1712,11 @@ TclDoGlob(interp, separators, headPtr, tail) } } name = Tcl_DStringValue(headPtr); - if (access(name, F_OK) == 0) { + if (TclpAccess(name, F_OK) == 0) { Tcl_AppendElement(interp, name); } break; + } } return TCL_OK; |