summaryrefslogtreecommitdiffstats
path: root/win
diff options
context:
space:
mode:
Diffstat (limited to 'win')
-rw-r--r--win/tclWinFCmd.c446
-rw-r--r--win/tclWinFile.c73
2 files changed, 230 insertions, 289 deletions
diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c
index 230723c..c21fb9e 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.9 2001/07/31 19:12:08 vincentdarley Exp $
+ * RCS: @(#) $Id: tclWinFCmd.c,v 1.10 2001/08/23 17:37:08 vincentdarley Exp $
*/
#include "tclWinInt.h"
@@ -28,19 +28,19 @@
*/
static int GetWinFileAttributes _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, CONST char *fileName,
+ int objIndex, Tcl_Obj *fileName,
Tcl_Obj **attributePtrPtr));
static int GetWinFileLongName _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, CONST char *fileName,
+ int objIndex, Tcl_Obj *fileName,
Tcl_Obj **attributePtrPtr));
static int GetWinFileShortName _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, CONST char *fileName,
+ int objIndex, Tcl_Obj *fileName,
Tcl_Obj **attributePtrPtr));
static int SetWinFileAttributes _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, CONST char *fileName,
+ int objIndex, Tcl_Obj *fileName,
Tcl_Obj *attributePtr));
static int CannotSetAttribute _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, CONST char *fileName,
+ int objIndex, Tcl_Obj *fileName,
Tcl_Obj *attributePtr));
/*
@@ -77,26 +77,28 @@ const TclFileAttrProcs tclpFileAttrProcs[] = {
* Prototype for the TraverseWinTree callback function.
*/
-typedef int (TraversalProc)(Tcl_DString *srcPtr, Tcl_DString *dstPtr,
+typedef int (TraversalProc)(CONST TCHAR *srcPtr, CONST TCHAR *dstPtr,
int type, Tcl_DString *errorPtr);
/*
* Declarations for local procedures defined in this file:
*/
-static void StatError(Tcl_Interp *interp, CONST char *fileName);
+static void StatError(Tcl_Interp *interp, Tcl_Obj *fileName);
static int ConvertFileNameFormat(Tcl_Interp *interp,
- int objIndex, CONST char *fileName, int longShort,
+ int objIndex, Tcl_Obj *fileName, int longShort,
Tcl_Obj **attributePtrPtr);
-static int DoCopyFile(Tcl_DString *srcPtr, Tcl_DString *dstPtr);
-static int DoCreateDirectory(Tcl_DString *pathPtr);
-static int DoDeleteFile(Tcl_DString *pathPtr);
+static int DoCopyFile(CONST TCHAR *srcPtr, CONST TCHAR *dstPtr);
+static int DoCreateDirectory(CONST TCHAR *pathPtr);
+static int DoDeleteFile(CONST TCHAR *pathPtr);
+static int DoRemoveJustDirectory(CONST TCHAR *nativeSrc, int recursive,
+ Tcl_DString *errorPtr);
static int DoRemoveDirectory(Tcl_DString *pathPtr, int recursive,
Tcl_DString *errorPtr);
-static int DoRenameFile(const TCHAR *nativeSrc, Tcl_DString *dstPtr);
-static int TraversalCopy(Tcl_DString *srcPtr, Tcl_DString *dstPtr,
+static int DoRenameFile(CONST TCHAR *nativeSrc, CONST TCHAR *dstPtr);
+static int TraversalCopy(CONST TCHAR *srcPtr, CONST TCHAR *dstPtr,
int type, Tcl_DString *errorPtr);
-static int TraversalDelete(Tcl_DString *srcPtr, Tcl_DString *dstPtr,
+static int TraversalDelete(CONST TCHAR *srcPtr, CONST TCHAR *dstPtr,
int type, Tcl_DString *errorPtr);
static int TraverseWinTree(TraversalProc *traverseProc,
Tcl_DString *sourcePtr, Tcl_DString *dstPtr,
@@ -107,14 +109,14 @@ int
TclpObjCreateDirectory(pathPtr)
Tcl_Obj *pathPtr;
{
- return TclpCreateDirectory(Tcl_FSGetTranslatedPath(NULL, pathPtr));
+ return DoCreateDirectory(Tcl_FSGetNativePath(pathPtr));
}
int
TclpObjDeleteFile(pathPtr)
Tcl_Obj *pathPtr;
{
- return TclpDeleteFile(Tcl_FSGetTranslatedPath(NULL, pathPtr));
+ return DoDeleteFile(Tcl_FSGetNativePath(pathPtr));
}
int
@@ -125,8 +127,8 @@ TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr)
{
Tcl_DString ds;
int ret;
- ret = TclpCopyDirectory(Tcl_FSGetTranslatedPath(NULL,srcPathPtr),
- Tcl_FSGetTranslatedPath(NULL,destPathPtr), &ds);
+ ret = TclpCopyDirectory(Tcl_FSGetTranslatedStringPath(NULL,srcPathPtr),
+ Tcl_FSGetTranslatedStringPath(NULL,destPathPtr), &ds);
if (ret != TCL_OK) {
*errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
Tcl_DStringFree(&ds);
@@ -140,8 +142,8 @@ TclpObjCopyFile(srcPathPtr, destPathPtr)
Tcl_Obj *srcPathPtr;
Tcl_Obj *destPathPtr;
{
- return TclpCopyFile(Tcl_FSGetTranslatedPath(NULL,srcPathPtr),
- Tcl_FSGetTranslatedPath(NULL,destPathPtr));
+ return DoCopyFile(Tcl_FSGetNativePath(srcPathPtr),
+ Tcl_FSGetNativePath(destPathPtr));
}
int
@@ -152,7 +154,16 @@ TclpObjRemoveDirectory(pathPtr, recursive, errorPtr)
{
Tcl_DString ds;
int ret;
- ret = TclpRemoveDirectory(Tcl_FSGetTranslatedPath(NULL, pathPtr),recursive, &ds);
+ if (recursive) {
+ /*
+ * In the recursive case, the string rep is used to construct a Tcl_DString
+ * which may be used extensively, so we can't optimize this case easily.
+ */
+ ret = TclpRemoveDirectory(Tcl_FSGetTranslatedStringPath(NULL, pathPtr),
+ recursive, &ds);
+ } else {
+ ret = DoRemoveJustDirectory(Tcl_FSGetNativePath(pathPtr), recursive, &ds);
+ }
if (ret != TCL_OK) {
*errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
Tcl_DStringFree(&ds);
@@ -166,8 +177,7 @@ TclpObjRenameFile(srcPathPtr, destPathPtr)
Tcl_Obj *srcPathPtr;
Tcl_Obj *destPathPtr;
{
- return TclpRenameFile(Tcl_FSGetTranslatedPath(NULL,srcPathPtr),
- Tcl_FSGetTranslatedPath(NULL,destPathPtr));
+ return DoRenameFile(Tcl_FSGetNativePath(srcPathPtr), Tcl_FSGetNativePath(destPathPtr));
}
/*
@@ -221,12 +231,13 @@ TclpRenameFile(
{
int result;
TCHAR *nativeSrc;
+ TCHAR *nativeDest;
Tcl_DString srcString, dstString;
nativeSrc = Tcl_WinUtfToTChar(src, -1, &srcString);
- Tcl_WinUtfToTChar(dst, -1, &dstString);
+ nativeDest = Tcl_WinUtfToTChar(dst, -1, &dstString);
- result = DoRenameFile(nativeSrc, &dstString);
+ result = DoRenameFile(nativeSrc, nativeDest);
Tcl_DStringFree(&srcString);
Tcl_DStringFree(&dstString);
return result;
@@ -236,14 +247,11 @@ static int
DoRenameFile(
CONST TCHAR *nativeSrc, /* Pathname of file or dir to be renamed
* (native). */
- Tcl_DString *dstPtr) /* New pathname for file or directory
+ CONST TCHAR *nativeDst) /* New pathname for file or directory
* (native). */
{
- const TCHAR *nativeDst;
DWORD srcAttr, dstAttr;
- nativeDst = (TCHAR *) Tcl_DStringValue(dstPtr);
-
/*
* Would throw an exception under NT if one of the arguments is a
* char block device.
@@ -367,7 +375,7 @@ DoRenameFile(
* fails, it's because it wasn't empty.
*/
- if (DoRemoveDirectory(dstPtr, 0, NULL) == TCL_OK) {
+ if (DoRemoveJustDirectory(nativeDst, 0, NULL) == TCL_OK) {
/*
* Now that that empty directory is gone, we can try
* renaming again. If that fails, we'll put this empty
@@ -507,7 +515,8 @@ TclpCopyFile(
Tcl_WinUtfToTChar(src, -1, &srcString);
Tcl_WinUtfToTChar(dst, -1, &dstString);
- result = DoCopyFile(&srcString, &dstString);
+ result = DoCopyFile(Tcl_DStringValue(&srcString),
+ Tcl_DStringValue(&dstString));
Tcl_DStringFree(&srcString);
Tcl_DStringFree(&dstString);
return result;
@@ -515,14 +524,9 @@ TclpCopyFile(
static int
DoCopyFile(
- Tcl_DString *srcPtr, /* Pathname of file to be copied (native). */
- Tcl_DString *dstPtr) /* Pathname of file to copy to (native). */
+ CONST TCHAR *nativeSrc, /* Pathname of file to be copied (native). */
+ CONST TCHAR *nativeDst) /* Pathname of file to copy to (native). */
{
- CONST TCHAR *nativeSrc, *nativeDst;
-
- nativeSrc = (TCHAR *) Tcl_DStringValue(srcPtr);
- nativeDst = (TCHAR *) Tcl_DStringValue(dstPtr);
-
/*
* Would throw an exception under NT if one of the arguments is a char
* block device.
@@ -604,19 +608,16 @@ TclpDeleteFile(
Tcl_DString pathString;
Tcl_WinUtfToTChar(path, -1, &pathString);
- result = DoDeleteFile(&pathString);
+ result = DoDeleteFile(Tcl_DStringValue(&pathString));
Tcl_DStringFree(&pathString);
return result;
}
static int
DoDeleteFile(
- Tcl_DString *pathPtr) /* Pathname of file to be removed (native). */
+ CONST TCHAR *nativePath) /* Pathname of file to be removed (native). */
{
DWORD attr;
- CONST TCHAR *nativePath;
-
- nativePath = (TCHAR *) Tcl_DStringValue(pathPtr);
if ((*tclWinProcs->deleteFileProc)(nativePath) != FALSE) {
return TCL_OK;
@@ -716,19 +717,16 @@ TclpCreateDirectory(
Tcl_DString pathString;
Tcl_WinUtfToTChar(path, -1, &pathString);
- result = DoCreateDirectory(&pathString);
+ result = DoCreateDirectory(Tcl_DStringValue(&pathString));
Tcl_DStringFree(&pathString);
return result;
}
static int
DoCreateDirectory(
- Tcl_DString *pathPtr) /* Pathname of directory to create (native). */
+ CONST TCHAR *nativePath) /* Pathname of directory to create (native). */
{
DWORD error;
- CONST TCHAR *nativePath;
-
- nativePath = (TCHAR *) Tcl_DStringValue(pathPtr);
if ((*tclWinProcs->createDirectoryProc)(nativePath, NULL) == 0) {
error = GetLastError();
TclWinConvertError(error);
@@ -836,21 +834,18 @@ TclpRemoveDirectory(
}
static int
-DoRemoveDirectory(
- Tcl_DString *pathPtr, /* Pathname of directory to be removed
+DoRemoveJustDirectory(
+ CONST TCHAR *nativePath, /* Pathname of directory to be removed
* (native). */
- int recursive, /* If non-zero, removes directories that
- * are nonempty. Otherwise, will only remove
- * empty directories. */
+ int recursive, /* If non-zero, don't initialize the
+ * errorPtr under some circumstances
+ * on return. */
Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free
* DString filled with UTF-8 name of file
* causing error. */
{
- CONST TCHAR *nativePath;
DWORD attr;
- nativePath = (TCHAR *) Tcl_DStringValue(pathPtr);
-
if ((*tclWinProcs->removeDirectoryProc)(nativePath) != FALSE) {
return TCL_OK;
}
@@ -952,19 +947,44 @@ DoRemoveDirectory(
Tcl_SetErrno(EEXIST);
}
if ((recursive != 0) && (Tcl_GetErrno() == EEXIST)) {
- /*
- * The directory is nonempty, but the recursive flag has been
- * specified, so we recursively remove all the files in the directory.
+ /*
+ * If we're being recursive, this error may actually
+ * be ok, so we don't want to initialise the errorPtr
+ * yet.
*/
-
- return TraverseWinTree(TraversalDelete, pathPtr, NULL, errorPtr);
+ return TCL_ERROR;
}
-
+
end:
if (errorPtr != NULL) {
Tcl_WinTCharToUtf(nativePath, -1, errorPtr);
}
return TCL_ERROR;
+
+}
+
+static int
+DoRemoveDirectory(
+ Tcl_DString *pathPtr, /* Pathname of directory to be removed
+ * (native). */
+ int recursive, /* If non-zero, removes directories that
+ * are nonempty. Otherwise, will only remove
+ * empty directories. */
+ Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free
+ * DString filled with UTF-8 name of file
+ * causing error. */
+{
+ int res = DoRemoveJustDirectory(Tcl_DStringValue(pathPtr), recursive, errorPtr);
+
+ if ((res == TCL_ERROR) && (recursive != 0) && (Tcl_GetErrno() == EEXIST)) {
+ /*
+ * The directory is nonempty, but the recursive flag has been
+ * specified, so we recursively remove all the files in the directory.
+ */
+ return TraverseWinTree(TraversalDelete, pathPtr, NULL, errorPtr);
+ } else {
+ return res;
+ }
}
/*
@@ -996,13 +1016,14 @@ TraverseWinTree(
Tcl_DString *sourcePtr, /* Pathname of source directory to be
* traversed (native). */
Tcl_DString *targetPtr, /* Pathname of directory to traverse in
- * parallel with source directory (native). */
+ * parallel with source directory (native),
+ * may be NULL. */
Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free
* DString filled with UTF-8 name of file
* causing error. */
{
DWORD sourceAttr;
- TCHAR *nativeSource, *nativeErrfile;
+ TCHAR *nativeSource, *nativeTarget, *nativeErrfile;
int result, found, sourceLen, targetLen, oldSourceLen, oldTargetLen;
HANDLE handle;
WIN32_FIND_DATAT data;
@@ -1012,6 +1033,8 @@ TraverseWinTree(
oldTargetLen = 0; /* lint. */
nativeSource = (TCHAR *) Tcl_DStringValue(sourcePtr);
+ nativeTarget = (TCHAR *) (targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr));
+
oldSourceLen = Tcl_DStringLength(sourcePtr);
sourceAttr = (*tclWinProcs->getFileAttributesProc)(nativeSource);
if (sourceAttr == 0xffffffff) {
@@ -1023,7 +1046,7 @@ TraverseWinTree(
* Process the regular file
*/
- return (*traverseProc)(sourcePtr, targetPtr, DOTREE_F, errorPtr);
+ return (*traverseProc)(nativeSource, nativeTarget, DOTREE_F, errorPtr);
}
if (tclWinProcs->useWide) {
@@ -1046,7 +1069,7 @@ TraverseWinTree(
nativeSource[oldSourceLen + 1] = '\0';
Tcl_DStringSetLength(sourcePtr, oldSourceLen);
- result = (*traverseProc)(sourcePtr, targetPtr, DOTREE_PRED, errorPtr);
+ result = (*traverseProc)(nativeSource, nativeTarget, DOTREE_PRED, errorPtr);
if (result != TCL_OK) {
FindClose(handle);
return result;
@@ -1148,8 +1171,9 @@ TraverseWinTree(
* files in that directory.
*/
- result = (*traverseProc)(sourcePtr, targetPtr, DOTREE_POSTD,
- errorPtr);
+ result = (*traverseProc)(Tcl_DStringValue(sourcePtr),
+ (targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr)),
+ DOTREE_POSTD, errorPtr);
}
end:
if (nativeErrfile != NULL) {
@@ -1182,26 +1206,23 @@ TraverseWinTree(
static int
TraversalCopy(
- Tcl_DString *srcPtr, /* Source pathname to copy. */
- Tcl_DString *dstPtr, /* Destination pathname of copy. */
+ CONST TCHAR *nativeSrc, /* Source pathname to copy. */
+ CONST TCHAR *nativeDst, /* Destination pathname of copy. */
int type, /* Reason for call - see TraverseWinTree() */
Tcl_DString *errorPtr) /* If non-NULL, initialized DString filled
* with UTF-8 name of file causing error. */
{
- TCHAR *nativeDst, *nativeSrc;
DWORD attr;
switch (type) {
case DOTREE_F: {
- if (DoCopyFile(srcPtr, dstPtr) == TCL_OK) {
+ if (DoCopyFile(nativeSrc, nativeDst) == TCL_OK) {
return TCL_OK;
}
break;
}
case DOTREE_PRED: {
- if (DoCreateDirectory(dstPtr) == TCL_OK) {
- nativeSrc = (TCHAR *) Tcl_DStringValue(srcPtr);
- nativeDst = (TCHAR *) Tcl_DStringValue(dstPtr);
+ if (DoCreateDirectory(nativeDst) == TCL_OK) {
attr = (*tclWinProcs->getFileAttributesProc)(nativeSrc);
if ((*tclWinProcs->setFileAttributesProc)(nativeDst, attr) != FALSE) {
return TCL_OK;
@@ -1221,7 +1242,6 @@ TraversalCopy(
*/
if (errorPtr != NULL) {
- nativeDst = (TCHAR *) Tcl_DStringValue(dstPtr);
Tcl_WinTCharToUtf(nativeDst, -1, errorPtr);
}
return TCL_ERROR;
@@ -1250,17 +1270,15 @@ TraversalCopy(
static int
TraversalDelete(
- Tcl_DString *srcPtr, /* Source pathname to delete. */
- Tcl_DString *dstPtr, /* Not used. */
+ CONST TCHAR *nativeSrc, /* Source pathname to delete. */
+ CONST TCHAR *dstPtr, /* Not used. */
int type, /* Reason for call - see TraverseWinTree() */
Tcl_DString *errorPtr) /* If non-NULL, initialized DString filled
* with UTF-8 name of file causing error. */
{
- TCHAR *nativeSrc;
-
switch (type) {
case DOTREE_F: {
- if (DoDeleteFile(srcPtr) == TCL_OK) {
+ if (DoDeleteFile(nativeSrc) == TCL_OK) {
return TCL_OK;
}
break;
@@ -1269,7 +1287,7 @@ TraversalDelete(
return TCL_OK;
}
case DOTREE_POSTD: {
- if (DoRemoveDirectory(srcPtr, 0, NULL) == TCL_OK) {
+ if (DoRemoveJustDirectory(nativeSrc, 0, NULL) == TCL_OK) {
return TCL_OK;
}
break;
@@ -1277,7 +1295,6 @@ TraversalDelete(
}
if (errorPtr != NULL) {
- nativeSrc = (TCHAR *) Tcl_DStringValue(srcPtr);
Tcl_WinTCharToUtf(nativeSrc, -1, errorPtr);
}
return TCL_ERROR;
@@ -1303,13 +1320,14 @@ TraversalDelete(
static void
StatError(
Tcl_Interp *interp, /* The interp that has the error */
- CONST char *fileName) /* The name of the file which caused the
+ Tcl_Obj *fileName) /* The name of the file which caused the
* error. */
{
TclWinConvertError(GetLastError());
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "could not read \"", fileName, "\": ", Tcl_PosixError(interp),
- (char *) NULL);
+ "could not read \"", Tcl_GetString(fileName),
+ "\": ", Tcl_PosixError(interp),
+ (char *) NULL);
}
/*
@@ -1335,16 +1353,14 @@ static int
GetWinFileAttributes(
Tcl_Interp *interp, /* The interp we are using for errors. */
int objIndex, /* The index of the attribute. */
- CONST char *fileName, /* The name of the file. */
+ Tcl_Obj *fileName, /* The name of the file. */
Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */
{
DWORD result;
- Tcl_DString ds;
TCHAR *nativeName;
- nativeName = Tcl_WinUtfToTChar(fileName, -1, &ds);
+ nativeName = Tcl_FSGetNativePath(fileName);
result = (*tclWinProcs->getFileAttributesProc)(nativeName);
- Tcl_DStringFree(&ds);
if (result == 0xffffffff) {
StatError(interp, fileName);
@@ -1356,106 +1372,6 @@ GetWinFileAttributes(
}
/*
- *---------------------------------------------------------------------------
- *
- * TclpNormalizePath --
- *
- * This function scans through a path specification and replaces
- * it, in place, with a normalized version. On windows this
- * means using the 'longname'.
- *
- * Results:
- * The new 'nextCheckpoint' value, giving as far as we could
- * understand in the path.
- *
- * Side effects:
- * The pathPtr string, which must contain a valid path, is
- * possibly modified in place.
- *
- *---------------------------------------------------------------------------
- */
-
-int
-TclpNormalizePath(interp, pathPtr, nextCheckpoint)
- Tcl_Interp *interp;
- Tcl_DString *pathPtr;
- int nextCheckpoint;
-{
- char *currentPathEndPosition;
- char *lastValidPathEnd = NULL;
- char *path = Tcl_DStringValue(pathPtr);
-
- currentPathEndPosition = path + nextCheckpoint;
-
- while (1) {
- char cur = *currentPathEndPosition;
- if (cur == '/' || cur == 0) {
- /* Reached directory separator, or end of string */
- Tcl_DString ds;
- DWORD attr;
- char * nativePath;
- nativePath = Tcl_WinUtfToTChar(path, currentPathEndPosition - path, &ds);
- attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
- Tcl_DStringFree(&ds);
-
- if (attr == 0xffffffff) {
- /* File doesn't exist */
- break;
- }
- lastValidPathEnd = currentPathEndPosition;
- /* File does exist */
- if (cur == 0) {
- break;
- }
- }
- currentPathEndPosition++;
- }
- nextCheckpoint = currentPathEndPosition - path;
- if (lastValidPathEnd != NULL) {
- /*
- * The leading end of the path description was acceptable to
- * us. We therefore convert it to its long form, and return
- * that.
- */
- Tcl_Obj* objPtr = NULL;
- int endOfString;
- int useLength = lastValidPathEnd - path;
- if (*lastValidPathEnd == 0) {
- endOfString = 1;
- } else {
- endOfString = 0;
- path[useLength] = 0;
- }
- /*
- * If this returns an error, we have a strange situation; the
- * file exists, but we can't get its long name. We will have
- * to assume the name we have is ok.
- */
- if (ConvertFileNameFormat(interp, 0, path, 1, &objPtr) == TCL_OK) {
- /* objPtr now has a refCount of 0 */
- int len;
- (void) Tcl_GetStringFromObj(objPtr,&len);
- if (!endOfString) {
- /* Be nice and fix the string before we clear it */
- path[useLength] = '/';
- Tcl_AppendToObj(objPtr, lastValidPathEnd, -1);
- }
- nextCheckpoint += (len - useLength);
- Tcl_DStringSetLength(pathPtr,0);
- path = Tcl_GetStringFromObj(objPtr,&len);
- Tcl_DStringAppend(pathPtr,path,len);
- /* Free up the objPtr */
- Tcl_DecrRefCount(objPtr);
- } else {
- if (!endOfString) {
- path[useLength] = '/';
- }
- }
- }
- return nextCheckpoint;
-}
-
-/*
*----------------------------------------------------------------------
*
* ConvertFileNameFormat --
@@ -1467,6 +1383,11 @@ TclpNormalizePath(interp, pathPtr, nextCheckpoint)
* Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object
* will have ref count 0. If the return value is not TCL_OK,
* attributePtrPtr is not touched.
+ *
+ * Warning: if you pass this function a drive name like 'c:' it
+ * will actually return the current working directory on that
+ * drive. To avoid this, make sure the drive name ends in a
+ * slash, like this 'c:/'.
*
* Side effects:
* A new object is allocated if the file is valid.
@@ -1478,22 +1399,19 @@ static int
ConvertFileNameFormat(
Tcl_Interp *interp, /* The interp we are using for errors. */
int objIndex, /* The index of the attribute. */
- CONST char *fileName, /* The name of the file. */
+ Tcl_Obj *fileName, /* The name of the file. */
int longShort, /* 0 to short name, 1 to long name. */
Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */
{
int pathc, i;
- char **pathv, **newv;
- char *resultStr;
- Tcl_DString resultDString;
+ Tcl_Obj *splitPath;
int result = TCL_OK;
- Tcl_SplitPath(fileName, &pathc, &pathv);
- newv = (char **) ckalloc(pathc * sizeof(char *));
+ splitPath = Tcl_FSSplitPath(fileName, &pathc);
- if (pathc == 0) {
+ if (splitPath == NULL || pathc == 0) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "could not read \"", fileName,
+ "could not read \"", Tcl_GetString(fileName),
"\": no such file or directory",
(char *) NULL);
result = TCL_ERROR;
@@ -1501,10 +1419,16 @@ ConvertFileNameFormat(
}
for (i = 0; i < pathc; i++) {
- if ((pathv[i][0] == '/')
- || ((strlen(pathv[i]) == 3) && (pathv[i][1] == ':'))
- || (strcmp(pathv[i], ".") == 0)
- || (strcmp(pathv[i], "..") == 0)) {
+ Tcl_Obj *elt;
+ char *pathv;
+ int pathLen;
+ Tcl_ListObjIndex(NULL, splitPath, i, &elt);
+
+ pathv = Tcl_GetStringFromObj(elt, &pathLen);
+ if ((pathv[0] == '/')
+ || ((pathLen == 3) && (pathv[1] == ':'))
+ || (strcmp(pathv, ".") == 0)
+ || (strcmp(pathv, "..") == 0)) {
/*
* Handle "/", "//machine/export", "c:/", "." or ".." by just
* copying the string literally. Uppercase the drive letter,
@@ -1512,20 +1436,32 @@ ConvertFileNameFormat(
*/
simple:
- pathv[i][0] = (char) Tcl_UniCharToUpper(UCHAR(pathv[i][0]));
- newv[i] = (char *) ckalloc(strlen(pathv[i]) + 1);
- lstrcpyA(newv[i], pathv[i]);
+ /* Here we are modifying the string representation in place */
+ /* I believe this is legal, since this won't affect any
+ * file representation this thing may have. */
+ pathv[0] = (char) Tcl_UniCharToUpper(UCHAR(pathv[0]));
} else {
- char *str;
- TCHAR *nativeName;
+ Tcl_Obj *tempPath;
Tcl_DString ds;
+ Tcl_DString dsTemp;
+ TCHAR *nativeName;
+ char *tempString;
+ int tempLen;
WIN32_FIND_DATAT data;
HANDLE handle;
DWORD attr;
- Tcl_DStringInit(&resultDString);
- str = Tcl_JoinPath(i + 1, pathv, &resultDString);
- nativeName = Tcl_WinUtfToTChar(str, -1, &ds);
+ tempPath = Tcl_FSJoinPath(splitPath, i+1);
+ Tcl_IncrRefCount(tempPath);
+ /*
+ * We'd like to call Tcl_FSGetNativePath(tempPath)
+ * but that is likely to lead to infinite loops
+ */
+ Tcl_DStringInit(&ds);
+ tempString = Tcl_GetStringFromObj(tempPath,&tempLen);
+ Tcl_WinUtfToTChar(tempString, tempLen, &ds);
+ Tcl_DecrRefCount(tempPath);
+ nativeName = Tcl_DStringValue(&ds);
handle = (*tclWinProcs->findFirstFileProc)(nativeName, &data);
if (handle == INVALID_HANDLE_VALUE) {
/*
@@ -1538,16 +1474,12 @@ ConvertFileNameFormat(
attr = (*tclWinProcs->getFileAttributesProc)(nativeName);
if ((attr != 0xFFFFFFFF) && (attr & FILE_ATTRIBUTE_DIRECTORY)) {
Tcl_DStringFree(&ds);
- Tcl_DStringFree(&resultDString);
-
goto simple;
}
}
- Tcl_DStringFree(&ds);
- Tcl_DStringFree(&resultDString);
if (handle == INVALID_HANDLE_VALUE) {
- pathc = i - 1;
+ Tcl_DStringFree(&ds);
StatError(interp, fileName);
result = TCL_ERROR;
goto cleanup;
@@ -1588,26 +1520,24 @@ ConvertFileNameFormat(
* fprintf(stderr, "%d\n", ((WCHAR *) nativeName)[0]);
*/
- Tcl_WinTCharToUtf(nativeName, -1, &ds);
- newv[i] = ckalloc((unsigned int) (Tcl_DStringLength(&ds) + 1));
- lstrcpyA(newv[i], Tcl_DStringValue(&ds));
+ Tcl_DStringInit(&dsTemp);
+ Tcl_WinTCharToUtf(nativeName, -1, &dsTemp);
+ tempPath = Tcl_NewStringObj(Tcl_DStringValue(&dsTemp),
+ Tcl_DStringLength(&dsTemp));
+ Tcl_ListObjReplace(NULL, splitPath, i, 1, 1, &tempPath);
Tcl_DStringFree(&ds);
+ Tcl_DStringFree(&dsTemp);
FindClose(handle);
}
}
- Tcl_DStringInit(&resultDString);
- resultStr = Tcl_JoinPath(pathc, newv, &resultDString);
- *attributePtrPtr = Tcl_NewStringObj(resultStr,
- Tcl_DStringLength(&resultDString));
- Tcl_DStringFree(&resultDString);
+ *attributePtrPtr = Tcl_FSJoinPath(splitPath, -1);
cleanup:
- for (i = 0; i < pathc; i++) {
- ckfree(newv[i]);
+ if (splitPath != NULL) {
+ Tcl_DecrRefCount(splitPath);
}
- ckfree((char *) newv);
- ckfree((char *) pathv);
+
return result;
}
@@ -1634,7 +1564,7 @@ static int
GetWinFileLongName(
Tcl_Interp *interp, /* The interp we are using for errors. */
int objIndex, /* The index of the attribute. */
- CONST char *fileName, /* The name of the file. */
+ Tcl_Obj *fileName, /* The name of the file. */
Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */
{
return ConvertFileNameFormat(interp, objIndex, fileName, 1, attributePtrPtr);
@@ -1663,7 +1593,7 @@ static int
GetWinFileShortName(
Tcl_Interp *interp, /* The interp we are using for errors. */
int objIndex, /* The index of the attribute. */
- CONST char *fileName, /* The name of the file. */
+ Tcl_Obj *fileName, /* The name of the file. */
Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */
{
return ConvertFileNameFormat(interp, objIndex, fileName, 0, attributePtrPtr);
@@ -1690,27 +1620,25 @@ static int
SetWinFileAttributes(
Tcl_Interp *interp, /* The interp we are using for errors. */
int objIndex, /* The index of the attribute. */
- CONST char *fileName, /* The name of the file. */
+ Tcl_Obj *fileName, /* The name of the file. */
Tcl_Obj *attributePtr) /* The new value of the attribute. */
{
DWORD fileAttributes;
int yesNo;
int result;
- Tcl_DString ds;
TCHAR *nativeName;
- nativeName = Tcl_WinUtfToTChar(fileName, -1, &ds);
+ nativeName = Tcl_FSGetNativePath(fileName);
fileAttributes = (*tclWinProcs->getFileAttributesProc)(nativeName);
if (fileAttributes == 0xffffffff) {
StatError(interp, fileName);
- result = TCL_ERROR;
- goto end;
+ return TCL_ERROR;
}
result = Tcl_GetBooleanFromObj(interp, attributePtr, &yesNo);
if (result != TCL_OK) {
- goto end;
+ return result;
}
if (yesNo) {
@@ -1721,13 +1649,9 @@ SetWinFileAttributes(
if (!(*tclWinProcs->setFileAttributesProc)(nativeName, fileAttributes)) {
StatError(interp, fileName);
- result = TCL_ERROR;
- goto end;
+ return TCL_ERROR;
}
- end:
- Tcl_DStringFree(&ds);
-
return result;
}
@@ -1743,7 +1667,7 @@ SetWinFileAttributes(
* TCL_ERROR
*
* Side effects:
- * The object result is set to a pertinant error message.
+ * The object result is set to a pertinent error message.
*
*----------------------------------------------------------------------
*/
@@ -1752,12 +1676,13 @@ static int
CannotSetAttribute(
Tcl_Interp *interp, /* The interp we are using for errors. */
int objIndex, /* The index of the attribute. */
- CONST char *fileName, /* The name of the file. */
+ Tcl_Obj *fileName, /* The name of the file. */
Tcl_Obj *attributePtr) /* The new value of the attribute. */
{
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"cannot set attribute \"", tclpFileAttrStrings[objIndex],
- "\" for file \"", fileName, "\": attribute is readonly",
+ "\" for file \"", Tcl_GetString(fileName),
+ "\": attribute is readonly",
(char *) NULL);
return TCL_ERROR;
}
@@ -1766,14 +1691,12 @@ CannotSetAttribute(
/*
*---------------------------------------------------------------------------
*
- * TclpListVolumes --
+ * TclpObjListVolumes --
*
* Lists the currently mounted volumes
*
* Results:
- * A standard Tcl result. Will always be TCL_OK, since there is no way
- * that this command can fail. Also, the interpreter's result is set to
- * the list of volumes.
+ * The list of volumes.
*
* Side effects:
* None
@@ -1781,16 +1704,15 @@ CannotSetAttribute(
*---------------------------------------------------------------------------
*/
-int
-TclpListVolumes(
- Tcl_Interp *interp) /* Interpreter for returning volume list. */
+Tcl_Obj*
+TclpObjListVolumes(void)
{
Tcl_Obj *resultPtr, *elemPtr;
char buf[40 * 4]; /* There couldn't be more than 30 drives??? */
int i;
char *p;
- resultPtr = Tcl_GetObjResult(interp);
+ resultPtr = Tcl_NewObj();
/*
* On Win32s:
@@ -1827,7 +1749,9 @@ TclpListVolumes(
Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr);
}
}
- return TCL_OK;
+
+ Tcl_IncrRefCount(resultPtr);
+ return resultPtr;
}
/*
@@ -1869,7 +1793,8 @@ TclpObjNormalizePath(interp, pathPtr, nextCheckpoint)
Tcl_DString ds;
DWORD attr;
char * nativePath;
- nativePath = Tcl_WinUtfToTChar(path, currentPathEndPosition - path, &ds);
+ nativePath = Tcl_WinUtfToTChar(path, currentPathEndPosition - path,
+ &ds);
attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
Tcl_DStringFree(&ds);
@@ -1887,6 +1812,7 @@ TclpObjNormalizePath(interp, pathPtr, nextCheckpoint)
}
nextCheckpoint = currentPathEndPosition - path;
if (lastValidPathEnd != NULL) {
+ Tcl_Obj *tmpPathPtr;
/*
* The leading end of the path description was acceptable to
* us. We therefore convert it to its long form, and return
@@ -1896,33 +1822,31 @@ TclpObjNormalizePath(interp, pathPtr, nextCheckpoint)
int endOfString;
int useLength = lastValidPathEnd - path;
if (*lastValidPathEnd == 0) {
+ tmpPathPtr = Tcl_NewStringObj(path, useLength);
endOfString = 1;
} else {
+ tmpPathPtr = Tcl_NewStringObj(path, useLength + 1);
endOfString = 0;
- path[useLength] = 0;
}
/*
* If this returns an error, we have a strange situation; the
* file exists, but we can't get its long name. We will have
* to assume the name we have is ok.
*/
- if (ConvertFileNameFormat(interp, 0, path, 1, &objPtr) == TCL_OK) {
+ Tcl_IncrRefCount(tmpPathPtr);
+ if (ConvertFileNameFormat(interp, 0, tmpPathPtr, 1, &objPtr) == TCL_OK) {
int len;
(void) Tcl_GetStringFromObj(objPtr,&len);
if (!endOfString) {
/* Be nice and fix the string before we clear it */
- path[useLength] = '/';
Tcl_AppendToObj(objPtr, lastValidPathEnd, -1);
}
nextCheckpoint += (len - useLength);
path = Tcl_GetStringFromObj(objPtr,&len);
Tcl_SetStringObj(pathPtr,path, len);
Tcl_DecrRefCount(objPtr);
- } else {
- if (!endOfString) {
- path[useLength] = '/';
- }
}
+ Tcl_DecrRefCount(tmpPathPtr);
}
return nextCheckpoint;
}
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index c40a0b8..d74fb78 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.11 2001/07/31 19:12:08 vincentdarley Exp $
+ * RCS: @(#) $Id: tclWinFile.c,v 1.12 2001/08/23 17:37:08 vincentdarley Exp $
*/
#include "tclWinInt.h"
@@ -126,7 +126,7 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
BOOL found;
Tcl_DString ds;
Tcl_DString dsOrig;
- char *fileName;
+ Tcl_Obj *fileNamePtr;
TCHAR *nativeName;
int matchSpecialDots;
@@ -136,12 +136,12 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
* separator character.
*/
- fileName = Tcl_FSGetTranslatedPath(interp, pathPtr);
- if (fileName == NULL) {
+ fileNamePtr = Tcl_FSGetTranslatedPath(interp, pathPtr);
+ if (fileNamePtr == NULL) {
return TCL_ERROR;
}
Tcl_DStringInit(&dsOrig);
- Tcl_DStringAppend(&dsOrig, fileName, -1);
+ Tcl_DStringAppend(&dsOrig, Tcl_GetString(fileNamePtr), -1);
dirLength = Tcl_DStringLength(&dsOrig);
Tcl_DStringInit(&dirString);
@@ -333,6 +333,8 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
typeOk = 0;
}
} else {
+ struct stat buf;
+
if (attr & FILE_ATTRIBUTE_HIDDEN) {
/* If invisible */
if ((types->perm == 0) ||
@@ -360,12 +362,14 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
}
}
if (typeOk && types->type != 0) {
- struct stat buf;
- /*
- * We must match at least one flag to be listed
- */
- typeOk = 0;
- if (TclpLstat(fname, &buf) >= 0) {
+ if (types->perm == 0) {
+ /* We haven't yet done a stat on the file */
+ if (TclpStat(fname, &buf) != 0) {
+ /* Posix error occurred */
+ typeOk = 0;
+ }
+ }
+ if (typeOk) {
/*
* In order bcdpfls as in 'find -t'
*/
@@ -380,19 +384,24 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
S_ISFIFO(buf.st_mode)) ||
((types->type & TCL_GLOB_TYPE_FILE) &&
S_ISREG(buf.st_mode))
-#ifdef S_ISLNK
- || ((types->type & TCL_GLOB_TYPE_LINK) &&
- S_ISLNK(buf.st_mode))
-#endif
#ifdef S_ISSOCK
|| ((types->type & TCL_GLOB_TYPE_SOCK) &&
S_ISSOCK(buf.st_mode))
#endif
) {
- typeOk = 1;
+ /* Do nothing -- this file is ok */
+ } else {
+ typeOk = 0;
+#ifdef S_ISLNK
+ if (types->type & TCL_GLOB_TYPE_LINK) {
+ if (TclpLstat(fname, &buf) == 0) {
+ if (S_ISLNK(buf.st_mode)) {
+ typeOk = 1;
+ }
+ }
+ }
+#endif
}
- } else {
- /* Posix error occurred */
}
}
}
@@ -824,13 +833,15 @@ TclpObjStat(pathPtr, statPtr)
TCHAR *nativePart;
char *p, *fullPath;
int dev, mode;
-
+ Tcl_Obj *transPtr;
+
/*
* Eliminate file names containing wildcard characters, or subsequent
* call to FindFirstFile() will expand them, matching some other file.
*/
- if (strpbrk(Tcl_FSGetTranslatedPath(NULL, pathPtr), "?*") != NULL) {
+ transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
+ if (transPtr == NULL || (strpbrk(Tcl_GetString(transPtr), "?*") != NULL)) {
Tcl_SetErrno(ENOENT);
return -1;
}
@@ -907,7 +918,7 @@ TclpObjStat(pathPtr, statPtr)
attr = data.a.dwFileAttributes;
mode = (attr & FILE_ATTRIBUTE_DIRECTORY) ? S_IFDIR | S_IEXEC : S_IFREG;
mode |= (attr & FILE_ATTRIBUTE_READONLY) ? S_IREAD : S_IREAD | S_IWRITE;
- p = strrchr(Tcl_FSGetTranslatedPath(NULL, pathPtr), '.');
+ p = strrchr(Tcl_GetString(transPtr), '.');
if (p != NULL) {
if ((lstrcmpiA(p, ".exe") == 0)
|| (lstrcmpiA(p, ".com") == 0)
@@ -1140,7 +1151,7 @@ TclpObjAccess(pathPtr, mode)
return 0;
}
- p = strrchr(Tcl_FSGetTranslatedPath(NULL, pathPtr), '.');
+ p = strrchr(Tcl_FSGetTranslatedStringPath(NULL, pathPtr), '.');
if (p != NULL) {
p++;
if ((stricmp(p, "exe") == 0)
@@ -1170,15 +1181,21 @@ TclpObjLstat(pathPtr, buf)
#ifdef S_IFLNK
Tcl_Obj*
-TclpObjReadlink(pathPtr)
+TclpObjLink(pathPtr, toPtr)
Tcl_Obj *pathPtr;
+ Tcl_Obj *toPtr;
{
- Tcl_DString ds;
Tcl_Obj* link = NULL;
- if (TclpReadlink(Tcl_FSGetTranslatedPath(NULL, pathPtr), &ds) != NULL) {
- link = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
- Tcl_IncrRefCount(link);
- Tcl_DStringFree(&ds);
+
+ if (toPtr != NULL) {
+ return NULL;
+ } else {
+ Tcl_DString ds;
+ if (TclpReadlink(Tcl_FSGetTranslatedStringPath(NULL, pathPtr), &ds) != NULL) {
+ link = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
+ Tcl_IncrRefCount(link);
+ Tcl_DStringFree(&ds);
+ }
}
return link;
}