diff options
Diffstat (limited to 'generic/tclFileName.c')
| -rw-r--r-- | generic/tclFileName.c | 311 |
1 files changed, 80 insertions, 231 deletions
diff --git a/generic/tclFileName.c b/generic/tclFileName.c index dba137c..74e4d7f 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -26,8 +26,6 @@ TclPlatformType tclPlatform = TCL_PLATFORM_UNIX; * Prototypes for local procedures defined in this file: */ -static const char * DoTildeSubst(Tcl_Interp *interp, - const char *user, Tcl_DString *resultPtr); static const char * ExtractWinRoot(const char *path, Tcl_DString *resultPtr, int offset, Tcl_PathType *typePtr); @@ -362,12 +360,6 @@ Tcl_GetPathType( * file). The exported function Tcl_FSGetPathType should be used by * extensions. * - * Note that '~' paths are always considered TCL_PATH_ABSOLUTE, even - * though expanding the '~' could lead to any possible path type. This - * function should therefore be considered a low-level, string - * manipulation function only -- it doesn't actually do any expansion in - * making its determination. - * * Results: * Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or * TCL_PATH_VOLUME_RELATIVE. @@ -388,81 +380,66 @@ TclpGetNativePathType( Tcl_PathType type = TCL_PATH_ABSOLUTE; const char *path = TclGetString(pathPtr); - if (path[0] == '~') { - /* - * This case is common to all platforms. Paths that begin with ~ are - * absolute. - */ - - if (driveNameLengthPtr != NULL) { - const char *end = path + 1; - while ((*end != '\0') && (*end != '/')) { - end++; - } - *driveNameLengthPtr = end - path; - } - } else { - switch (tclPlatform) { - case TCL_PLATFORM_UNIX: { - const char *origPath = path; + switch (tclPlatform) { + case TCL_PLATFORM_UNIX: { + const char *origPath = path; - /* - * Paths that begin with / are absolute. - */ + /* + * Paths that begin with / are absolute. + */ - if (path[0] == '/') { - ++path; + if (path[0] == '/') { + ++path; #if defined(__CYGWIN__) || defined(__QNX__) - /* - * Check for "//" network path prefix - */ - if ((*path == '/') && path[1] && (path[1] != '/')) { - path += 2; - while (*path && *path != '/') { - ++path; - } + /* + * Check for "//" network path prefix + */ + if ((*path == '/') && path[1] && (path[1] != '/')) { + path += 2; + while (*path && *path != '/') { + ++path; + } #if defined(__CYGWIN__) - /* UNC paths need to be followed by a share name */ - if (*path++ && (*path && *path != '/')) { - ++path; - while (*path && *path != '/') { - ++path; - } - } else { - path = origPath + 1; - } + /* UNC paths need to be followed by a share name */ + if (*path++ && (*path && *path != '/')) { + ++path; + while (*path && *path != '/') { + ++path; + } + } else { + path = origPath + 1; + } #endif - } + } #endif - if (driveNameLengthPtr != NULL) { - /* - * We need this addition in case the QNX or Cygwin code was used. - */ - - *driveNameLengthPtr = (path - origPath); - } - } else { - type = TCL_PATH_RELATIVE; - } - break; - } - case TCL_PLATFORM_WINDOWS: { - Tcl_DString ds; - const char *rootEnd; - - Tcl_DStringInit(&ds); - rootEnd = ExtractWinRoot(path, &ds, 0, &type); - if ((rootEnd != path) && (driveNameLengthPtr != NULL)) { - *driveNameLengthPtr = rootEnd - path; - if (driveNameRef != NULL) { - *driveNameRef = TclDStringToObj(&ds); - Tcl_IncrRefCount(*driveNameRef); - } - } - Tcl_DStringFree(&ds); - break; - } - } + if (driveNameLengthPtr != NULL) { + /* + * We need this addition in case the QNX or Cygwin code was used. + */ + + *driveNameLengthPtr = (path - origPath); + } + } else { + type = TCL_PATH_RELATIVE; + } + break; + } + case TCL_PLATFORM_WINDOWS: { + Tcl_DString ds; + const char *rootEnd; + + Tcl_DStringInit(&ds); + rootEnd = ExtractWinRoot(path, &ds, 0, &type); + if ((rootEnd != path) && (driveNameLengthPtr != NULL)) { + *driveNameLengthPtr = rootEnd - path; + if (driveNameRef != NULL) { + *driveNameRef = TclDStringToObj(&ds); + Tcl_IncrRefCount(*driveNameRef); + } + } + Tcl_DStringFree(&ds); + break; + } } return type; } @@ -685,8 +662,7 @@ SplitUnixPath( } /* - * Split on slashes. Embedded elements that start with tilde will be - * prefixed with "./" so they are not affected by tilde substitution. + * Split on slashes. */ for (;;) { @@ -697,13 +673,8 @@ SplitUnixPath( length = path - elementStart; if (length > 0) { Tcl_Obj *nextElt; - if ((elementStart[0] == '~') && (elementStart != origPath)) { - TclNewLiteralStringObj(nextElt, "./"); - Tcl_AppendToObj(nextElt, elementStart, length); - } else { - nextElt = Tcl_NewStringObj(elementStart, length); - } - Tcl_ListObjAppendElement(NULL, result, nextElt); + nextElt = Tcl_NewStringObj(elementStart, length); + Tcl_ListObjAppendElement(NULL, result, nextElt); } if (*path++ == '\0') { break; @@ -753,9 +724,7 @@ SplitWinPath( Tcl_DStringFree(&buf); /* - * Split on slashes. Embedded elements that start with tilde or a drive - * letter will be prefixed with "./" so they are not affected by tilde - * substitution. + * Split on slashes. */ do { @@ -766,10 +735,10 @@ SplitWinPath( length = p - elementStart; if (length > 0) { Tcl_Obj *nextElt; - if ((elementStart != path) && ((elementStart[0] == '~') - || (isalpha(UCHAR(elementStart[0])) - && elementStart[1] == ':'))) { - TclNewLiteralStringObj(nextElt, "./"); + if ((elementStart != path) && + isalpha(UCHAR(elementStart[0])) && + (elementStart[1] == ':')) { + TclNewLiteralStringObj(nextElt, "./"); Tcl_AppendToObj(nextElt, elementStart, length); } else { nextElt = Tcl_NewStringObj(elementStart, length); @@ -864,17 +833,19 @@ TclpNativeJoinPath( start = Tcl_GetStringFromObj(prefix, &length); /* - * Remove the ./ from tilde prefixed elements, and drive-letter prefixed + * Remove the ./ from drive-letter prefixed * elements on Windows, unless it is the first component. */ p = joining; if (length != 0) { - if ((p[0] == '.') && (p[1] == '/') && ((p[2] == '~') - || (tclPlatform==TCL_PLATFORM_WINDOWS && isalpha(UCHAR(p[2])) - && (p[3] == ':')))) { - p += 2; + if ((p[0] == '.') && + (p[1] == '/') && + (tclPlatform==TCL_PLATFORM_WINDOWS) && + isalpha(UCHAR(p[2])) && + (p[3] == ':')) { + p += 2; } } if (*p == '\0') { @@ -1025,19 +996,15 @@ Tcl_JoinPath( * 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. * * Results: - * 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 + * The return value is a pointer to a string containing the name. + * This may either be the name pointer passed in or space allocated in + * bufferPtr. In all cases, if the return value is not NULL, the caller + * must call Tcl_DStringFree() to free the space. 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: * None. @@ -1054,7 +1021,7 @@ Tcl_TranslateFileName( * "~<user>" (to indicate any user's home * directory). */ Tcl_DString *bufferPtr) /* Uninitialized or free DString filled with - * name after tilde substitution. */ + * name. */ { Tcl_Obj *path = Tcl_NewStringObj(name, -1); Tcl_Obj *transPtr; @@ -1149,65 +1116,6 @@ TclGetExtension( /* *---------------------------------------------------------------------- * - * DoTildeSubst -- - * - * Given a string following a tilde, this routine returns the - * corresponding home directory. - * - * 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 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. - * - *---------------------------------------------------------------------- - */ - -static const char * -DoTildeSubst( - Tcl_Interp *interp, /* Interpreter in which to store error message - * (if necessary). */ - const char *user, /* Name of user whose home directory should be - * substituted, or "" for current user. */ - Tcl_DString *resultPtr) /* Initialized DString filled with name after - * tilde substitution. */ -{ - const char *dir; - - if (*user == '\0') { - Tcl_DString dirString; - - dir = TclGetEnv("HOME", &dirString); - if (dir == NULL) { - if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "couldn't find HOME environment " - "variable to expand path", -1)); - Tcl_SetErrorCode(interp, "TCL", "FILENAME", "NO_HOME", NULL); - } - return NULL; - } - Tcl_JoinPath(1, &dir, resultPtr); - Tcl_DStringFree(&dirString); - } else if (TclpGetUserHome(user, resultPtr) == NULL) { - if (interp) { - Tcl_ResetResult(interp); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "user \"%s\" doesn't exist", user)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "USER", user, NULL); - } - return NULL; - } - return Tcl_DStringValue(resultPtr); -} - -/* - *---------------------------------------------------------------------- - * * Tcl_GlobObjCmd -- * * This procedure is invoked to process the "glob" Tcl command. See the @@ -1692,8 +1600,7 @@ Tcl_GlobObjCmd( * * TclGlob -- * - * Sets the separator string based on the platform, performs tilde - * substitution, and calls DoGlob. + * Sets the separator string based on the platform and calls DoGlob. * * The interpreter's result, on entry to this function, must be a valid * Tcl list (e.g. it could be empty), since we will lappend any new @@ -1729,8 +1636,7 @@ TclGlob( * NULL. */ { const char *separators; - const char *head; - char *tail, *start; + char *tail; int result; Tcl_Obj *filenamesObj, *savedResultObj; @@ -1744,60 +1650,10 @@ TclGlob( break; } - if (pathPrefix == NULL) { - char c; - Tcl_DString buffer; - Tcl_DStringInit(&buffer); - - start = pattern; - - /* - * Perform tilde substitution, if needed. - */ - - if (start[0] == '~') { - /* - * Find the first path separator after the tilde. - */ - - for (tail = start; *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. - */ - - c = *tail; - *tail = '\0'; - head = DoTildeSubst(interp, start+1, &buffer); - *tail = c; - if (head == NULL) { - return TCL_ERROR; - } - if (head != Tcl_DStringValue(&buffer)) { - Tcl_DStringAppend(&buffer, head, -1); - } - pathPrefix = TclDStringToObj(&buffer); - Tcl_IncrRefCount(pathPrefix); - globFlags |= TCL_GLOBMODE_DIR; - if (c != '\0') { - tail++; - } - Tcl_DStringFree(&buffer); - } else { - tail = pattern; - } - } else { + if (pathPrefix != NULL) { Tcl_IncrRefCount(pathPrefix); - tail = pattern; } + tail = pattern; /* * Handling empty path prefixes with glob patterns like 'C:' or @@ -2351,14 +2207,7 @@ DoGlob( for (i=0; result==TCL_OK && i<subdirc; i++) { Tcl_Obj *copy = NULL; - if (pathPtr == NULL && TclGetString(subdirv[i])[0] == '~') { - TclListObjLengthM(NULL, matchesObj, &repair); - copy = subdirv[i]; - subdirv[i] = Tcl_NewStringObj("./", 2); - Tcl_AppendObjToObj(subdirv[i], copy); - Tcl_IncrRefCount(subdirv[i]); - } - result = DoGlob(interp, matchesObj, separators, subdirv[i], + result = DoGlob(interp, matchesObj, separators, subdirv[i], 1, p+1, types); if (copy) { size_t end; |