summaryrefslogtreecommitdiffstats
path: root/win
diff options
context:
space:
mode:
Diffstat (limited to 'win')
-rw-r--r--win/tclWin32Dll.c7
-rw-r--r--win/tclWinFCmd.c32
-rw-r--r--win/tclWinFile.c117
-rw-r--r--win/tclWinInt.h3
4 files changed, 130 insertions, 29 deletions
diff --git a/win/tclWin32Dll.c b/win/tclWin32Dll.c
index 2bccd07..4a5aefd 100644
--- a/win/tclWin32Dll.c
+++ b/win/tclWin32Dll.c
@@ -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: tclWin32Dll.c,v 1.31 2003/12/26 04:12:16 mdejong Exp $
+ * RCS: @(#) $Id: tclWin32Dll.c,v 1.32 2004/01/21 19:59:34 vincentdarley Exp $
*/
#include "tclWinInt.h"
@@ -648,6 +648,10 @@ TclWinSetInterfaces(
(BOOL (WINAPI *)(CONST TCHAR*, TCHAR*,
DWORD)) GetProcAddress(hInstance,
"GetVolumeNameForVolumeMountPointW");
+ tclWinProcs->getLongPathNameProc =
+ (DWORD (WINAPI *)(CONST TCHAR*, TCHAR*,
+ DWORD)) GetProcAddress(hInstance,
+ "GetLongPathNameW");
FreeLibrary(hInstance);
}
hInstance = LoadLibraryA("advapi32");
@@ -696,6 +700,7 @@ TclWinSetInterfaces(
LPSECURITY_ATTRIBUTES)) GetProcAddress(hInstance,
"CreateHardLinkA");
tclWinProcs->findFirstFileExProc = NULL;
+ tclWinProcs->getLongPathNameProc = NULL;
/*
* The 'findFirstFileExProc' function exists on some
* of 95/98/ME, but it seems not to work as anticipated.
diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c
index 1062a3f..f78f053 100644
--- a/win/tclWinFCmd.c
+++ b/win/tclWinFCmd.c
@@ -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: tclWinFCmd.c,v 1.39 2003/12/24 04:18:22 davygrvy Exp $
+ * RCS: @(#) $Id: tclWinFCmd.c,v 1.40 2004/01/21 19:59:34 vincentdarley Exp $
*/
#include "tclWinInt.h"
@@ -1593,10 +1593,9 @@ ConvertFileNameFormat(
{
int pathc, i;
Tcl_Obj *splitPath;
- int result = TCL_OK;
splitPath = Tcl_FSSplitPath(fileName, &pathc);
-
+
if (splitPath == NULL || pathc == 0) {
if (interp != NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
@@ -1604,10 +1603,16 @@ ConvertFileNameFormat(
"\": no such file or directory",
(char *) NULL);
}
- result = TCL_ERROR;
goto cleanup;
}
+ /*
+ * We will decrement this again at the end. It is safer to
+ * do this in case any of the calls below retain a reference
+ * to splitPath.
+ */
+ Tcl_IncrRefCount(splitPath);
+
for (i = 0; i < pathc; i++) {
Tcl_Obj *elt;
char *pathv;
@@ -1672,7 +1677,6 @@ ConvertFileNameFormat(
if (interp != NULL) {
StatError(interp, fileName);
}
- result = TCL_ERROR;
goto cleanup;
}
if (tclWinProcs->useWide) {
@@ -1730,13 +1734,27 @@ ConvertFileNameFormat(
}
*attributePtrPtr = Tcl_FSJoinPath(splitPath, -1);
+
+ if (splitPath != NULL) {
+ /*
+ * Unfortunately, the object we will return may have its only
+ * refCount as part of the list splitPath. This means if
+ * we free splitPath, the object will disappear. So, we
+ * have to be very careful here. Unfortunately this means
+ * we must manipulate the object's refCount directly.
+ */
+ Tcl_IncrRefCount(*attributePtrPtr);
+ Tcl_DecrRefCount(splitPath);
+ --(*attributePtrPtr)->refCount;
+ }
+ return TCL_OK;
-cleanup:
+ cleanup:
if (splitPath != NULL) {
Tcl_DecrRefCount(splitPath);
}
- return result;
+ return TCL_ERROR;
}
/*
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index a000802..12fad95 100644
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclWinFile.c,v 1.58 2003/12/16 02:55:38 davygrvy Exp $
+ * RCS: @(#) $Id: tclWinFile.c,v 1.59 2004/01/21 19:59:34 vincentdarley Exp $
*/
//#define _WIN32_WINNT 0x0500
@@ -1626,6 +1626,8 @@ TclpReadlink(path, linkPtr)
* TclpGetCwd --
*
* This function replaces the library version of getcwd().
+ * (Obsolete function, only retained for old extensions which
+ * may call it directly).
*
* Results:
* The result is a pointer to a string specifying the current
@@ -2090,19 +2092,56 @@ TclWinResolveShortcut(bufferPtr)
}
#endif
-Tcl_Obj*
-TclpObjGetCwd(interp)
- Tcl_Interp *interp;
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpGetNativeCwd --
+ *
+ * This function replaces the library version of getcwd().
+ *
+ * Results:
+ * The input and output are filesystem paths in native form. The
+ * result is either the given clientData, if the working directory
+ * hasn't changed, or a new clientData (owned by our caller),
+ * giving the new native path, or NULL if the current directory
+ * could not be determined. If NULL is returned, the caller can
+ * examine the standard posix error codes to determine the cause of
+ * the problem.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ClientData
+TclpGetNativeCwd(clientData)
+ ClientData clientData;
{
- Tcl_DString ds;
- if (TclpGetCwd(interp, &ds) != NULL) {
- Tcl_Obj *cwdPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
- Tcl_IncrRefCount(cwdPtr);
- Tcl_DStringFree(&ds);
- return cwdPtr;
- } else {
+ WCHAR buffer[MAX_PATH];
+
+ if ((*tclWinProcs->getCurrentDirectoryProc)(MAX_PATH, buffer) == 0) {
+ TclWinConvertError(GetLastError());
return NULL;
}
+
+ if (clientData != NULL) {
+ if (tclWinProcs->useWide) {
+ /* unicode representation when running on NT/2K/XP */
+ if (wcscmp((CONST WCHAR*)clientData,
+ (CONST WCHAR*)buffer) == 0) {
+ return clientData;
+ }
+ } else {
+ /* ansi representation when running on 95/98/ME */
+ if (strcmp((CONST char*)clientData,
+ (CONST char*)buffer) == 0) {
+ return clientData;
+ }
+ }
+ }
+
+ return TclNativeDupInternalRep((ClientData)buffer);
}
int
@@ -2139,7 +2178,11 @@ TclpObjLink(pathPtr, toPtr, linkAction)
{
if (toPtr != NULL) {
int res;
+#if 0
TCHAR* LinkTarget = (TCHAR*)Tcl_FSGetNativePath(toPtr);
+#else
+ TCHAR* LinkTarget = (TCHAR*)Tcl_FSGetNativePath(Tcl_FSGetNormalizedPath(NULL,toPtr));
+#endif
TCHAR* LinkSource = (TCHAR*)Tcl_FSGetNativePath(pathPtr);
if (LinkSource == NULL || LinkTarget == NULL) {
return NULL;
@@ -2180,8 +2223,8 @@ TclpObjLink(pathPtr, toPtr, linkAction)
*---------------------------------------------------------------------------
*/
Tcl_Obj*
-TclpFilesystemPathType(pathObjPtr)
- Tcl_Obj* pathObjPtr;
+TclpFilesystemPathType(pathPtr)
+ Tcl_Obj* pathPtr;
{
#define VOL_BUF_SIZE 32
int found;
@@ -2189,7 +2232,7 @@ TclpFilesystemPathType(pathObjPtr)
char* firstSeparator;
CONST char *path;
- Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathObjPtr);
+ Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathPtr);
if (normPath == NULL) return NULL;
path = Tcl_GetString(normPath);
if (path == NULL) return NULL;
@@ -2197,7 +2240,7 @@ TclpFilesystemPathType(pathObjPtr)
firstSeparator = strchr(path, '/');
if (firstSeparator == NULL) {
found = tclWinProcs->getVolumeInformationProc(
- Tcl_FSGetNativePath(pathObjPtr), NULL, 0, NULL, NULL,
+ Tcl_FSGetNativePath(pathPtr), NULL, 0, NULL, NULL,
NULL, (WCHAR *)volType, VOL_BUF_SIZE);
} else {
Tcl_Obj *driveName = Tcl_NewStringObj(path, firstSeparator - path+1);
@@ -2221,7 +2264,20 @@ TclpFilesystemPathType(pathObjPtr)
}
#undef VOL_BUF_SIZE
}
-
+/*
+ * This define can be turned on to experiment with a different way of
+ * normalizing paths (using a different Windows API). Unfortunately the
+ * new path seems to take almost exactly the same amount of time as the
+ * old path! The primary time taken by normalization is in
+ * GetFileAttributesEx/FindFirstFile or
+ * GetFileAttributesEx/GetLongPathName. Conversion to/from native is
+ * not a significant factor at all.
+ *
+ * Also, since we have to check for symbolic links (reparse points)
+ * then we have to call GetFileAttributes on each path segment anyway,
+ * so there's no benefit to doing anything clever there.
+ */
+/* #define TclNORM_LONG_PATH */
/*
*---------------------------------------------------------------------------
@@ -2243,7 +2299,6 @@ TclpFilesystemPathType(pathObjPtr)
*
*---------------------------------------------------------------------------
*/
-
int
TclpObjNormalizePath(interp, pathPtr, nextCheckpoint)
Tcl_Interp *interp;
@@ -2341,7 +2396,7 @@ TclpObjNormalizePath(interp, pathPtr, nextCheckpoint)
Tcl_Obj *temp = NULL;
int isDrive = 1;
Tcl_DString ds;
-
+
currentPathEndPosition = path + nextCheckpoint;
if (*currentPathEndPosition == '/') {
currentPathEndPosition++;
@@ -2374,8 +2429,8 @@ TclpObjNormalizePath(interp, pathPtr, nextCheckpoint)
* understand. We therefore don't perform this
* check for drives.
*/
- if (cur != 0 && !isDrive && (data.dwFileAttributes
- & FILE_ATTRIBUTE_REPARSE_POINT)) {
+ if (cur != 0 && !isDrive
+ && (data.dwFileAttributes & FILE_ATTRIBUTE_REPARSE_POINT)) {
Tcl_Obj *to = WinReadLinkDirectory(nativePath);
if (to != NULL) {
/* Read the reparse point ok */
@@ -2400,6 +2455,7 @@ TclpObjNormalizePath(interp, pathPtr, nextCheckpoint)
continue;
}
}
+#ifndef TclNORM_LONG_PATH
/*
* Now we convert the tail of the current path to its
* 'long form', and append it to 'dsNorm' which holds
@@ -2435,6 +2491,7 @@ TclpObjNormalizePath(interp, pathPtr, nextCheckpoint)
(int) (wcslen(nativeName)*sizeof(WCHAR)));
}
}
+#endif
Tcl_DStringFree(&ds);
lastValidPathEnd = currentPathEndPosition;
if (cur == 0) {
@@ -2448,6 +2505,26 @@ TclpObjNormalizePath(interp, pathPtr, nextCheckpoint)
}
currentPathEndPosition++;
}
+#ifdef TclNORM_LONG_PATH
+ /*
+ * Convert the entire known path to long form.
+ */
+ if (1) {
+ WCHAR wpath[MAX_PATH];
+ DWORD wpathlen;
+ CONST char *nativePath = Tcl_WinUtfToTChar(path,
+ lastValidPathEnd - path, &ds);
+ wpathlen = (*tclWinProcs->getLongPathNameProc)(nativePath,
+ (TCHAR*)wpath,
+ MAX_PATH);
+ /* We have to make the drive letter uppercase */
+ if (wpath[0] >= L'a') {
+ wpath[0] -= (L'a' - L'A');
+ }
+ Tcl_DStringAppend(&dsNorm, (TCHAR*)wpath, wpathlen*sizeof(WCHAR));
+ Tcl_DStringFree(&ds);
+ }
+#endif
}
/* Common code path for all Windows platforms */
nextCheckpoint = currentPathEndPosition - path;
diff --git a/win/tclWinInt.h b/win/tclWinInt.h
index b2cb74e..5c9ce70 100644
--- a/win/tclWinInt.h
+++ b/win/tclWinInt.h
@@ -8,7 +8,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclWinInt.h,v 1.23 2003/10/13 16:48:07 vincentdarley Exp $
+ * RCS: @(#) $Id: tclWinInt.h,v 1.24 2004/01/21 19:59:34 vincentdarley Exp $
*/
#ifndef _TCLWININT
@@ -111,6 +111,7 @@ typedef struct TclWinProcs {
LPVOID, UINT,
LPVOID, DWORD);
BOOL (WINAPI *getVolumeNameForVMPProc)(CONST TCHAR*, TCHAR*, DWORD);
+ DWORD (WINAPI *getLongPathNameProc)(CONST TCHAR*, TCHAR*, DWORD);
/*
* These six are for the security sdk to get correct file
* permissions on NT, 2000, XP, etc. On 95,98,ME they are