diff options
Diffstat (limited to 'win/tclWinFCmd.c')
| -rw-r--r-- | win/tclWinFCmd.c | 287 |
1 files changed, 115 insertions, 172 deletions
diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c index c21fb9e..a04fc45 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.10 2001/08/23 17:37:08 vincentdarley Exp $ + * RCS: @(#) $Id: tclWinFCmd.c,v 1.11 2001/08/30 08:53:15 vincentdarley Exp $ */ #include "tclWinInt.h" @@ -91,8 +91,8 @@ static int ConvertFileNameFormat(Tcl_Interp *interp, 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 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, CONST TCHAR *dstPtr); @@ -105,85 +105,10 @@ static int TraverseWinTree(TraversalProc *traverseProc, Tcl_DString *errorPtr); -int -TclpObjCreateDirectory(pathPtr) - Tcl_Obj *pathPtr; -{ - return DoCreateDirectory(Tcl_FSGetNativePath(pathPtr)); -} - -int -TclpObjDeleteFile(pathPtr) - Tcl_Obj *pathPtr; -{ - return DoDeleteFile(Tcl_FSGetNativePath(pathPtr)); -} - -int -TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr) - Tcl_Obj *srcPathPtr; - Tcl_Obj *destPathPtr; - Tcl_Obj **errorPtr; -{ - Tcl_DString ds; - int ret; - 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); - Tcl_IncrRefCount(*errorPtr); - } - return ret; -} - -int -TclpObjCopyFile(srcPathPtr, destPathPtr) - Tcl_Obj *srcPathPtr; - Tcl_Obj *destPathPtr; -{ - return DoCopyFile(Tcl_FSGetNativePath(srcPathPtr), - Tcl_FSGetNativePath(destPathPtr)); -} - -int -TclpObjRemoveDirectory(pathPtr, recursive, errorPtr) - Tcl_Obj *pathPtr; - int recursive; - Tcl_Obj **errorPtr; -{ - Tcl_DString ds; - int ret; - 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); - Tcl_IncrRefCount(*errorPtr); - } - return ret; -} - -int -TclpObjRenameFile(srcPathPtr, destPathPtr) - Tcl_Obj *srcPathPtr; - Tcl_Obj *destPathPtr; -{ - return DoRenameFile(Tcl_FSGetNativePath(srcPathPtr), Tcl_FSGetNativePath(destPathPtr)); -} - /* *--------------------------------------------------------------------------- * - * TclpRenameFile, DoRenameFile -- + * TclpObjRenameFile, DoRenameFile -- * * Changes the name of an existing file or directory, from src to dst. * If src and dst refer to the same file or directory, does nothing @@ -222,25 +147,13 @@ TclpObjRenameFile(srcPathPtr, destPathPtr) *--------------------------------------------------------------------------- */ -int -TclpRenameFile( - CONST char *src, /* Pathname of file or dir to be renamed - * (UTF-8). */ - CONST char *dst) /* New pathname of file or directory - * (UTF-8). */ +int +TclpObjRenameFile(srcPathPtr, destPathPtr) + Tcl_Obj *srcPathPtr; + Tcl_Obj *destPathPtr; { - int result; - TCHAR *nativeSrc; - TCHAR *nativeDest; - Tcl_DString srcString, dstString; - - nativeSrc = Tcl_WinUtfToTChar(src, -1, &srcString); - nativeDest = Tcl_WinUtfToTChar(dst, -1, &dstString); - - result = DoRenameFile(nativeSrc, nativeDest); - Tcl_DStringFree(&srcString); - Tcl_DStringFree(&dstString); - return result; + return DoRenameFile(Tcl_FSGetNativePath(srcPathPtr), + Tcl_FSGetNativePath(destPathPtr)); } static int @@ -481,7 +394,7 @@ DoRenameFile( /* *--------------------------------------------------------------------------- * - * TclpCopyFile, DoCopyFile -- + * TclpObjCopyFile, DoCopyFile -- * * Copy a single file (not a directory). If dst already exists and * is not a directory, it is removed. @@ -506,20 +419,12 @@ DoRenameFile( */ int -TclpCopyFile( - CONST char *src, /* Pathname of file to be copied (UTF-8). */ - CONST char *dst) /* Pathname of file to copy to (UTF-8). */ +TclpObjCopyFile(srcPathPtr, destPathPtr) + Tcl_Obj *srcPathPtr; + Tcl_Obj *destPathPtr; { - int result; - Tcl_DString srcString, dstString; - - Tcl_WinUtfToTChar(src, -1, &srcString); - Tcl_WinUtfToTChar(dst, -1, &dstString); - result = DoCopyFile(Tcl_DStringValue(&srcString), - Tcl_DStringValue(&dstString)); - Tcl_DStringFree(&srcString); - Tcl_DStringFree(&dstString); - return result; + return DoCopyFile(Tcl_FSGetNativePath(srcPathPtr), + Tcl_FSGetNativePath(destPathPtr)); } static int @@ -532,6 +437,16 @@ DoCopyFile( * block device. */ + /* + * If 'nativeDst' is NULL, the following code can lock the process + * up, at least under Windows2000. Therefore we have to bail at + * that point. + */ + if (nativeDst == NULL) { + Tcl_SetErrno(ENOENT); + return TCL_ERROR; + } + __try { if ((*tclWinProcs->copyFileProc)(nativeSrc, nativeDst, 0) != FALSE) { return TCL_OK; @@ -578,7 +493,7 @@ DoCopyFile( /* *--------------------------------------------------------------------------- * - * TclpDeleteFile, DoDeleteFile -- + * TclpObjDeleteFile, DoDeleteFile -- * * Removes a single file (not a directory). * @@ -600,17 +515,11 @@ DoCopyFile( *--------------------------------------------------------------------------- */ -int -TclpDeleteFile( - CONST char *path) /* Pathname of file to be removed (UTF-8). */ +int +TclpObjDeleteFile(pathPtr) + Tcl_Obj *pathPtr; { - int result; - Tcl_DString pathString; - - Tcl_WinUtfToTChar(path, -1, &pathString); - result = DoDeleteFile(Tcl_DStringValue(&pathString)); - Tcl_DStringFree(&pathString); - return result; + return DoDeleteFile(Tcl_FSGetNativePath(pathPtr)); } static int @@ -629,6 +538,11 @@ DoDeleteFile( * instead of ENOENT. */ + if (nativePath == NULL) { + Tcl_SetErrno(ENOENT); + return TCL_ERROR; + } + if (tclWinProcs->useWide) { if (((WCHAR *) nativePath)[0] == '\0') { Tcl_SetErrno(ENOENT); @@ -687,7 +601,7 @@ DoDeleteFile( /* *--------------------------------------------------------------------------- * - * TclpCreateDirectory -- + * TclpObjCreateDirectory -- * * Creates the specified directory. All parent directories of the * specified directory must already exist. The directory is @@ -709,17 +623,11 @@ DoDeleteFile( *--------------------------------------------------------------------------- */ -int -TclpCreateDirectory( - CONST char *path) /* Pathname of directory to create (UTF-8). */ +int +TclpObjCreateDirectory(pathPtr) + Tcl_Obj *pathPtr; { - int result; - Tcl_DString pathString; - - Tcl_WinUtfToTChar(path, -1, &pathString); - result = DoCreateDirectory(Tcl_DStringValue(&pathString)); - Tcl_DStringFree(&pathString); - return result; + return DoCreateDirectory(Tcl_FSGetNativePath(pathPtr)); } static int @@ -738,7 +646,7 @@ DoCreateDirectory( /* *--------------------------------------------------------------------------- * - * TclpCopyDirectory -- + * TclpObjCopyDirectory -- * * Recursively copies a directory. The target directory dst must * not already exist. Note that this function does not merge two @@ -761,32 +669,38 @@ DoCreateDirectory( *--------------------------------------------------------------------------- */ -int -TclpCopyDirectory( - CONST char *src, /* Pathname of directory to be copied - * (UTF-8). */ - CONST char *dst, /* Pathname of target directory (UTF-8). */ - Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free - * DString filled with UTF-8 name of file - * causing error. */ +int +TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr) + Tcl_Obj *srcPathPtr; + Tcl_Obj *destPathPtr; + Tcl_Obj **errorPtr; { - int result; + Tcl_DString ds; Tcl_DString srcString, dstString; + int ret; - Tcl_WinUtfToTChar(src, -1, &srcString); - Tcl_WinUtfToTChar(dst, -1, &dstString); + Tcl_WinUtfToTChar(Tcl_FSGetTranslatedStringPath(NULL,srcPathPtr), + -1, &srcString); + Tcl_WinUtfToTChar(Tcl_FSGetTranslatedStringPath(NULL,destPathPtr), + -1, &dstString); - result = TraverseWinTree(TraversalCopy, &srcString, &dstString, errorPtr); + ret = TraverseWinTree(TraversalCopy, &srcString, &dstString, &ds); Tcl_DStringFree(&srcString); Tcl_DStringFree(&dstString); - return result; + + if (ret != TCL_OK) { + *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); + Tcl_DStringFree(&ds); + Tcl_IncrRefCount(*errorPtr); + } + return ret; } /* *---------------------------------------------------------------------- * - * TclpRemoveDirectory, DoRemoveDirectory -- + * TclpObjRemoveDirectory, DoRemoveDirectory -- * * Removes directory (and its contents, if the recursive flag is set). * @@ -812,25 +726,38 @@ TclpCopyDirectory( *---------------------------------------------------------------------- */ -int -TclpRemoveDirectory( - CONST char *path, /* Pathname of directory to be removed - * (UTF-8). */ - 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 +TclpObjRemoveDirectory(pathPtr, recursive, errorPtr) + Tcl_Obj *pathPtr; + int recursive; + Tcl_Obj **errorPtr; { - int result; - Tcl_DString pathString; - - Tcl_WinUtfToTChar(path, -1, &pathString); - result = DoRemoveDirectory(&pathString, recursive, errorPtr); - Tcl_DStringFree(&pathString); - - return result; + Tcl_DString ds; + int ret; + 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. + */ + Tcl_DString native; + Tcl_WinUtfToTChar(Tcl_FSGetTranslatedStringPath(NULL, pathPtr), + -1, &native); + ret = DoRemoveDirectory(&native, recursive, &ds); + Tcl_DStringFree(&native); + } else { + ret = DoRemoveJustDirectory(Tcl_FSGetNativePath(pathPtr), + recursive, &ds); + } + if (ret != TCL_OK) { + int len = Tcl_DStringLength(&ds); + if (len > 0) { + *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); + Tcl_IncrRefCount(*errorPtr); + } + Tcl_DStringFree(&ds); + } + return ret; } static int @@ -856,7 +783,11 @@ DoRemoveJustDirectory( * instead of ENOENT. */ - + if (nativePath == NULL) { + Tcl_SetErrno(ENOENT); + goto end; + } + if (tclWinProcs->useWide) { if (((WCHAR *) nativePath)[0] == '\0') { Tcl_SetErrno(ENOENT); @@ -974,7 +905,8 @@ DoRemoveDirectory( * DString filled with UTF-8 name of file * causing error. */ { - int res = DoRemoveJustDirectory(Tcl_DStringValue(pathPtr), recursive, errorPtr); + int res = DoRemoveJustDirectory(Tcl_DStringValue(pathPtr), recursive, + errorPtr); if ((res == TCL_ERROR) && (recursive != 0) && (Tcl_GetErrno() == EEXIST)) { /* @@ -1410,10 +1342,12 @@ ConvertFileNameFormat( splitPath = Tcl_FSSplitPath(fileName, &pathc); if (splitPath == NULL || pathc == 0) { - Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), + if (interp != NULL) { + Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "could not read \"", Tcl_GetString(fileName), "\": no such file or directory", (char *) NULL); + } result = TCL_ERROR; goto cleanup; } @@ -1480,7 +1414,9 @@ ConvertFileNameFormat( if (handle == INVALID_HANDLE_VALUE) { Tcl_DStringFree(&ds); - StatError(interp, fileName); + if (interp != NULL) { + StatError(interp, fileName); + } result = TCL_ERROR; goto cleanup; } @@ -1522,8 +1458,15 @@ ConvertFileNameFormat( Tcl_DStringInit(&dsTemp); Tcl_WinTCharToUtf(nativeName, -1, &dsTemp); - tempPath = Tcl_NewStringObj(Tcl_DStringValue(&dsTemp), - Tcl_DStringLength(&dsTemp)); + /* Deal with issues of tildes being absolute */ + if (Tcl_DStringValue(&dsTemp)[0] == '~') { + tempPath = Tcl_NewStringObj("./",2); + Tcl_AppendToObj(tempPath, Tcl_DStringValue(&dsTemp), + Tcl_DStringLength(&dsTemp)); + } else { + tempPath = Tcl_NewStringObj(Tcl_DStringValue(&dsTemp), + Tcl_DStringLength(&dsTemp)); + } Tcl_ListObjReplace(NULL, splitPath, i, 1, 1, &tempPath); Tcl_DStringFree(&ds); Tcl_DStringFree(&dsTemp); |