summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclFileName.c17
-rw-r--r--generic/tclFileSystem.h8
-rw-r--r--generic/tclIOUtil.c190
-rw-r--r--generic/tclPathObj.c86
4 files changed, 40 insertions, 261 deletions
diff --git a/generic/tclFileName.c b/generic/tclFileName.c
index 785769a..aba17d7 100644
--- a/generic/tclFileName.c
+++ b/generic/tclFileName.c
@@ -10,7 +10,7 @@
* 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.59 2004/10/06 23:44:06 dkf Exp $
+ * RCS: @(#) $Id: tclFileName.c,v 1.60 2004/10/07 14:50:21 vincentdarley Exp $
*/
#include "tclInt.h"
@@ -1788,8 +1788,19 @@ TclGlob(interp, pattern, pathPrefix, globFlags, types)
/* If this length has never been set, set it here */
CONST char *pre = Tcl_GetStringFromObj(pathPrefix, &prefixLen);
- if (prefixLen > 0) {
- if (strchr(separators, pre[prefixLen-1]) == NULL) {
+ if (prefixLen > 0
+ && (strchr(separators, pre[prefixLen-1]) == NULL)) {
+
+ /*
+ * If we're on Windows and the prefix is a volume
+ * relative one like 'C:', then there won't be
+ * a path separator in between, so no need to
+ * skip it here.
+ */
+
+ if ((tclPlatform != TCL_PLATFORM_WINDOWS)
+ || (prefixLen != 2)
+ || (pre[1] != ':')) {
prefixLen++;
}
}
diff --git a/generic/tclFileSystem.h b/generic/tclFileSystem.h
index 2fe4bd6..a9a9245 100644
--- a/generic/tclFileSystem.h
+++ b/generic/tclFileSystem.h
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclFileSystem.h,v 1.8 2004/09/27 15:00:39 vincentdarley Exp $
+ * RCS: @(#) $Id: tclFileSystem.h,v 1.9 2004/10/07 14:50:22 vincentdarley Exp $
*/
/*
@@ -87,7 +87,7 @@ extern Tcl_ThreadDataKey tclFsDataKey;
/*
* Private shared functions for use by tclIOUtil.c, tclPathObj.c
- * and tclFileName.c
+ * and tclFileName.c, and any platform-specific filesystem code.
*/
Tcl_PathType TclFSGetPathType _ANSI_ARGS_((Tcl_Obj *pathPtr,
Tcl_Filesystem **filesystemPtrPtr,
@@ -99,4 +99,8 @@ Tcl_PathType TclGetPathType _ANSI_ARGS_((Tcl_Obj *pathPtr,
Tcl_Filesystem **filesystemPtrPtr,
int *driveNameLengthPtr, Tcl_Obj **driveNameRef));
int TclFSEpochOk _ANSI_ARGS_((int filesystemEpoch));
+int TclFSCwdIsNative _ANSI_ARGS_((void));
+Tcl_Obj* TclWinVolumeRelativeNormalize _ANSI_ARGS_((Tcl_Interp *interp,
+ CONST char *path, Tcl_Obj **useThisCwdPtr));
Tcl_FSPathInFilesystemProc TclNativePathInFilesystem;
+Tcl_FSCreateInternalRepProc TclNativeCreateNativeRep;
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index fce520e..0f31689 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -17,7 +17,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclIOUtil.c,v 1.110 2004/10/06 23:44:07 dkf Exp $
+ * RCS: @(#) $Id: tclIOUtil.c,v 1.111 2004/10/07 14:50:22 vincentdarley Exp $
*/
#include "tclInt.h"
@@ -296,7 +296,6 @@ TCL_DECLARE_MUTEX(obsoleteFsHookMutex)
*/
static Tcl_FSFilesystemSeparatorProc NativeFilesystemSeparator;
static Tcl_FSFreeInternalRepProc NativeFreeInternalRep;
-static Tcl_FSCreateInternalRepProc NativeCreateNativeRep;
static Tcl_FSFileAttrStringsProc NativeFileAttrStrings;
static Tcl_FSFileAttrsGetProc NativeFileAttrsGet;
static Tcl_FSFileAttrsSetProc NativeFileAttrsSet;
@@ -344,7 +343,7 @@ Tcl_Filesystem tclNativeFilesystem = {
&TclNativeDupInternalRep,
&NativeFreeInternalRep,
&TclpNativeToNormalized,
- &NativeCreateNativeRep,
+ &TclNativeCreateNativeRep,
&TclpObjNormalizePath,
&TclpFilesystemPathType,
&NativeFilesystemSeparator,
@@ -467,6 +466,18 @@ FsThrExitProc(cd)
}
}
+int
+TclFSCwdIsNative()
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
+
+ if (tsdPtr->cwdClientData != NULL) {
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
/*
*----------------------------------------------------------------------
*
@@ -4127,179 +4138,6 @@ Tcl_FSGetNativePath(pathPtr)
/*
*---------------------------------------------------------------------------
*
- * NativeCreateNativeRep --
- *
- * Create a native representation for the given path.
- *
- * Results:
- * None.
- *
- * Side effects:
- * None.
- *
- *---------------------------------------------------------------------------
- */
-static ClientData
-NativeCreateNativeRep(pathPtr)
- Tcl_Obj* pathPtr;
-{
- char *nativePathPtr;
- Tcl_DString ds;
- Tcl_Obj* validPathPtr;
- int len;
- char *str;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
-
- if (tsdPtr->cwdClientData != NULL) {
- /* The cwd is native */
- validPathPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
- } else {
- /* Make sure the normalized path is set */
- validPathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
- Tcl_IncrRefCount(validPathPtr);
- }
-
- str = Tcl_GetStringFromObj(validPathPtr, &len);
-#ifdef __WIN32__
- Tcl_WinUtfToTChar(str, len, &ds);
- if (tclWinProcs->useWide) {
- len = Tcl_DStringLength(&ds) + sizeof(WCHAR);
- } else {
- len = Tcl_DStringLength(&ds) + sizeof(char);
- }
-#else
- Tcl_UtfToExternalDString(NULL, str, len, &ds);
- len = Tcl_DStringLength(&ds) + sizeof(char);
-#endif
- Tcl_DecrRefCount(validPathPtr);
- nativePathPtr = ckalloc((unsigned) len);
- memcpy((VOID*)nativePathPtr, (VOID*)Tcl_DStringValue(&ds), (size_t) len);
-
- Tcl_DStringFree(&ds);
- return (ClientData)nativePathPtr;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * TclpNativeToNormalized --
- *
- * Convert native format to a normalized path object, with refCount
- * of zero.
- *
- * Currently assumes all native paths are actually normalized
- * already, so if the path given is not normalized this will
- * actually just convert to a valid string path, but not
- * necessarily a normalized one.
- *
- * Results:
- * A valid normalized path.
- *
- * Side effects:
- * None.
- *
- *---------------------------------------------------------------------------
- */
-Tcl_Obj*
-TclpNativeToNormalized(clientData)
- ClientData clientData;
-{
- Tcl_DString ds;
- Tcl_Obj *objPtr;
- int len;
-
-#ifdef __WIN32__
- char *copy;
- char *p;
- Tcl_WinTCharToUtf((CONST char*)clientData, -1, &ds);
-#else
- CONST char *copy;
- Tcl_ExternalToUtfDString(NULL, (CONST char*)clientData, -1, &ds);
-#endif
-
- copy = Tcl_DStringValue(&ds);
- len = Tcl_DStringLength(&ds);
-
-#ifdef __WIN32__
- /*
- * Certain native path representations on Windows have this special
- * prefix to indicate that they are to be treated specially. For
- * example extremely long paths, or symlinks
- */
- if (*copy == '\\') {
- if (0 == strncmp(copy,"\\??\\",4)) {
- copy += 4;
- len -= 4;
- } else if (0 == strncmp(copy,"\\\\?\\",4)) {
- copy += 4;
- len -= 4;
- }
- }
- /*
- * Ensure we are using forward slashes only.
- */
- for (p = copy; *p != '\0'; p++) {
- if (*p == '\\') {
- *p = '/';
- }
- }
-#endif
-
- objPtr = Tcl_NewStringObj(copy,len);
- Tcl_DStringFree(&ds);
-
- return objPtr;
-}
-
-
-/*
- *---------------------------------------------------------------------------
- *
- * TclNativeDupInternalRep --
- *
- * Duplicate the native representation.
- *
- * Results:
- * The copied native representation, or NULL if it is not possible
- * to copy the representation.
- *
- * Side effects:
- * None.
- *
- *---------------------------------------------------------------------------
- */
-ClientData
-TclNativeDupInternalRep(clientData)
- ClientData clientData;
-{
- char *copy;
- size_t len;
-
- if (clientData == NULL) {
- return NULL;
- }
-
-#ifdef __WIN32__
- if (tclWinProcs->useWide) {
- /* unicode representation when running on NT/2K/XP */
- len = sizeof(WCHAR) + (wcslen((CONST WCHAR*)clientData) * sizeof(WCHAR));
- } else {
- /* ansi representation when running on 95/98/ME */
- len = sizeof(char) + (strlen((CONST char*)clientData) * sizeof(char));
- }
-#else
- /* ansi representation when running on Unix */
- len = sizeof(char) + (strlen((CONST char*)clientData) * sizeof(char));
-#endif
-
- copy = (char *) ckalloc(len);
- memcpy((VOID*)copy, (VOID*)clientData, len);
- return (ClientData)copy;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
* NativeFreeInternalRep --
*
* Free a native internal representation, which will be non-NULL.
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
index 57dc048..26d5e70 100644
--- a/generic/tclPathObj.c
+++ b/generic/tclPathObj.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclPathObj.c,v 1.36 2004/10/06 12:09:14 dkf Exp $
+ * RCS: @(#) $Id: tclPathObj.c,v 1.37 2004/10/07 14:50:23 vincentdarley Exp $
*/
#include "tclInt.h"
@@ -1238,7 +1238,7 @@ TclNewFSPathObj(Tcl_Obj *dirPtr, CONST char *addStrRep, int len)
Tcl_Obj*
TclFSMakePathRelative(interp, pathPtr, cwdPtr)
Tcl_Interp *interp; /* Used for error reporting if not NULL. */
- Tcl_Obj *pathPtr; /* The object we have. */
+ Tcl_Obj *pathPtr; /* The path we have. */
Tcl_Obj *cwdPtr; /* Make it relative to this. */
{
int cwdLen, len;
@@ -1789,86 +1789,12 @@ Tcl_FSGetNormalizedPath(interp, pathPtr)
/* We have a refCount on the cwd */
#ifdef __WIN32__
} else if (type == TCL_PATH_VOLUME_RELATIVE) {
- /*
- * Only Windows has volume-relative paths. These
- * paths are rather rare, but it is nice if Tcl can
- * handle them. It is much better if we can
- * handle them here, rather than in the native fs code,
- * because we really need to have a real absolute path
- * just below.
- *
- * We do not let this block compile on non-Windows
- * platforms because the test suite's manual forcing
- * of tclPlatform can otherwise cause this code path
- * to be executed, causing various errors because
- * volume-relative paths really do not exist.
- */
-
- useThisCwd = Tcl_FSGetCwd(interp);
- if (useThisCwd == NULL) {
+ /* Only Windows has volume-relative paths */
+ absolutePath = TclWinVolumeRelativeNormalize(interp, path,
+ &useThisCwd);
+ if (absolutePath == NULL) {
return NULL;
}
-
- if (path[0] == '/') {
- /*
- * Path of form /foo/bar which is a path in the
- * root directory of the current volume.
- */
-
- CONST char *drive = TclGetString(useThisCwd);
-
- absolutePath = Tcl_NewStringObj(drive, 2);
- Tcl_AppendToObj(absolutePath, path, -1);
- Tcl_IncrRefCount(absolutePath);
- /* We have a refCount on the cwd */
- } else {
- /*
- * Path of form C:foo/bar, but this only makes
- * sense if the cwd is also on drive C.
- */
-
- int cwdLen;
- CONST char *drive =
- Tcl_GetStringFromObj(useThisCwd, &cwdLen);
- char drive_cur = path[0];
-
- if (drive_cur >= 'a') {
- drive_cur -= ('a' - 'A');
- }
- if (drive[0] == drive_cur) {
- absolutePath = Tcl_DuplicateObj(useThisCwd);
- /*
- * We have a refCount on the cwd, which we
- * will release later.
- */
-
- if (drive[cwdLen-1] != '/' && (path[2] != '\0')) {
- /*
- * Only add a trailing '/' if needed, which
- * is if there isn't one already, and if we
- * are going to be adding some more
- * characters.
- */
- Tcl_AppendToObj(absolutePath, "/", 1);
- }
- } else {
- TclDecrRefCount(useThisCwd);
- useThisCwd = NULL;
-
- /*
- * The path is not in the current drive, but
- * is volume-relative. The way Tcl 8.3 handles
- * this is that it treats such a path as
- * relative to the root of the drive. We
- * therefore behave the same here.
- */
-
- absolutePath = Tcl_NewStringObj(path, 2);
- Tcl_AppendToObj(absolutePath, "/", 1);
- }
- Tcl_IncrRefCount(absolutePath);
- Tcl_AppendToObj(absolutePath, path+2, -1);
- }
#endif /* __WIN32__ */
}
}
generated by cgit v0.12 at 2024-12-04 17:28:28 (GMT)