Initial revision

1 files changed, 1401 insertions, 0 deletions

diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c
new file mode 100644
index 0000000..f2df779
--- /dev/null
+++ b/win/tclWinFCmd.c
@@ -0,0 +1,1401 @@
+/*
+ * tclWinFCmd.c
+ *
+ *      This file implements the Windows specific portion of file manipulation 
+ *      subcommands of the "file" command. 
+ *
+ * Copyright (c) 1996-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tclWinFCmd.c 1.20 97/10/10 11:50:14
+ */
+
+#include "tclWinInt.h"
+
+/*
+ * The following constants specify the type of callback when
+ * TraverseWinTree() calls the traverseProc()
+ */
+
+#define DOTREE_PRED   1     /* pre-order directory  */
+#define DOTREE_POSTD  2     /* post-order directory */
+#define DOTREE_F      3     /* regular file */
+
+/*
+ * Callbacks for file attributes code.
+ */
+
+static int		GetWinFileAttributes _ANSI_ARGS_((Tcl_Interp *interp,
+			    int objIndex, char *fileName,
+			    Tcl_Obj **attributePtrPtr));
+static int		GetWinFileLongName _ANSI_ARGS_((Tcl_Interp *interp,
+			    int objIndex, char *fileName,
+			    Tcl_Obj **attributePtrPtr));
+static int		GetWinFileShortName _ANSI_ARGS_((Tcl_Interp *interp,
+			    int objIndex, char *fileName,
+			    Tcl_Obj **attributePtrPtr));
+static int		SetWinFileAttributes _ANSI_ARGS_((Tcl_Interp *interp,
+			    int objIndex, char *fileName,
+			    Tcl_Obj *attributePtr));
+static int		CannotSetAttribute _ANSI_ARGS_((Tcl_Interp *interp,
+			    int objIndex, char *fileName,
+			    Tcl_Obj *attributePtr));
+
+/*
+ * Constants and variables necessary for file attributes subcommand.
+ */
+
+enum {
+    WIN_ARCHIVE_ATTRIBUTE,
+    WIN_HIDDEN_ATTRIBUTE,
+    WIN_LONGNAME_ATTRIBUTE,
+    WIN_READONLY_ATTRIBUTE,
+    WIN_SHORTNAME_ATTRIBUTE,
+    WIN_SYSTEM_ATTRIBUTE
+};
+
+static int attributeArray[] = {FILE_ATTRIBUTE_ARCHIVE, FILE_ATTRIBUTE_HIDDEN,
+	0, FILE_ATTRIBUTE_READONLY, 0, FILE_ATTRIBUTE_SYSTEM};
+
+
+char *tclpFileAttrStrings[] = {"-archive", "-hidden", "-longname", "-readonly",
+	"-shortname", "-system", (char *) NULL};
+CONST TclFileAttrProcs tclpFileAttrProcs[] = {
+	{GetWinFileAttributes, SetWinFileAttributes},
+	{GetWinFileAttributes, SetWinFileAttributes},
+	{GetWinFileLongName, CannotSetAttribute},
+	{GetWinFileAttributes, SetWinFileAttributes},
+	{GetWinFileShortName, CannotSetAttribute},
+	{GetWinFileAttributes, SetWinFileAttributes}};
+
+/*
+ * Prototype for the TraverseWinTree callback function.
+ */
+
+typedef int (TraversalProc)(char *src, char *dst, DWORD attr, int type, 
+	Tcl_DString *errorPtr);
+
+/*
+ * Declarations for local procedures defined in this file:
+ */
+
+static void		AttributesPosixError _ANSI_ARGS_((Tcl_Interp *interp,
+			    int objIndex, char *fileName, int getOrSet));
+static int		ConvertFileNameFormat _ANSI_ARGS_((Tcl_Interp *interp,
+			    int objIndex, char *fileName, int longShort,
+			    Tcl_Obj **attributePtrPtr));
+static int		TraversalCopy(char *src, char *dst, DWORD attr, 
+				int type, Tcl_DString *errorPtr);
+static int		TraversalDelete(char *src, char *dst, DWORD attr,
+				int type, Tcl_DString *errorPtr);
+static int		TraverseWinTree(TraversalProc *traverseProc,
+			    Tcl_DString *sourcePtr, Tcl_DString *destPtr,
+			    Tcl_DString *errorPtr);
+
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpRenameFile --
+ *
+ *      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
+ *	and returns success.  Otherwise if dst already exists, it will be
+ *	deleted and replaced by src subject to the following conditions:
+ *	    If src is a directory, dst may be an empty directory.
+ *	    If src is a file, dst may be a file.
+ *	In any other situation where dst already exists, the rename will
+ *	fail.  
+ *
+ * Results:
+ *	If the directory was successfully created, returns TCL_OK.
+ *	Otherwise the return value is TCL_ERROR and errno is set to
+ *	indicate the error.  Some possible values for errno are:
+ *
+ *	EACCES:     src or dst parent directory can't be read and/or written.
+ *	EEXIST:	    dst is a non-empty directory.
+ *	EINVAL:	    src is a root directory or dst is a subdirectory of src.
+ *	EISDIR:	    dst is a directory, but src is not.
+ *	ENOENT:	    src doesn't exist.  src or dst is "".
+ *	ENOTDIR:    src is a directory, but dst is not.  
+ *	EXDEV:	    src and dst are on different filesystems.
+ *
+ *	EACCES:     exists an open file already referring to src or dst.
+ *	EACCES:     src or dst specify the current working directory (NT).
+ *	EACCES:	    src specifies a char device (nul:, com1:, etc.) 
+ *	EEXIST:	    dst specifies a char device (nul:, com1:, etc.) (NT)
+ *	EACCES:	    dst specifies a char device (nul:, com1:, etc.) (95)
+ *	
+ * Side effects:
+ *	The implementation supports cross-filesystem renames of files,
+ *	but the caller should be prepared to emulate cross-filesystem
+ *	renames of directories if errno is EXDEV.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TclpRenameFile(
+    char *src,			/* Pathname of file or dir to be renamed. */ 
+    char *dst)			/* New pathname for file or directory. */
+{
+    DWORD srcAttr, dstAttr;
+    
+    /*
+     * Would throw an exception under NT if one of the arguments is a 
+     * char block device.
+     */
+
+    try {
+	if (MoveFile(src, dst) != FALSE) {
+	    return TCL_OK;
+	}
+    } except (-1) {}
+
+    TclWinConvertError(GetLastError());
+
+    srcAttr = GetFileAttributes(src);
+    dstAttr = GetFileAttributes(dst);
+    if (srcAttr == (DWORD) -1) {
+	srcAttr = 0;
+    }
+    if (dstAttr == (DWORD) -1) {
+	dstAttr = 0;
+    }
+
+    if (errno == EBADF) {
+	errno = EACCES;
+	return TCL_ERROR;
+    }
+    if ((errno == EACCES) && (TclWinGetPlatformId() == VER_PLATFORM_WIN32s)) {
+	if ((srcAttr != 0) && (dstAttr != 0)) {
+	    /*
+	     * Win32s reports trying to overwrite an existing file or directory
+	     * as EACCES.
+	     */
+
+	    errno = EEXIST;
+	}
+    }
+    if (errno == EACCES) {
+	decode:
+	if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) {
+	    char srcPath[MAX_PATH], dstPath[MAX_PATH];
+	    int srcArgc, dstArgc;
+	    char **srcArgv, **dstArgv;
+	    char *srcRest, *dstRest;
+	    int size;
+
+	    size = GetFullPathName(src, sizeof(srcPath), srcPath, &srcRest);
+	    if ((size == 0) || (size > sizeof(srcPath))) {
+		return TCL_ERROR;
+	    }
+	    size = GetFullPathName(dst, sizeof(dstPath), dstPath, &dstRest);
+	    if ((size == 0) || (size > sizeof(dstPath))) {
+		return TCL_ERROR;
+	    }
+	    if (srcRest == NULL) {
+		srcRest = srcPath + strlen(srcPath);
+	    }
+	    if (strnicmp(srcPath, dstPath, srcRest - srcPath) == 0) {
+		/*
+		 * Trying to move a directory into itself.
+		 */
+
+		errno = EINVAL;
+		return TCL_ERROR;
+	    }
+	    Tcl_SplitPath(srcPath, &srcArgc, &srcArgv);
+	    Tcl_SplitPath(dstPath, &dstArgc, &dstArgv);
+	    if (srcArgc == 1) {
+		/*
+		 * They are trying to move a root directory.  Whether
+		 * or not it is across filesystems, this cannot be
+		 * done.
+		 */
+
+		errno = EINVAL;
+	    } else if ((srcArgc > 0) && (dstArgc > 0) &&
+		    (stricmp(srcArgv[0], dstArgv[0]) != 0)) {
+		/*
+		 * If src is a directory and dst filesystem != src
+		 * filesystem, errno should be EXDEV.  It is very
+		 * important to get this behavior, so that the caller
+		 * can respond to a cross filesystem rename by
+		 * simulating it with copy and delete.  The MoveFile
+		 * system call already handles the case of moving a
+		 * file between filesystems.
+		 */
+
+		errno = EXDEV;
+	    }
+
+	    ckfree((char *) srcArgv);
+	    ckfree((char *) dstArgv);
+	}
+
+	/*
+	 * Other types of access failure is that dst is a read-only
+	 * filesystem, that an open file referred to src or dest, or that
+	 * src or dest specified the current working directory on the
+	 * current filesystem.  EACCES is returned for those cases.
+	 */
+
+    } else if (errno == EEXIST) {
+	/*
+	 * Reports EEXIST any time the target already exists.  If it makes
+	 * sense, remove the old file and try renaming again.
+	 */
+
+	if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) {
+	    if (dstAttr & FILE_ATTRIBUTE_DIRECTORY) {
+		/*
+		 * Overwrite empty dst directory with src directory.  The
+		 * following call will remove an empty directory.  If it
+		 * fails, it's because it wasn't empty.
+		 */
+
+		if (TclpRemoveDirectory(dst, 0, NULL) == TCL_OK) {
+		    /*
+		     * Now that that empty directory is gone, we can try
+		     * renaming again.  If that fails, we'll put this empty
+		     * directory back, for completeness.
+		     */
+
+		    if (MoveFile(src, dst) != FALSE) {
+			return TCL_OK;
+		    }
+
+		    /*
+		     * Some new error has occurred.  Don't know what it
+		     * could be, but report this one.
+		     */
+
+		    TclWinConvertError(GetLastError());
+		    CreateDirectory(dst, NULL);
+		    SetFileAttributes(dst, dstAttr);
+		    if (errno == EACCES) {
+			/*
+			 * Decode the EACCES to a more meaningful error.
+			 */
+
+			goto decode;
+		    }
+		}
+	    } else {	/* (dstAttr & FILE_ATTRIBUTE_DIRECTORY) == 0 */
+		errno = ENOTDIR;
+	    }
+	} else {    /* (srcAttr & FILE_ATTRIBUTE_DIRECTORY) == 0 */
+	    if (dstAttr & FILE_ATTRIBUTE_DIRECTORY) {
+		errno = EISDIR;
+	    } else {
+		/*
+		 * Overwrite existing file by:
+		 * 
+		 * 1. Rename existing file to temp name.
+		 * 2. Rename old file to new name.
+		 * 3. If success, delete temp file.  If failure,
+		 *    put temp file back to old name.
+		 */
+
+		char tempName[MAX_PATH];
+		int result, size;
+		char *rest;
+		
+		size = GetFullPathName(dst, sizeof(tempName), tempName, &rest);
+		if ((size == 0) || (size > sizeof(tempName)) || (rest == NULL)) {
+		    return TCL_ERROR;
+		}
+		*rest = '\0';
+		result = TCL_ERROR;
+		if (GetTempFileName(tempName, "tclr", 0, tempName) != 0) {
+		    /*
+		     * Strictly speaking, need the following DeleteFile and
+		     * MoveFile to be joined as an atomic operation so no
+		     * other app comes along in the meantime and creates the
+		     * same temp file.
+		     */
+		     
+		    DeleteFile(tempName);
+		    if (MoveFile(dst, tempName) != FALSE) {
+			if (MoveFile(src, dst) != FALSE) {
+			    SetFileAttributes(tempName, FILE_ATTRIBUTE_NORMAL);
+			    DeleteFile(tempName);
+			    return TCL_OK;
+			} else {
+			    DeleteFile(dst);
+			    MoveFile(tempName, dst);
+			}
+		    } 
+
+		    /*
+		     * Can't backup dst file or move src file.  Return that
+		     * error.  Could happen if an open file refers to dst.
+		     */
+
+		    TclWinConvertError(GetLastError());
+		    if (errno == EACCES) {
+			/*
+			 * Decode the EACCES to a more meaningful error.
+			 */
+
+			goto decode;
+		    }
+		}
+		return result;
+	    }
+	}
+    }
+    return TCL_ERROR;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpCopyFile --
+ *
+ *      Copy a single file (not a directory).  If dst already exists and
+ *	is not a directory, it is removed.
+ *
+ * Results:
+ *	If the file was successfully copied, returns TCL_OK.  Otherwise
+ *	the return value is TCL_ERROR and errno is set to indicate the
+ *	error.  Some possible values for errno are:
+ *
+ *	EACCES:     src or dst parent directory can't be read and/or written.
+ *	EISDIR:	    src or dst is a directory.
+ *	ENOENT:	    src doesn't exist.  src or dst is "".
+ *
+ *	EACCES:     exists an open file already referring to dst (95).
+ *	EACCES:	    src specifies a char device (nul:, com1:, etc.) (NT)
+ *	ENOENT:	    src specifies a char device (nul:, com1:, etc.) (95)
+ *
+ * Side effects:
+ *	It is not an error to copy to a char device.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int 
+TclpCopyFile(
+    char *src,			/* Pathname of file to be copied. */
+    char *dst)			/* Pathname of file to copy to. */
+{
+    /*
+     * Would throw an exception under NT if one of the arguments is a char
+     * block device.
+     */
+
+    try {
+	if (CopyFile(src, dst, 0) != FALSE) {
+	    return TCL_OK;
+	}
+    } except (-1) {}
+
+    TclWinConvertError(GetLastError());
+    if (errno == EBADF) {
+	errno = EACCES;
+	return TCL_ERROR;
+    }
+    if (errno == EACCES) {
+	DWORD srcAttr, dstAttr;
+
+	srcAttr = GetFileAttributes(src);
+	dstAttr = GetFileAttributes(dst);
+	if (srcAttr != (DWORD) -1) {
+	    if (dstAttr == (DWORD) -1) {
+		dstAttr = 0;
+	    }
+	    if ((srcAttr & FILE_ATTRIBUTE_DIRECTORY) ||
+		    (dstAttr & FILE_ATTRIBUTE_DIRECTORY)) {
+		errno = EISDIR;
+	    }
+	    if (dstAttr & FILE_ATTRIBUTE_READONLY) {
+		SetFileAttributes(dst, dstAttr & ~FILE_ATTRIBUTE_READONLY);
+		if (CopyFile(src, dst, 0) != FALSE) {
+		    return TCL_OK;
+		}
+		/*
+		 * Still can't copy onto dst.  Return that error, and
+		 * restore attributes of dst.
+		 */
+
+		TclWinConvertError(GetLastError());
+		SetFileAttributes(dst, dstAttr);
+	    }
+	}
+    }
+    return TCL_ERROR;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpDeleteFile --
+ *
+ *      Removes a single file (not a directory).
+ *
+ * Results:
+ *	If the file was successfully deleted, returns TCL_OK.  Otherwise
+ *	the return value is TCL_ERROR and errno is set to indicate the
+ *	error.  Some possible values for errno are:
+ *
+ *	EACCES:     a parent directory can't be read and/or written.
+ *	EISDIR:	    path is a directory.
+ *	ENOENT:	    path doesn't exist or is "".
+ *
+ *	EACCES:     exists an open file already referring to path.
+ *	EACCES:	    path is a char device (nul:, com1:, etc.)
+ *
+ * Side effects:
+ *      The file is deleted, even if it is read-only.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TclpDeleteFile(
+    char *path)			/* Pathname of file to be removed. */
+{
+    DWORD attr;
+
+    if (DeleteFile(path) != FALSE) {
+	return TCL_OK;
+    }
+    TclWinConvertError(GetLastError());
+    if (path[0] == '\0') {
+	/*
+	 * Win32s thinks that "" is the same as "." and then reports EISDIR
+	 * instead of ENOENT.
+	 */
+
+	errno = ENOENT;
+    } else if (errno == EACCES) {
+        attr = GetFileAttributes(path);
+	if (attr != (DWORD) -1) {
+	    if (attr & FILE_ATTRIBUTE_DIRECTORY) {
+		/*
+		 * Windows NT reports removing a directory as EACCES instead
+		 * of EISDIR.
+		 */
+
+		errno = EISDIR;
+	    } else if (attr & FILE_ATTRIBUTE_READONLY) {
+		SetFileAttributes(path, attr & ~FILE_ATTRIBUTE_READONLY);
+		if (DeleteFile(path) != FALSE) {
+		    return TCL_OK;
+		}
+		TclWinConvertError(GetLastError());
+		SetFileAttributes(path, attr);
+	    }
+	}
+    } else if (errno == ENOENT) {
+        attr = GetFileAttributes(path);
+	if (attr != (DWORD) -1) {
+	    if (attr & FILE_ATTRIBUTE_DIRECTORY) {
+	    	/*
+		 * Windows 95 reports removing a directory as ENOENT instead 
+		 * of EISDIR. 
+		 */
+
+		errno = EISDIR;
+	    }
+	}
+    } else if (errno == EINVAL) {
+	/*
+	 * Windows NT reports removing a char device as EINVAL instead of
+	 * EACCES.
+	 */
+
+	errno = EACCES;
+    }
+
+    return TCL_ERROR;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpCreateDirectory --
+ *
+ *      Creates the specified directory.  All parent directories of the
+ *	specified directory must already exist.  The directory is
+ *	automatically created with permissions so that user can access
+ *	the new directory and create new files or subdirectories in it.
+ *
+ * Results:
+ *	If the directory was successfully created, returns TCL_OK.
+ *	Otherwise the return value is TCL_ERROR and errno is set to
+ *	indicate the error.  Some possible values for errno are:
+ *
+ *	EACCES:     a parent directory can't be read and/or written.
+ *	EEXIST:	    path already exists.
+ *	ENOENT:	    a parent directory doesn't exist.
+ *
+ * Side effects:
+ *      A directory is created.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TclpCreateDirectory(
+    char *path)			/* Pathname of directory to create */
+{
+    int error;
+
+    if (CreateDirectory(path, NULL) == 0) {
+	error = GetLastError();
+	if (TclWinGetPlatformId() == VER_PLATFORM_WIN32s) {
+	    if ((error == ERROR_ACCESS_DENIED) 
+		    && (GetFileAttributes(path) != (DWORD) -1)) {
+		error = ERROR_FILE_EXISTS;
+	    }
+	}
+	TclWinConvertError(error);
+	return TCL_ERROR;
+    }   
+    return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpCopyDirectory --
+ *
+ *      Recursively copies a directory.  The target directory dst must
+ *	not already exist.  Note that this function does not merge two
+ *	directory hierarchies, even if the target directory is an an
+ *	empty directory.
+ *
+ * Results:
+ *	If the directory was successfully copied, returns TCL_OK.
+ *	Otherwise the return value is TCL_ERROR, errno is set to indicate
+ *	the error, and the pathname of the file that caused the error
+ *	is stored in errorPtr.  See TclpCreateDirectory and TclpCopyFile
+ *	for a description of possible values for errno.
+ *
+ * Side effects:
+ *      An exact copy of the directory hierarchy src will be created
+ *	with the name dst.  If an error occurs, the error will
+ *      be returned immediately, and remaining files will not be
+ *	processed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TclpCopyDirectory(
+    char *src,			/* Pathname of directory to be copied. */
+    char *dst,			/* Pathname of target directory. */
+    Tcl_DString *errorPtr)	/* If non-NULL, initialized DString for
+				 * error reporting. */
+{
+    int result;
+    Tcl_DString srcBuffer;
+    Tcl_DString dstBuffer;
+
+    Tcl_DStringInit(&srcBuffer);
+    Tcl_DStringInit(&dstBuffer);
+    Tcl_DStringAppend(&srcBuffer, src, -1);
+    Tcl_DStringAppend(&dstBuffer, dst, -1);
+    result = TraverseWinTree(TraversalCopy, &srcBuffer, &dstBuffer, 
+	    errorPtr);
+    Tcl_DStringFree(&srcBuffer);
+    Tcl_DStringFree(&dstBuffer);
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpRemoveDirectory -- 
+ *
+ *	Removes directory (and its contents, if the recursive flag is set).
+ *
+ * Results:
+ *	If the directory was successfully removed, returns TCL_OK.
+ *	Otherwise the return value is TCL_ERROR, errno is set to indicate
+ *	the error, and the pathname of the file that caused the error
+ *	is stored in errorPtr.  Some possible values for errno are:
+ *
+ *	EACCES:     path directory can't be read and/or written.
+ *	EEXIST:	    path is a non-empty directory.
+ *	EINVAL:	    path is root directory or current directory.
+ *	ENOENT:	    path doesn't exist or is "".
+ * 	ENOTDIR:    path is not a directory.
+ *
+ *	EACCES:	    path is a char device (nul:, com1:, etc.) (95)
+ *	EINVAL:	    path is a char device (nul:, com1:, etc.) (NT)
+ *
+ * Side effects:
+ *	Directory removed.  If an error occurs, the error will be returned
+ *	immediately, and remaining files will not be deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclpRemoveDirectory(
+    char *path,			/* Pathname of directory to be removed. */
+    int recursive,		/* If non-zero, removes directories that
+				 * are nonempty.  Otherwise, will only remove
+				 * empty directories. */
+    Tcl_DString *errorPtr)	/* If non-NULL, initialized DString for
+				 * error reporting. */
+{
+    int result;
+    Tcl_DString buffer;
+    DWORD attr;
+
+    if (RemoveDirectory(path) != FALSE) {
+	return TCL_OK;
+    }
+    TclWinConvertError(GetLastError());
+    if (path[0] == '\0') {
+	/*
+	 * Win32s thinks that "" is the same as "." and then reports EACCES
+	 * instead of ENOENT.
+	 */
+
+	errno = ENOENT;
+    }
+    if (errno == EACCES) {
+	attr = GetFileAttributes(path);
+	if (attr != (DWORD) -1) {
+	    if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
+		/* 
+		 * Windows 95 reports calling RemoveDirectory on a file as an 
+		 * EACCES, not an ENOTDIR.
+		 */
+		
+		errno = ENOTDIR;
+		goto end;
+	    }
+
+	    if (attr & FILE_ATTRIBUTE_READONLY) {
+		attr &= ~FILE_ATTRIBUTE_READONLY;
+		if (SetFileAttributes(path, attr) == FALSE) {
+		    goto end;
+		}
+		if (RemoveDirectory(path) != FALSE) {
+		    return TCL_OK;
+		}
+		TclWinConvertError(GetLastError());
+		SetFileAttributes(path, attr | FILE_ATTRIBUTE_READONLY);
+	    }
+
+	    /* 
+	     * Windows 95 and Win32s report removing a non-empty directory 
+	     * as EACCES, not EEXIST.  If the directory is not empty,
+	     * change errno so caller knows what's going on.
+	     */
+
+	    if (TclWinGetPlatformId() != VER_PLATFORM_WIN32_NT) {
+		HANDLE handle;
+		WIN32_FIND_DATA data;
+		Tcl_DString buffer;
+		char *find;
+		int len;
+
+		Tcl_DStringInit(&buffer);
+		find = Tcl_DStringAppend(&buffer, path, -1);
+		len = Tcl_DStringLength(&buffer);
+		if ((len > 0) && (find[len - 1] != '\\')) {
+		    Tcl_DStringAppend(&buffer, "\\", 1);
+		}
+		find = Tcl_DStringAppend(&buffer, "*.*", 3);
+		handle = FindFirstFile(find, &data);
+		if (handle != INVALID_HANDLE_VALUE) {
+		    while (1) {
+			if ((strcmp(data.cFileName, ".") != 0)
+				&& (strcmp(data.cFileName, "..") != 0)) {
+			    /*
+			     * Found something in this directory.
+			     */
+
+			    errno = EEXIST;
+			    break;
+			}
+			if (FindNextFile(handle, &data) == FALSE) {
+			    break;
+			}
+		    }
+		    FindClose(handle);
+		}
+		Tcl_DStringFree(&buffer);
+	    }
+	}
+    }
+    if (errno == ENOTEMPTY) {
+	/* 
+	 * The caller depends on EEXIST to signify that the directory is
+	 * not empty, not ENOTEMPTY. 
+	 */
+
+	errno = EEXIST;
+    }
+    if ((recursive != 0) && (errno == EEXIST)) {
+	/*
+	 * The directory is nonempty, but the recursive flag has been
+	 * specified, so we recursively remove all the files in the directory.
+	 */
+
+	Tcl_DStringInit(&buffer);
+	Tcl_DStringAppend(&buffer, path, -1);
+	result = TraverseWinTree(TraversalDelete, &buffer, NULL, errorPtr);
+	Tcl_DStringFree(&buffer);
+	return result;
+    }
+
+    end:
+    if (errorPtr != NULL) {
+        Tcl_DStringAppend(errorPtr, path, -1);
+    }
+    return TCL_ERROR;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TraverseWinTree --
+ *
+ *      Traverse directory tree specified by sourcePtr, calling the function 
+ *	traverseProc for each file and directory encountered.  If destPtr 
+ *	is non-null, each of name in the sourcePtr directory is appended to 
+ *	the directory specified by destPtr and passed as the second argument 
+ *	to traverseProc() .
+ *
+ * Results:
+ *      Standard Tcl result.
+ *
+ * Side effects:
+ *      None caused by TraverseWinTree, however the user specified 
+ *	traverseProc() may change state.  If an error occurs, the error will
+ *      be returned immediately, and remaining files will not be processed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int 
+TraverseWinTree(
+    TraversalProc *traverseProc,/* Function to call for every file and
+				 * directory in source hierarchy. */
+    Tcl_DString *sourcePtr,	/* Pathname of source directory to be
+				 * traversed. */
+    Tcl_DString *targetPtr,	/* Pathname of directory to traverse in
+				 * parallel with source directory. */
+    Tcl_DString *errorPtr)	/* If non-NULL, an initialized DString for
+				 * error reporting. */
+{
+    DWORD sourceAttr;
+    char *source, *target, *errfile;
+    int result, sourceLen, targetLen, sourceLenOriginal, targetLenOriginal;
+    HANDLE handle;
+    WIN32_FIND_DATA data;
+
+    result = TCL_OK;
+    source = Tcl_DStringValue(sourcePtr);
+    sourceLenOriginal = Tcl_DStringLength(sourcePtr);
+    if (targetPtr != NULL) {
+	target = Tcl_DStringValue(targetPtr);
+	targetLenOriginal = Tcl_DStringLength(targetPtr);
+    } else {
+	target = NULL;
+	targetLenOriginal = 0;
+    }
+
+    errfile = NULL;
+
+    sourceAttr = GetFileAttributes(source);
+    if (sourceAttr == (DWORD) -1) {
+	errfile = source;
+	goto end;
+    }
+    if ((sourceAttr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
+	/*
+	 * Process the regular file
+	 */
+
+	return (*traverseProc)(source, target, sourceAttr, DOTREE_F, errorPtr);
+    }
+
+    /*
+     * When given the pathname of the form "c:\" (one that already ends
+     * with a backslash), must make sure not to add another "\" to the end
+     * otherwise it will try to access a network drive.  
+     */
+
+    sourceLen = sourceLenOriginal;
+    if ((sourceLen > 0) && (source[sourceLen - 1] != '\\')) {
+	Tcl_DStringAppend(sourcePtr, "\\", 1);
+	sourceLen++;
+    }
+    source = Tcl_DStringAppend(sourcePtr, "*.*", 3); 
+    handle = FindFirstFile(source, &data);
+    Tcl_DStringSetLength(sourcePtr, sourceLen);
+    if (handle == INVALID_HANDLE_VALUE) {
+	/* 
+	 * Can't read directory
+	 */
+
+	TclWinConvertError(GetLastError());
+	errfile = source;
+	goto end;
+    }
+
+    result = (*traverseProc)(source, target, sourceAttr, DOTREE_PRED, errorPtr);
+    if (result != TCL_OK) {
+	FindClose(handle);
+	return result;
+    }
+
+    if (targetPtr != NULL) {
+	targetLen = targetLenOriginal;
+	if ((targetLen > 0) && (target[targetLen - 1] != '\\')) {
+	    target = Tcl_DStringAppend(targetPtr, "\\", 1);
+	    targetLen++;
+	}
+    }
+
+    while (1) {
+	if ((strcmp(data.cFileName, ".") != 0)
+	        && (strcmp(data.cFileName, "..") != 0)) {
+	    /* 
+	     * Append name after slash, and recurse on the file. 
+	     */
+
+	    Tcl_DStringAppend(sourcePtr, data.cFileName, -1);
+	    if (targetPtr != NULL) {
+		Tcl_DStringAppend(targetPtr, data.cFileName, -1);
+	    }
+	    result = TraverseWinTree(traverseProc, sourcePtr, targetPtr, 
+		    errorPtr);
+	    if (result != TCL_OK) {
+		break;
+	    }
+
+	    /*
+	     * Remove name after slash.
+	     */
+
+	    Tcl_DStringSetLength(sourcePtr, sourceLen);
+	    if (targetPtr != NULL) {
+		Tcl_DStringSetLength(targetPtr, targetLen);
+	    }
+	}
+	if (FindNextFile(handle, &data) == FALSE) {
+	    break;
+	}
+    }
+    FindClose(handle);
+
+    /*
+     * Strip off the trailing slash we added
+     */
+
+    Tcl_DStringSetLength(sourcePtr, sourceLenOriginal);
+    source = Tcl_DStringValue(sourcePtr);
+    if (targetPtr != NULL) {
+	Tcl_DStringSetLength(targetPtr, targetLenOriginal);
+	target = Tcl_DStringValue(targetPtr);
+    }
+
+    if (result == TCL_OK) {
+	/*
+	 * Call traverseProc() on a directory after visiting all the
+	 * files in that directory.
+	 */
+
+	result = (*traverseProc)(source, target, sourceAttr, 
+		DOTREE_POSTD, errorPtr);
+    }
+    end:
+    if (errfile != NULL) {
+	TclWinConvertError(GetLastError());
+	if (errorPtr != NULL) {
+	    Tcl_DStringAppend(errorPtr, errfile, -1);
+	}
+	result = TCL_ERROR;
+    }
+	    
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TraversalCopy
+ *
+ *      Called from TraverseUnixTree in order to execute a recursive
+ *      copy of a directory.
+ *
+ * Results:
+ *      Standard Tcl result.
+ *
+ * Side effects:
+ *      Depending on the value of type, src may be copied to dst.
+ *      
+ *----------------------------------------------------------------------
+ */
+
+static int 
+TraversalCopy(
+    char *src,			/* Source pathname to copy. */
+    char *dst,			/* Destination pathname of copy. */
+    DWORD srcAttr,		/* File attributes for src. */
+    int type,			/* Reason for call - see TraverseWinTree() */
+    Tcl_DString *errorPtr)	/* If non-NULL, initialized DString for
+				 * error return. */
+{
+    switch (type) {
+	case DOTREE_F:
+	    if (TclpCopyFile(src, dst) == TCL_OK) {
+		return TCL_OK;
+	    }
+	    break;
+
+	case DOTREE_PRED:
+	    if (TclpCreateDirectory(dst) == TCL_OK) {
+		if (SetFileAttributes(dst, srcAttr) != FALSE) {
+		    return TCL_OK;
+		}
+		TclWinConvertError(GetLastError());
+	    }
+	    break;
+
+        case DOTREE_POSTD:
+	    return TCL_OK;
+
+    }
+
+    /*
+     * There shouldn't be a problem with src, because we already
+     * checked it to get here.
+     */
+
+    if (errorPtr != NULL) {
+	Tcl_DStringAppend(errorPtr, dst, -1);
+    }
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TraversalDelete --
+ *
+ *      Called by procedure TraverseWinTree for every file and
+ *      directory that it encounters in a directory hierarchy. This
+ *      procedure unlinks files, and removes directories after all the
+ *      containing files have been processed.
+ *
+ * Results:
+ *      Standard Tcl result.
+ *
+ * Side effects:
+ *      Files or directory specified by src will be deleted. If an
+ *      error occurs, the windows error is converted to a Posix error
+ *      and errno is set accordingly.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TraversalDelete( 
+    char *src,			/* Source pathname. */
+    char *ignore,		/* Destination pathname (not used). */
+    DWORD srcAttr,		/* File attributes for src (not used). */
+    int type,			/* Reason for call - see TraverseWinTree(). */
+    Tcl_DString *errorPtr)	/* If non-NULL, initialized DString for
+				 * error return. */
+{
+    switch (type) {
+	case DOTREE_F:
+	    if (TclpDeleteFile(src) == TCL_OK) {
+		return TCL_OK;
+	    }
+	    break;
+
+	case DOTREE_PRED:
+	    return TCL_OK;
+
+	case DOTREE_POSTD:
+	    if (TclpRemoveDirectory(src, 0, NULL) == TCL_OK) {
+		return TCL_OK;
+	    }
+	    break;
+
+    }
+
+    if (errorPtr != NULL) {
+	Tcl_DStringAppend(errorPtr, src, -1);
+    }
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AttributesPosixError --
+ *
+ *	Sets the object result with the appropriate error.
+ *
+ * Results:
+ *      None.
+ *
+ * Side effects:
+ *      The interp's object result is set with an error message
+ *	based on the objIndex, fileName and errno.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+AttributesPosixError(
+    Tcl_Interp *interp,		/* The interp that has the error */
+    int objIndex,		/* The attribute which caused the problem. */
+    char *fileName,		/* The name of the file which caused the 
+				 * error. */
+    int getOrSet)		/* 0 for get; 1 for set */
+{
+    TclWinConvertError(GetLastError());
+    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), 
+	    "cannot ", getOrSet ? "set" : "get", " attribute \"", 
+	    tclpFileAttrStrings[objIndex], "\" for file \"", fileName, 
+	    "\": ", Tcl_PosixError(interp), (char *) NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetWinFileAttributes --
+ *
+ *      Returns a Tcl_Obj containing the value of a file attribute.
+ *	This routine gets the -hidden, -readonly or -system attribute.
+ *
+ * Results:
+ *      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.
+ *
+ * Side effects:
+ *      A new object is allocated if the file is valid.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetWinFileAttributes(
+    Tcl_Interp *interp,		    /* The interp we are using for errors. */
+    int objIndex,		    /* The index of the attribute. */
+    char *fileName,		    /* The name of the file. */
+    Tcl_Obj **attributePtrPtr)	    /* A pointer to return the object with. */
+{
+    DWORD result = GetFileAttributes(fileName);
+
+    if (result == 0xFFFFFFFF) {
+	AttributesPosixError(interp, objIndex, fileName, 0);
+	return TCL_ERROR;
+    }
+
+    *attributePtrPtr = Tcl_NewBooleanObj(result & attributeArray[objIndex]);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConvertFileNameFormat --
+ *
+ *      Returns a Tcl_Obj containing either the long or short version of the 
+ *	file name.
+ *
+ * Results:
+ *      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.
+ *
+ * Side effects:
+ *      A new object is allocated if the file is valid.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConvertFileNameFormat(
+    Tcl_Interp *interp,		    /* The interp we are using for errors. */
+    int objIndex,		    /* The index of the attribute. */
+    char *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. */
+{
+    HANDLE findHandle;
+    WIN32_FIND_DATA findData;
+    int pathArgc, i;
+    char **pathArgv, **newPathArgv;
+    char *currentElement, *resultStr;
+    Tcl_DString resultDString;
+    int result = TCL_OK;
+
+    Tcl_SplitPath(fileName, &pathArgc, &pathArgv);
+    newPathArgv = (char **) ckalloc(pathArgc * sizeof(char *));
+
+    i = 0;
+    if ((pathArgv[0][0] == '/') 
+	    || ((strlen(pathArgv[0]) == 3) && (pathArgv[0][1] == ':'))) {
+	newPathArgv[0] = (char *) ckalloc(strlen(pathArgv[0]) + 1);
+	strcpy(newPathArgv[0], pathArgv[0]);
+	i = 1;
+    } 
+    for ( ; i < pathArgc; i++) {
+	if (strcmp(pathArgv[i], ".") == 0) {
+	    currentElement = ckalloc(2);
+	    strcpy(currentElement, ".");
+	} else if (strcmp(pathArgv[i], "..") == 0) {
+	    currentElement = ckalloc(3);
+	    strcpy(currentElement, "..");
+	} else {
+	    int useLong;
+
+	    Tcl_DStringInit(&resultDString);
+	    resultStr = Tcl_JoinPath(i + 1, pathArgv, &resultDString);
+	    findHandle = FindFirstFile(resultStr, &findData);
+	    if (findHandle == INVALID_HANDLE_VALUE) {
+		pathArgc = i - 1;
+		AttributesPosixError(interp, objIndex, fileName, 0);
+		result = TCL_ERROR;
+		Tcl_DStringFree(&resultDString);
+		goto cleanup;
+	    }
+	    if (longShort) {
+		if (findData.cFileName[0] != '\0') {
+		    useLong = 1;
+		} else {
+		    useLong = 0;
+		}
+	    } else {
+		if (findData.cAlternateFileName[0] == '\0') {
+		    useLong = 1;
+		} else {
+		    useLong = 0;
+		}
+	    }
+	    if (useLong) {
+		currentElement = ckalloc(strlen(findData.cFileName) + 1);
+		strcpy(currentElement, findData.cFileName);
+	    } else {
+		currentElement = ckalloc(strlen(findData.cAlternateFileName) 
+			+ 1);
+		strcpy(currentElement, findData.cAlternateFileName);
+	    }
+	    Tcl_DStringFree(&resultDString);
+	    FindClose(findHandle);
+	}
+	newPathArgv[i] = currentElement;
+    }
+
+    Tcl_DStringInit(&resultDString);
+    resultStr = Tcl_JoinPath(pathArgc, newPathArgv, &resultDString);
+    *attributePtrPtr = Tcl_NewStringObj(resultStr, Tcl_DStringLength(&resultDString));
+    Tcl_DStringFree(&resultDString);
+
+cleanup:
+    for (i = 0; i < pathArgc; i++) {
+	ckfree(newPathArgv[i]);
+    }
+    ckfree((char *) newPathArgv);
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetWinFileLongName --
+ *
+ *      Returns a Tcl_Obj containing the short version of the file
+ *	name.
+ *
+ * Results:
+ *      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.
+ *
+ * Side effects:
+ *      A new object is allocated if the file is valid.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetWinFileLongName(
+    Tcl_Interp *interp,		    /* The interp we are using for errors. */
+    int objIndex,		    /* The index of the attribute. */
+    char *fileName,		    /* The name of the file. */
+    Tcl_Obj **attributePtrPtr)	    /* A pointer to return the object with. */
+{
+    return ConvertFileNameFormat(interp, objIndex, fileName, 1, attributePtrPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetWinFileShortName --
+ *
+ *      Returns a Tcl_Obj containing the short version of the file
+ *	name.
+ *
+ * Results:
+ *      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.
+ *
+ * Side effects:
+ *      A new object is allocated if the file is valid.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetWinFileShortName(
+    Tcl_Interp *interp,		    /* The interp we are using for errors. */
+    int objIndex,		    /* The index of the attribute. */
+    char *fileName,		    /* The name of the file. */
+    Tcl_Obj **attributePtrPtr)	    /* A pointer to return the object with. */
+{
+    return ConvertFileNameFormat(interp, objIndex, fileName, 0, attributePtrPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetWinFileAttributes --
+ *
+ *	Set the file attributes to the value given by attributePtr.
+ *	This routine sets the -hidden, -readonly, or -system attributes.
+ *
+ * Results:
+ *      Standard TCL error.
+ *
+ * Side effects:
+ *      The file's attribute is set.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetWinFileAttributes(
+    Tcl_Interp *interp,		    /* The interp we are using for errors. */
+    int objIndex,		    /* The index of the attribute. */
+    char *fileName,		    /* The name of the file. */
+    Tcl_Obj *attributePtr)	    /* The new value of the attribute. */
+{
+    DWORD fileAttributes = GetFileAttributes(fileName);
+    int yesNo;
+    int result;
+
+    if (fileAttributes == 0xFFFFFFFF) {
+	AttributesPosixError(interp, objIndex, fileName, 1);
+	return TCL_ERROR;
+    }
+
+    result = Tcl_GetBooleanFromObj(interp, attributePtr, &yesNo);
+    if (result != TCL_OK) {
+	return result;
+    }
+
+    if (yesNo) {
+	fileAttributes |= (attributeArray[objIndex]);
+    } else {
+	fileAttributes &= ~(attributeArray[objIndex]);
+    }
+
+    if (!SetFileAttributes(fileName, fileAttributes)) {
+	AttributesPosixError(interp, objIndex, fileName, 1);
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetWinFileLongName --
+ *
+ *	The attribute in question is a readonly attribute and cannot
+ *	be set.
+ *
+ * Results:
+ *      TCL_ERROR
+ *
+ * Side effects:
+ *      The object result is set to a pertinant error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CannotSetAttribute(
+    Tcl_Interp *interp,		    /* The interp we are using for errors. */
+    int objIndex,		    /* The index of the attribute. */
+    char *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", 
+	    (char *) NULL);
+    return TCL_ERROR;
+}
+
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpListVolumes --
+ *
+ *	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.
+ *
+ * Side effects:
+ *	None
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TclpListVolumes( 
+    Tcl_Interp *interp)    /* Interpreter to which to pass the volume list */
+{
+    Tcl_Obj *resultPtr, *elemPtr;
+    char buf[4];
+    int i;
+
+    resultPtr = Tcl_GetObjResult(interp);
+
+    buf[1] = ':';
+    buf[2] = '/';
+    buf[3] = '\0';
+
+    /*
+     * On Win32s: 
+     * GetLogicalDriveStrings() isn't implemented.
+     * GetLogicalDrives() returns incorrect information.
+     */
+
+    for (i = 0; i < 26; i++) {
+        buf[0] = (char) ('a' + i);
+	if (GetVolumeInformation(buf, NULL, 0, NULL, NULL, NULL, NULL, 0)  
+		|| (GetLastError() == ERROR_NOT_READY)) {
+	    elemPtr = Tcl_NewStringObj(buf, -1);
+	    Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr);
+	}
+    }
+    return TCL_OK;	
+}