diff options
author | dgp <dgp@users.sourceforge.net> | 2012-11-15 17:55:25 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2012-11-15 17:55:25 (GMT) |
commit | 8a45c3faf392af5c64589268d0d7699c17b7feec (patch) | |
tree | a098b4e6b1d3b2a82e4d807dc53a33244eb57d2b /generic/tclFileName.c | |
parent | a06d3694d5af51acabffa650a8aaaa30e199d130 (diff) | |
download | tcl-8a45c3faf392af5c64589268d0d7699c17b7feec.zip tcl-8a45c3faf392af5c64589268d0d7699c17b7feec.tar.gz tcl-8a45c3faf392af5c64589268d0d7699c17b7feec.tar.bz2 |
More complete purge of things only present for supporting long-dead Mac 9 systems.
Diffstat (limited to 'generic/tclFileName.c')
-rw-r--r-- | generic/tclFileName.c | 579 |
1 files changed, 2 insertions, 577 deletions
diff --git a/generic/tclFileName.c b/generic/tclFileName.c index c5ecf0f..046eaef 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -16,51 +16,9 @@ #include "tclPort.h" #include "tclRegexp.h" -/* - * This define is used to activate Tcl's interpretation of Unix-style - * paths (containing forward slashes, '.' and '..') on MacOS. A - * side-effect of this is that some paths become ambiguous. - */ -#define MAC_UNDERSTANDS_UNIX_PATHS - -#ifdef MAC_UNDERSTANDS_UNIX_PATHS -/* - * 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. 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 "^((/+([.][.]?/+)*([.][.]?)?)|(~[^:/]*)(/[^:]*)?|(~[^:]*)(:.*)?|/+([.][.]?/+)*([^:/]+)(/[^:]*)?|([^:]+):.*)$" - -/* - * The following variables are used to hold precompiled regular expressions - * for use in filename matching. - */ - -typedef struct ThreadSpecificData { - int initialized; - Tcl_Obj *macRootPatternPtr; -} 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. + * of: TCL_PLATFORM_UNIX, or TCL_PLATFORM_WINDOWS. */ TclPlatformType tclPlatform = TCL_PLATFORM_UNIX; @@ -76,64 +34,8 @@ static CONST char * ExtractWinRoot _ANSI_ARGS_((CONST char *path, Tcl_PathType *typePtr)); 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 - -/* - *---------------------------------------------------------------------- - * - * FileNameInit -- - * - * This procedure initializes the patterns used by this module. - * - * Results: - * None. - * - * Side effects: - * Compiles the regular expressions. - * - *---------------------------------------------------------------------- - */ - -static void -FileNameInit() -{ - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - if (!tsdPtr->initialized) { - tsdPtr->initialized = 1; - tsdPtr->macRootPatternPtr = Tcl_NewStringObj(MAC_ROOT_PATTERN, -1); - Tcl_CreateThreadExitHandler(FileNameCleanup, NULL); - } -} - -/* - *---------------------------------------------------------------------- - * - * FileNameCleanup -- - * - * This procedure is a Tcl_ExitProc used to clean up the static - * data structures used in this file. - * - * Results: - * None. - * - * Side effects: - * Deallocates storage used by the procedures in this file. - * - *---------------------------------------------------------------------- - */ - -static void -FileNameCleanup(clientData) - ClientData clientData; /* Not used. */ -{ - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - Tcl_DecrRefCount(tsdPtr->macRootPatternPtr); - tsdPtr->initialized = 0; -} -#endif /* *---------------------------------------------------------------------- @@ -411,87 +313,6 @@ TclpGetNativePathType(pathObjPtr, driveNameLengthPtr, driveNameRef) } break; } - case TCL_PLATFORM_MAC: - if (path[0] == ':') { - type = TCL_PATH_RELATIVE; - } else { -#ifdef MAC_UNDERSTANDS_UNIX_PATHS - ThreadSpecificData *tsdPtr; - Tcl_RegExp re; - - tsdPtr = TCL_TSD_INIT(&dataKey); - - /* - * Since we have eliminated the easy cases, use the - * root pattern to look for the other types. - */ - - FileNameInit(); - re = Tcl_GetRegExpFromObj(NULL, tsdPtr->macRootPatternPtr, - REG_ADVANCED); - - if (!Tcl_RegExpExec(NULL, re, path, path)) { - type = TCL_PATH_RELATIVE; - } else { - CONST char *root, *end; - Tcl_RegExpRange(re, 2, &root, &end); - if (root != NULL) { - type = TCL_PATH_RELATIVE; - } else { - if (driveNameLengthPtr != NULL) { - Tcl_RegExpRange(re, 0, &root, &end); - *driveNameLengthPtr = end - root; - } - if (driveNameRef != NULL) { - if (*root == '/') { - char *c; - int gotColon = 0; - *driveNameRef = Tcl_NewStringObj(root + 1, - end - root -1); - c = Tcl_GetString(*driveNameRef); - while (*c != '\0') { - if (*c == '/') { - gotColon++; - *c = ':'; - } - c++; - } - /* - * If there is no colon, we have just a - * volume name so we must add a colon so - * it is an absolute path. - */ - if (gotColon == 0) { - Tcl_AppendToObj(*driveNameRef, ":", 1); - } else if ((gotColon > 1) && - (*(c-1) == ':')) { - /* We have an extra colon */ - Tcl_SetObjLength(*driveNameRef, - c - Tcl_GetString(*driveNameRef) - 1); - } - } - } - } - } -#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; case TCL_PLATFORM_WINDOWS: { Tcl_DString ds; @@ -559,9 +380,6 @@ TclpNativeSplitPath(pathPtr, lenPtr) resultPtr = SplitWinPath(Tcl_GetString(pathPtr)); break; - case TCL_PLATFORM_MAC: - resultPtr = SplitMacPath(Tcl_GetString(pathPtr)); - break; } /* @@ -821,246 +639,6 @@ SplitWinPath(path) } /* - *---------------------------------------------------------------------- - * - * SplitMacPath -- - * - * This routine is used by Tcl_(FS)SplitPath to handle splitting - * Macintosh paths. - * - * Results: - * Returns a newly allocated Tcl list object. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -static Tcl_Obj* -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 length; - CONST char *p, *elementStart; - 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. - */ - - FileNameInit(); - - /* - * Match the root portion of a Mac path name. - */ - - i = 0; /* Needed only to prevent gcc warnings. */ - - re = Tcl_GetRegExpFromObj(NULL, tsdPtr->macRootPatternPtr, REG_ADVANCED); - - if (Tcl_RegExpExec(NULL, re, path, path) == 1) { - CONST char *start, *end; - Tcl_Obj *nextElt; - - /* - * Treat degenerate absolute paths like / and /../.. as - * Mac relative file names for lack of anything else to do. - */ - - Tcl_RegExpRange(re, 2, &start, &end); - if (start) { - Tcl_Obj *elt = Tcl_NewStringObj(":", 1); - Tcl_RegExpRange(re, 0, &start, &end); - Tcl_AppendToObj(elt, path, end - start); - Tcl_ListObjAppendElement(NULL, result, elt); - return result; - } - - Tcl_RegExpRange(re, 5, &start, &end); - if (start) { - /* - * Unix-style tilde prefixed paths. - */ - - isMac = 0; - i = 5; - } else { - Tcl_RegExpRange(re, 7, &start, &end); - if (start) { - /* - * Mac-style tilde prefixed paths. - */ - - isMac = 1; - i = 7; - } else { - Tcl_RegExpRange(re, 10, &start, &end); - if (start) { - /* - * Normal Unix style paths. - */ - - isMac = 0; - i = 10; - } else { - Tcl_RegExpRange(re, 12, &start, &end); - if (start) { - /* - * Normal Mac style paths. - */ - - isMac = 1; - i = 12; - } - } - } - } - Tcl_RegExpRange(re, i, &start, &end); - length = end - start; - - /* - * Append the element and terminate it with a : - */ - - nextElt = Tcl_NewStringObj(start, length); - Tcl_AppendToObj(nextElt, ":", 1); - Tcl_ListObjAppendElement(NULL, result, nextElt); - p = end; - } else { - 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; - if (*p == ':') { - p++; - } - - while ((p = strchr(p, ':')) != NULL) { - length = p - elementStart; - if (length == 1) { - while (*p == ':') { - Tcl_ListObjAppendElement(NULL, result, - Tcl_NewStringObj("::", 2)); - elementStart = p++; - } - } else { - /* - * If this is a simple component, drop the leading colon. - */ - - if ((elementStart[1] != '~') - && (strchr(elementStart+1, '/') == NULL)) { - elementStart++; - length--; - } - Tcl_ListObjAppendElement(NULL, result, - Tcl_NewStringObj(elementStart, length)); - elementStart = p++; - } - } - 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)); - } - } - } else { - - /* - * Split on slashes, suppress extra /'s, and convert .. to ::. - */ - - for (;;) { - elementStart = p; - while ((*p != '\0') && (*p != '/')) { - p++; - } - length = p - elementStart; - if (length > 0) { - if ((length == 1) && (elementStart[0] == '.')) { - Tcl_ListObjAppendElement(NULL, result, - Tcl_NewStringObj(":", 1)); - } else if ((length == 2) && (elementStart[0] == '.') - && (elementStart[1] == '.')) { - Tcl_ListObjAppendElement(NULL, result, - Tcl_NewStringObj("::", 2)); - } else { - Tcl_Obj *nextElt; - if (*elementStart == '~') { - nextElt = Tcl_NewStringObj(":",1); - Tcl_AppendToObj(nextElt, elementStart, length); - } else { - nextElt = Tcl_NewStringObj(elementStart, length); - } - Tcl_ListObjAppendElement(NULL, result, nextElt); - } - } - if (*p++ == '\0') { - break; - } - } - } - return result; -} - -/* *--------------------------------------------------------------------------- * * Tcl_FSJoinToPath -- @@ -1222,85 +800,6 @@ TclpNativeJoinPath(prefix, joining) Tcl_SetObjLength(prefix, length); break; - case TCL_PLATFORM_MAC: { - int newLength; - - /* - * Sort out separators. We basically add the object we've - * been given, but we have to make sure that there is - * exactly one separator inbetween (unless the object we're - * adding contains multiple contiguous colons, all of which - * we must add). Also if an object is just ':' we don't - * bother to add it unless it's the very first element. - */ - -#ifdef MAC_UNDERSTANDS_UNIX_PATHS - int adjustedPath = 0; - if ((strchr(p, ':') == NULL) && (strchr(p, '/') != NULL)) { - char *start = p; - adjustedPath = 1; - while (*start != '\0') { - if (*start == '/') { - *start = ':'; - } - start++; - } - } -#endif - if (length > 0) { - if ((p[0] == ':') && (p[1] == '\0')) { - return; - } - if (start[length-1] != ':') { - if (*p != '\0' && *p != ':') { - Tcl_AppendToObj(prefix, ":", 1); - length++; - } - } else if (*p == ':') { - p++; - } - } else { - if (*p != '\0' && *p != ':') { - Tcl_AppendToObj(prefix, ":", 1); - length++; - } - } - - /* - * Append the element - */ - - 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 ':' */ - dest = Tcl_GetString(prefix) + length + newLength; - if (*(dest-1) == ':') { - if (dest-1 > Tcl_GetString(prefix)) { - if (*(dest-2) != ':') { - Tcl_SetObjLength(prefix, length + newLength -1); - } - } - } -#ifdef MAC_UNDERSTANDS_UNIX_PATHS - /* Revert the path to what it was */ - if (adjustedPath) { - char *start = joining; - while (*start != '\0') { - if (*start == ':') { - *start = '/'; - } - start++; - } - } -#endif - break; - } } return; } @@ -1459,18 +958,6 @@ TclGetExtension(name) lastSep = strrchr(name, '/'); break; - case TCL_PLATFORM_MAC: -#ifdef MAC_UNDERSTANDS_UNIX_PATHS - if (strchr(name, ':') == NULL) { - lastSep = strrchr(name, '/'); - } else { - lastSep = strrchr(name, ':'); - } -#else - lastSep = strrchr(name, ':'); -#endif - break; - case TCL_PLATFORM_WINDOWS: lastSep = NULL; for (p = name; *p != '\0'; p++) { @@ -1699,9 +1186,6 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv) case TCL_PLATFORM_WINDOWS: separators = "/\\:"; break; - case TCL_PLATFORM_MAC: - separators = ":"; - break; } if (dir == PATH_GENERAL) { int pathlength; @@ -2040,17 +1524,6 @@ TclGlob(interp, pattern, unquotedPrefix, globFlags, types) case TCL_PLATFORM_WINDOWS: separators = "/\\:"; break; - case TCL_PLATFORM_MAC: -#ifdef MAC_UNDERSTANDS_UNIX_PATHS - if (unquotedPrefix == NULL) { - separators = (strchr(pattern, ':') == NULL) ? "/" : ":"; - } else { - separators = ":"; - } -#else - separators = ":"; -#endif - break; } Tcl_DStringInit(&buffer); @@ -2183,16 +1656,6 @@ TclGlob(interp, pattern, unquotedPrefix, globFlags, types) Tcl_ListObjGetElements(NULL, Tcl_GetObjResult(interp), &objc, &objv); -#ifdef MAC_TCL - /* adjust prefixLen if TclDoGlob prepended a ':' */ - if ((prefixLen > 0) && (objc > 0) - && (Tcl_DStringValue(&buffer)[0] != ':')) { - char *str = Tcl_GetStringFromObj(objv[0],NULL); - if (str[0] == ':') { - prefixLen++; - } - } -#endif for (i = 0; i< objc; i++) { Tcl_Obj* elt; if (globFlags & TCL_GLOBMODE_TAILS) { @@ -2353,13 +1816,11 @@ TclDoGlob(interp, separators, headPtr, tail, types) } else if (strchr(separators, *tail) == NULL) { break; } - if (tclPlatform != TCL_PLATFORM_MAC) { if (*tail == '\\') { Tcl_DStringAppend(headPtr, separators, 1); } else { Tcl_DStringAppend(headPtr, tail, 1); } - } count++; } @@ -2370,31 +1831,6 @@ TclDoGlob(interp, separators, headPtr, tail, types) */ switch (tclPlatform) { - case TCL_PLATFORM_MAC: -#ifdef MAC_UNDERSTANDS_UNIX_PATHS - if (*separators == '/') { - if (((length == 0) && (count == 0)) - || ((length > 0) && (lastChar != ':'))) { - Tcl_DStringAppend(headPtr, ":", 1); - } - } else { -#endif - if (count == 0) { - if ((length > 0) && (lastChar != ':')) { - Tcl_DStringAppend(headPtr, ":", 1); - } - } else { - if (lastChar == ':') { - count--; - } - while (count-- > 0) { - Tcl_DStringAppend(headPtr, ":", 1); - } - } -#ifdef MAC_UNDERSTANDS_UNIX_PATHS - } -#endif - break; case TCL_PLATFORM_WINDOWS: /* * If this is a drive relative path, add the colon and the @@ -2575,11 +2011,7 @@ TclDoGlob(interp, separators, headPtr, tail, types) Tcl_DStringAppend(&ds, "./", 2); } Tcl_DStringAppend(&ds, Tcl_GetString(elt), -1); - if(tclPlatform == TCL_PLATFORM_MAC) { - Tcl_DStringAppend(&ds, ":",1); - } else { Tcl_DStringAppend(&ds, "/",1); - } ret = TclDoGlob(interp, separators, &ds, p+1, types); Tcl_DStringFree(&ds); if (ret != TCL_OK) { @@ -2630,12 +2062,6 @@ TclDoGlob(interp, separators, headPtr, tail, types) Tcl_Obj *nameObj; switch (tclPlatform) { - case TCL_PLATFORM_MAC: { - if (strchr(Tcl_DStringValue(headPtr), ':') == NULL) { - Tcl_DStringAppend(headPtr, ":", 1); - } - break; - } case TCL_PLATFORM_WINDOWS: { if (Tcl_DStringLength(headPtr) == 0) { if (((*name == '\\') && (name[1] == '/' || name[1] == '\\')) @@ -2737,8 +2163,7 @@ TclFileDirname(interp, pathPtr) splitResultPtr = Tcl_FSJoinPath(splitPtr, splitElements - 1); } else if (splitElements == 0 || (Tcl_FSGetPathType(pathPtr) == TCL_PATH_RELATIVE)) { - splitResultPtr = Tcl_NewStringObj( - ((tclPlatform == TCL_PLATFORM_MAC) ? ":" : "."), 1); + splitResultPtr = Tcl_NewStringObj(".", 1); } else { Tcl_ListObjIndex(NULL, splitPtr, 0, &splitResultPtr); } |