diff options
Diffstat (limited to 'generic/tclFileName.c')
| -rw-r--r-- | generic/tclFileName.c | 217 |
1 files changed, 174 insertions, 43 deletions
diff --git a/generic/tclFileName.c b/generic/tclFileName.c index 1839564..3eb9a17 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -10,25 +10,17 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclFileName.c,v 1.19 2001/08/30 08:53:14 vincentdarley Exp $ + * RCS: @(#) $Id: tclFileName.c,v 1.20 2001/09/04 18:06:34 vincentdarley Exp $ */ #include "tclInt.h" #include "tclPort.h" #include "tclRegexp.h" -/* - * The following regular expression matches the root portion of a Windows - * absolute or volume relative path. It will match both UNC and drive relative - * paths. This pattern is no longer used, since it has been replaced by - * the ExtractWinRoot function. - */ - -#define WIN_ROOT_PATTERN "^(([a-zA-Z]:)|[/\\\\][/\\\\]+([^/\\\\]+)[/\\\\]+([^/\\\\]+)|([/\\\\]))([/\\\\])*" - /* * This define is used to activate Tcl's interpretation of Unix-style - * paths (containing forward slashes) on MacOS. + * paths (containing forward slashes, '.' and '..') on MacOS. A + * side-effect of this is that some paths become ambiguous. */ #define MAC_UNDERSTANDS_UNIX_PATHS @@ -36,19 +28,19 @@ /* * The following regular expression matches the root portion of a Macintosh * absolute path. It will match degenerate Unix-style paths, tilde paths, - * Unix-style paths, and Mac paths. + * Unix-style paths, and Mac paths. The various subexpressions in this + * can be summarised as follows: ^(/..|~user/unix|~user:mac|/unix|mac:dir). + * The subexpression indices which match the root portions, are as follows: + * + * degenerate unix-style: 2 + * unix-tilde: 5 + * mac-tilde: 7 + * unix-style: 9 (or 10 to cut off the irrelevant header). + * mac: 12 + * */ #define MAC_ROOT_PATTERN "^((/+([.][.]?/+)*([.][.]?)?)|(~[^:/]*)(/[^:]*)?|(~[^:]*)(:.*)?|/+([.][.]?/+)*([^:/]+)(/[^:]*)?|([^:]+):.*)$" -#else -/* - * The following regular expression and some code below needs to be updated - * to allow complete removal of unix-style path matching. For the moment - * this regular expression is the same as the one above. - */ - -#define MAC_ROOT_PATTERN "^((/+([.][.]?/+)*([.][.]?)?)|(~[^:/]*)(/[^:]*)?|(~[^:]*)(:.*)?|/+([.][.]?/+)*([^:/]+)(/[^:]*)?|([^:]+):.*)$" -#endif /* * The following variables are used to hold precompiled regular expressions @@ -62,6 +54,11 @@ typedef struct ThreadSpecificData { static Tcl_ThreadDataKey dataKey; +static void FileNameCleanup _ANSI_ARGS_((ClientData clientData)); +static void FileNameInit _ANSI_ARGS_((void)); + +#endif + /* * The following variable is set in the TclPlatformInit call to one * of: TCL_PLATFORM_UNIX, TCL_PLATFORM_MAC, or TCL_PLATFORM_WINDOWS. @@ -78,13 +75,12 @@ static char * DoTildeSubst _ANSI_ARGS_((Tcl_Interp *interp, static CONST char * ExtractWinRoot _ANSI_ARGS_((CONST char *path, Tcl_DString *resultPtr, int offset, Tcl_PathType *typePtr)); -static void FileNameCleanup _ANSI_ARGS_((ClientData clientData)); -static void FileNameInit _ANSI_ARGS_((void)); static int SkipToChar _ANSI_ARGS_((char **stringPtr, char *match)); static Tcl_Obj* SplitMacPath _ANSI_ARGS_((CONST char *path)); static Tcl_Obj* SplitWinPath _ANSI_ARGS_((CONST char *path)); static Tcl_Obj* SplitUnixPath _ANSI_ARGS_((CONST char *path)); +#ifdef MAC_UNDERSTANDS_UNIX_PATHS /* *---------------------------------------------------------------------- @@ -138,6 +134,7 @@ FileNameCleanup(clientData) Tcl_DecrRefCount(tsdPtr->macRootPatternPtr); tsdPtr->initialized = 0; } +#endif /* *---------------------------------------------------------------------- @@ -167,8 +164,6 @@ ExtractWinRoot(path, resultPtr, offset, typePtr) * stored. */ Tcl_PathType *typePtr; /* Where to store pathType result */ { - FileNameInit(); - if (path[0] == '/' || path[0] == '\\') { /* Might be a UNC or Vol-Relative path */ char *host, *share, *tail; @@ -192,7 +187,14 @@ ExtractWinRoot(path, resultPtr, offset, typePtr) /* * The path given is simply of the form * '/foo', '//foo', '/////foo' or the same - * with backslashes. + * with backslashes. If there is exactly + * one leading '/' the path is volume relative + * (see filename man page). If there are more + * than one, we are simply assuming they + * are superfluous and we trim them away. + * (An alternative interpretation would + * be that it is a host name, but we have + * been documented that that is not the case). */ *typePtr = TCL_PATH_VOLUME_RELATIVE; Tcl_DStringAppend(resultPtr, "/", 1); @@ -275,7 +277,7 @@ Tcl_GetPathType(path) Tcl_PathType type; Tcl_Obj *tempObj = Tcl_NewStringObj(path,-1); Tcl_IncrRefCount(tempObj); - type = Tcl_FSGetPathType(tempObj, NULL, NULL); + type = Tcl_FSGetPathType(tempObj); Tcl_DecrRefCount(tempObj); return type; } @@ -362,6 +364,7 @@ TclpGetNativePathType(pathObjPtr, driveNameLengthPtr, driveNameRef) if (path[0] == ':') { type = TCL_PATH_RELATIVE; } else { +#ifdef MAC_UNDERSTANDS_UNIX_PATHS ThreadSpecificData *tsdPtr; Tcl_RegExp re; @@ -380,7 +383,6 @@ TclpGetNativePathType(pathObjPtr, driveNameLengthPtr, driveNameRef) type = TCL_PATH_RELATIVE; } else { char *root, *end; - Tcl_RegExpRange(re, 2, &root, &end); if (root != NULL) { type = TCL_PATH_RELATIVE; @@ -389,7 +391,6 @@ TclpGetNativePathType(pathObjPtr, driveNameLengthPtr, driveNameRef) Tcl_RegExpRange(re, 0, &root, &end); *driveNameLengthPtr = end - root; } -#ifdef MAC_UNDERSTANDS_UNIX_PATHS if (driveNameRef != NULL) { if (*root == '/') { char *c; @@ -416,9 +417,25 @@ TclpGetNativePathType(pathObjPtr, driveNameLengthPtr, driveNameRef) } } } -#endif } } +#else + if (path[0] == '~') { + } else if (path[0] == ':') { + type = TCL_PATH_RELATIVE; + } else { + char *colonPos = strchr(path,':'); + if (colonPos == NULL) { + type = TCL_PATH_RELATIVE; + } else { + } + } + if (type == TCL_PATH_ABSOLUTE) { + if (driveNameLengthPtr != NULL) { + *driveNameLengthPtr = strlen(path); + } + } +#endif } break; @@ -762,14 +779,18 @@ SplitMacPath(path) CONST char *path; /* Pointer to string containing a path. */ { int isMac = 0; /* 1 if is Mac-style, 0 if Unix-style path. */ - int i, length; + int length; CONST char *p, *elementStart; - Tcl_RegExp re; Tcl_Obj *result; +#ifdef MAC_UNDERSTANDS_UNIX_PATHS + Tcl_RegExp re; + int i; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - +#endif + result = Tcl_NewObj(); +#ifdef MAC_UNDERSTANDS_UNIX_PATHS /* * Initialize the path name parser for Macintosh path names. */ @@ -843,13 +864,11 @@ SplitMacPath(path) } } } - 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. + * Append the element and terminate it with a : */ nextElt = Tcl_NewStringObj(start, length); @@ -860,15 +879,49 @@ SplitMacPath(path) isMac = (strchr(path, ':') != NULL); p = path; } +#else + if ((path[0] != ':') && (path[0] == '~' || (strchr(path,':') != NULL))) { + CONST char *end; + Tcl_Obj *nextElt; + + isMac = 1; + + end = strchr(path,':'); + if (end == NULL) { + length = strlen(path); + } else { + length = end - path; + } + + /* + * Append the element and terminate it with a : + */ + + nextElt = Tcl_NewStringObj(path, length); + Tcl_AppendToObj(nextElt, ":", 1); + Tcl_ListObjAppendElement(NULL, result, nextElt); + p = path + length; + } else { + isMac = (strchr(path, ':') != NULL); + isMac = 1; + p = path; + } +#endif if (isMac) { /* * p is pointing at the first colon in the path. There * will always be one, since this is a Mac-style path. + * (This is no longer true if MAC_UNDERSTANDS_UNIX_PATHS + * is false, so we must check whether 'p' points to the + * end of the string.) */ - - elementStart = p++; + elementStart = p; + if (*p == ':') { + p++; + } + while ((p = strchr(p, ':')) != NULL) { length = p - elementStart; if (length == 1) { @@ -891,13 +944,20 @@ SplitMacPath(path) elementStart = p++; } } - if (elementStart[1] != '\0' || elementStart == path) { - if ((elementStart[1] != '~') && (elementStart[1] != '\0') - && (strchr(elementStart+1, '/') == NULL)) { + if (elementStart[0] != ':') { + if (elementStart[0] != '\0') { + Tcl_ListObjAppendElement(NULL, result, + Tcl_NewStringObj(elementStart, -1)); + } + } else { + if (elementStart[1] != '\0' || elementStart == path) { + if ((elementStart[1] != '~') && (elementStart[1] != '\0') + && (strchr(elementStart+1, '/') == NULL)) { elementStart++; + } + Tcl_ListObjAppendElement(NULL, result, + Tcl_NewStringObj(elementStart, -1)); } - Tcl_ListObjAppendElement(NULL, result, - Tcl_NewStringObj(elementStart, -1)); } } else { @@ -1150,6 +1210,11 @@ TclpNativeJoinPath(prefix, joining) */ newLength = strlen(p); + /* + * It may not be good to just do 'Tcl_AppendToObj(prefix, + * p, newLength)' because the object may contain duplicate + * colons which we want to get rid of. + */ Tcl_AppendToObj(prefix, p, newLength); /* Remove spurious trailing single ':' */ @@ -2484,3 +2549,69 @@ TclDoGlob(interp, separators, headPtr, tail, types) return TCL_OK; } } + + +/* + *--------------------------------------------------------------------------- + * + * TclFileDirname + * + * This procedure calculates the directory above a given + * path: basically 'file dirname'. It is used both by + * the 'dirname' subcommand of file and by code in tclIOUtil.c. + * + * Results: + * NULL if an error occurred, otherwise a Tcl_Obj owned by + * the caller (i.e. most likely with refCount 1). + * + * Side effects: + * None. + * + *--------------------------------------------------------------------------- + */ + +Tcl_Obj* +TclFileDirname(interp, pathPtr) + Tcl_Interp *interp; /* Used for error reporting */ + Tcl_Obj *pathPtr; /* Path to take dirname of */ +{ + int splitElements; + Tcl_Obj *splitPtr; + Tcl_Obj *splitResultPtr = NULL; + + /* + * The behaviour we want here is slightly different to + * the standard Tcl_FSSplitPath in the handling of home + * directories; Tcl_FSSplitPath preserves the "~" while + * this code computes the actual full path name, if we + * had just a single component. + */ + splitPtr = Tcl_FSSplitPath(pathPtr, &splitElements); + if ((splitElements == 1) && (Tcl_GetString(pathPtr)[0] == '~')) { + Tcl_DecrRefCount(splitPtr); + splitPtr = Tcl_FSGetNormalizedPath(interp, pathPtr); + if (splitPtr == NULL) { + return NULL; + } + splitPtr = Tcl_FSSplitPath(splitPtr, &splitElements); + } + + /* + * Return all but the last component. If there is only one + * component, return it if the path was non-relative, otherwise + * return the current directory. + */ + + if (splitElements > 1) { + splitResultPtr = Tcl_FSJoinPath(splitPtr, splitElements - 1); + } else if (splitElements == 0 || + (Tcl_FSGetPathType(pathPtr) == TCL_PATH_RELATIVE)) { + splitResultPtr = Tcl_NewStringObj( + ((tclPlatform == TCL_PLATFORM_MAC) ? ":" : "."), 1); + } else { + Tcl_ListObjIndex(NULL, splitPtr, 0, &splitResultPtr); + } + Tcl_IncrRefCount(splitResultPtr); + Tcl_DecrRefCount(splitPtr); + return splitResultPtr; +} |