diff options
Diffstat (limited to 'win')
| -rw-r--r-- | win/tclWinFCmd.c | 446 | ||||
| -rw-r--r-- | win/tclWinFile.c | 73 |
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; } |