Merge commit '05fa4c89f20e9769db0e6c0b429cef2590771ace' as 'tcl8.6'

1 files changed, 1968 insertions, 0 deletions

diff --git a/tcl8.6/win/tclWinFCmd.c b/tcl8.6/win/tclWinFCmd.c
new file mode 100644
index 0000000..52ea8c6
--- /dev/null
+++ b/tcl8.6/win/tclWinFCmd.c
@@ -0,0 +1,1968 @@
+/*
+ * tclWinFCmd.c
+ *
+ *	This file implements the Windows specific portion of file manipulation
+ *	subcommands of the "file" command.
+ *
+ * Copyright (c) 1996-1998 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#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 */
+#define DOTREE_LINK	4	/* symbolic link */
+
+/*
+ * Callbacks for file attributes code.
+ */
+
+static int		GetWinFileAttributes(Tcl_Interp *interp, int objIndex,
+			    Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr);
+static int		GetWinFileLongName(Tcl_Interp *interp, int objIndex,
+			    Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr);
+static int		GetWinFileShortName(Tcl_Interp *interp, int objIndex,
+			    Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr);
+static int		SetWinFileAttributes(Tcl_Interp *interp, int objIndex,
+			    Tcl_Obj *fileName, Tcl_Obj *attributePtr);
+static int		CannotSetAttribute(Tcl_Interp *interp, int objIndex,
+			    Tcl_Obj *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 const int attributeArray[] = {FILE_ATTRIBUTE_ARCHIVE, FILE_ATTRIBUTE_HIDDEN,
+	0, FILE_ATTRIBUTE_READONLY, 0, FILE_ATTRIBUTE_SYSTEM};
+
+
+const char *const 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)(const TCHAR *srcPtr, const TCHAR *dstPtr,
+	int type, Tcl_DString *errorPtr);
+
+/*
+ * Declarations for local functions defined in this file:
+ */
+
+static void		StatError(Tcl_Interp *interp, Tcl_Obj *fileName);
+static int		ConvertFileNameFormat(Tcl_Interp *interp,
+			    int objIndex, Tcl_Obj *fileName, int longShort,
+			    Tcl_Obj **attributePtrPtr);
+static int		DoCopyFile(const TCHAR *srcPtr, const TCHAR *dstPtr);
+static int		DoCreateDirectory(const TCHAR *pathPtr);
+static int		DoRemoveJustDirectory(const TCHAR *nativeSrc,
+			    int ignoreError, Tcl_DString *errorPtr);
+static int		DoRemoveDirectory(Tcl_DString *pathPtr, int recursive,
+			    Tcl_DString *errorPtr);
+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(const TCHAR *srcPtr,
+			    const TCHAR *dstPtr, int type,
+			    Tcl_DString *errorPtr);
+static int		TraverseWinTree(TraversalProc *traverseProc,
+			    Tcl_DString *sourcePtr, Tcl_DString *dstPtr,
+			    Tcl_DString *errorPtr);
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * 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 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 file or directory was successfully renamed, returns TCL_OK.
+ *	Otherwise the return value is TCL_ERROR and errno is set to indicate
+ *	the error. Some possible values for errno are:
+ *
+ *	ENAMETOOLONG: src or dst names are too long.
+ *	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
+TclpObjRenameFile(
+    Tcl_Obj *srcPathPtr,
+    Tcl_Obj *destPathPtr)
+{
+    return DoRenameFile(Tcl_FSGetNativePath(srcPathPtr),
+	    Tcl_FSGetNativePath(destPathPtr));
+}
+
+static int
+DoRenameFile(
+    const TCHAR *nativeSrc,	/* Pathname of file or dir to be renamed
+				 * (native). */
+    const TCHAR *nativeDst)	/* New pathname for file or directory
+				 * (native). */
+{
+#if defined(HAVE_NO_SEH) && !defined(_WIN64)
+    TCLEXCEPTION_REGISTRATION registration;
+#endif
+    DWORD srcAttr, dstAttr;
+    int retval = -1;
+
+    /*
+     * The MoveFile API acts differently under Win95/98 and NT WRT NULL and
+     * "". Avoid passing these values.
+     */
+
+    if (nativeSrc == NULL || nativeSrc[0] == '\0' ||
+	    nativeDst == NULL || nativeDst[0] == '\0') {
+	Tcl_SetErrno(ENOENT);
+	return TCL_ERROR;
+    }
+
+    /*
+     * The MoveFile API would throw an exception under NT if one of the
+     * arguments is a char block device.
+     */
+
+#if defined(HAVE_NO_SEH) && !defined(_WIN64)
+    /*
+     * Don't have SEH available, do things the hard way. Note that this needs
+     * to be one block of asm, to avoid stack imbalance; also, it is illegal
+     * for one asm block to contain a jump to another.
+     */
+
+    __asm__ __volatile__ (
+	/*
+	 * Pick up params before messing with the stack.
+	 */
+
+	"movl	    %[nativeDst],   %%ebx"	    "\n\t"
+	"movl	    %[nativeSrc],   %%ecx"	    "\n\t"
+
+	/*
+	 * Construct an TCLEXCEPTION_REGISTRATION to protect the call to
+	 * MoveFile.
+	 */
+
+	"leal	    %[registration], %%edx"	    "\n\t"
+	"movl	    %%fs:0,	    %%eax"	    "\n\t"
+	"movl	    %%eax,	    0x0(%%edx)"	    "\n\t" /* link */
+	"leal	    1f,		    %%eax"	    "\n\t"
+	"movl	    %%eax,	    0x4(%%edx)"	    "\n\t" /* handler */
+	"movl	    %%ebp,	    0x8(%%edx)"	    "\n\t" /* ebp */
+	"movl	    %%esp,	    0xc(%%edx)"	    "\n\t" /* esp */
+	"movl	    $0,		    0x10(%%edx)"    "\n\t" /* status */
+
+	/*
+	 * Link the TCLEXCEPTION_REGISTRATION on the chain.
+	 */
+
+	"movl	    %%edx,	    %%fs:0"	    "\n\t"
+
+	/*
+	 * Call MoveFile(nativeSrc, nativeDst)
+	 */
+
+	"pushl	    %%ebx"			    "\n\t"
+	"pushl	    %%ecx"			    "\n\t"
+	"movl	    %[moveFile],    %%eax"	    "\n\t"
+	"call	    *%%eax"			    "\n\t"
+
+	/*
+	 * Come here on normal exit. Recover the TCLEXCEPTION_REGISTRATION and
+	 * put the status return from MoveFile into it.
+	 */
+
+	"movl	    %%fs:0,	    %%edx"	    "\n\t"
+	"movl	    %%eax,	    0x10(%%edx)"    "\n\t"
+	"jmp	    2f"				    "\n"
+
+	/*
+	 * Come here on an exception. Recover the TCLEXCEPTION_REGISTRATION
+	 */
+
+	"1:"					    "\t"
+	"movl	    %%fs:0,	    %%edx"	    "\n\t"
+	"movl	    0x8(%%edx),	    %%edx"	    "\n\t"
+
+	/*
+	 * Come here however we exited. Restore context from the
+	 * TCLEXCEPTION_REGISTRATION in case the stack is unbalanced.
+	 */
+
+	"2:"					    "\t"
+	"movl	    0xc(%%edx),	    %%esp"	    "\n\t"
+	"movl	    0x8(%%edx),	    %%ebp"	    "\n\t"
+	"movl	    0x0(%%edx),	    %%eax"	    "\n\t"
+	"movl	    %%eax,	    %%fs:0"	    "\n\t"
+
+	:
+	/* No outputs */
+	:
+	[registration]	"m"	(registration),
+	[nativeDst]	"m"	(nativeDst),
+	[nativeSrc]	"m"	(nativeSrc),
+	[moveFile]	"r"	(MoveFile)
+	:
+	"%eax", "%ebx", "%ecx", "%edx", "memory"
+	);
+    if (registration.status != FALSE) {
+	retval = TCL_OK;
+    }
+#else
+#ifndef HAVE_NO_SEH
+    __try {
+#endif
+	if ((*MoveFile)(nativeSrc, nativeDst) != FALSE) {
+	    retval = TCL_OK;
+	}
+#ifndef HAVE_NO_SEH
+    } __except (EXCEPTION_EXECUTE_HANDLER) {}
+#endif
+#endif
+
+    if (retval != -1) {
+	return retval;
+    }
+
+    TclWinConvertError(GetLastError());
+
+    srcAttr = GetFileAttributes(nativeSrc);
+    dstAttr = GetFileAttributes(nativeDst);
+    if (srcAttr == 0xffffffff) {
+	if (GetFullPathName(nativeSrc, 0, NULL,
+		NULL) >= MAX_PATH) {
+	    errno = ENAMETOOLONG;
+	    return TCL_ERROR;
+	}
+	srcAttr = 0;
+    }
+    if (dstAttr == 0xffffffff) {
+	if (GetFullPathName(nativeDst, 0, NULL,
+		NULL) >= MAX_PATH) {
+	    errno = ENAMETOOLONG;
+	    return TCL_ERROR;
+	}
+	dstAttr = 0;
+    }
+
+    if (errno == EBADF) {
+	errno = EACCES;
+	return TCL_ERROR;
+    }
+    if (errno == EACCES) {
+    decode:
+	if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) {
+	    TCHAR *nativeSrcRest, *nativeDstRest;
+	    const char **srcArgv, **dstArgv;
+	    int size, srcArgc, dstArgc;
+	    TCHAR nativeSrcPath[MAX_PATH];
+	    TCHAR nativeDstPath[MAX_PATH];
+	    Tcl_DString srcString, dstString;
+	    const char *src, *dst;
+
+	    size = GetFullPathName(nativeSrc, MAX_PATH,
+		    nativeSrcPath, &nativeSrcRest);
+	    if ((size == 0) || (size > MAX_PATH)) {
+		return TCL_ERROR;
+	    }
+	    size = GetFullPathName(nativeDst, MAX_PATH,
+		    nativeDstPath, &nativeDstRest);
+	    if ((size == 0) || (size > MAX_PATH)) {
+		return TCL_ERROR;
+	    }
+	    CharLower(nativeSrcPath);
+	    CharLower(nativeDstPath);
+
+	    src = Tcl_WinTCharToUtf(nativeSrcPath, -1, &srcString);
+	    dst = Tcl_WinTCharToUtf(nativeDstPath, -1, &dstString);
+
+	    /*
+	     * Check whether the destination path is actually inside the
+	     * source path. This is true if the prefix matches, and the next
+	     * character is either end-of-string or a directory separator
+	     */
+
+	    if ((strncmp(src, dst, (size_t) Tcl_DStringLength(&srcString))==0)
+		    && (dst[Tcl_DStringLength(&srcString)] == '\\'
+		    || dst[Tcl_DStringLength(&srcString)] == '/'
+		    || dst[Tcl_DStringLength(&srcString)] == '\0')) {
+		/*
+		 * Trying to move a directory into itself.
+		 */
+
+		errno = EINVAL;
+		Tcl_DStringFree(&srcString);
+		Tcl_DStringFree(&dstString);
+		return TCL_ERROR;
+	    }
+	    Tcl_SplitPath(src, &srcArgc, &srcArgv);
+	    Tcl_SplitPath(dst, &dstArgc, &dstArgv);
+	    Tcl_DStringFree(&srcString);
+	    Tcl_DStringFree(&dstString);
+
+	    if (srcArgc == 1) {
+		/*
+		 * They are trying to move a root directory. Whether or not it
+		 * is across filesystems, this cannot be done.
+		 */
+
+		Tcl_SetErrno(EINVAL);
+	    } else if ((srcArgc > 0) && (dstArgc > 0) &&
+		    (strcmp(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.
+		 */
+
+		Tcl_SetErrno(EXDEV);
+	    }
+
+	    ckfree(srcArgv);
+	    ckfree(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 (Tcl_GetErrno() == 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 (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
+		     * directory back, for completeness.
+		     */
+
+		    if (MoveFile(nativeSrc,
+			    nativeDst) != FALSE) {
+			return TCL_OK;
+		    }
+
+		    /*
+		     * Some new error has occurred. Don't know what it could
+		     * be, but report this one.
+		     */
+
+		    TclWinConvertError(GetLastError());
+		    CreateDirectory(nativeDst, NULL);
+		    SetFileAttributes(nativeDst, dstAttr);
+		    if (Tcl_GetErrno() == EACCES) {
+			/*
+			 * Decode the EACCES to a more meaningful error.
+			 */
+
+			goto decode;
+		    }
+		}
+	    } else {	/* (dstAttr & FILE_ATTRIBUTE_DIRECTORY) == 0 */
+		Tcl_SetErrno(ENOTDIR);
+	    }
+	} else {    /* (srcAttr & FILE_ATTRIBUTE_DIRECTORY) == 0 */
+	    if (dstAttr & FILE_ATTRIBUTE_DIRECTORY) {
+		Tcl_SetErrno(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.
+		 */
+
+		TCHAR *nativeRest, *nativeTmp, *nativePrefix;
+		int result, size;
+		TCHAR tempBuf[MAX_PATH];
+
+		size = GetFullPathName(nativeDst, MAX_PATH,
+			tempBuf, &nativeRest);
+		if ((size == 0) || (size > MAX_PATH) || (nativeRest == NULL)) {
+		    return TCL_ERROR;
+		}
+		nativeTmp = (TCHAR *) tempBuf;
+		nativeRest[0] = L'\0';
+
+		result = TCL_ERROR;
+		nativePrefix = (TCHAR *) L"tclr";
+		if (GetTempFileName(nativeTmp, nativePrefix,
+			0, tempBuf) != 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.
+		     */
+
+		    nativeTmp = tempBuf;
+		    DeleteFile(nativeTmp);
+		    if (MoveFile(nativeDst, nativeTmp) != FALSE) {
+			if (MoveFile(nativeSrc, nativeDst) != FALSE) {
+			    SetFileAttributes(nativeTmp, FILE_ATTRIBUTE_NORMAL);
+			    DeleteFile(nativeTmp);
+			    return TCL_OK;
+			} else {
+			    DeleteFile(nativeDst);
+			    MoveFile(nativeTmp, nativeDst);
+			}
+		    }
+
+		    /*
+		     * Can't backup dst file or move src file. Return that
+		     * error. Could happen if an open file refers to dst.
+		     */
+
+		    TclWinConvertError(GetLastError());
+		    if (Tcl_GetErrno() == EACCES) {
+			/*
+			 * Decode the EACCES to a more meaningful error.
+			 */
+
+			goto decode;
+		    }
+		}
+		return result;
+	    }
+	}
+    }
+    return TCL_ERROR;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpObjCopyFile, DoCopyFile --
+ *
+ *	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
+TclpObjCopyFile(
+    Tcl_Obj *srcPathPtr,
+    Tcl_Obj *destPathPtr)
+{
+    return DoCopyFile(Tcl_FSGetNativePath(srcPathPtr),
+	    Tcl_FSGetNativePath(destPathPtr));
+}
+
+static int
+DoCopyFile(
+    const TCHAR *nativeSrc,	/* Pathname of file to be copied (native). */
+    const TCHAR *nativeDst)	/* Pathname of file to copy to (native). */
+{
+#if defined(HAVE_NO_SEH) && !defined(_WIN64)
+    TCLEXCEPTION_REGISTRATION registration;
+#endif
+    int retval = -1;
+
+    /*
+     * The CopyFile API acts differently under Win95/98 and NT WRT NULL and
+     * "". Avoid passing these values.
+     */
+
+    if (nativeSrc == NULL || nativeSrc[0] == '\0' ||
+	    nativeDst == NULL || nativeDst[0] == '\0') {
+	Tcl_SetErrno(ENOENT);
+	return TCL_ERROR;
+    }
+
+    /*
+     * The CopyFile API would throw an exception under NT if one of the
+     * arguments is a char block device.
+     */
+
+#if defined(HAVE_NO_SEH) && !defined(_WIN64)
+    /*
+     * Don't have SEH available, do things the hard way. Note that this needs
+     * to be one block of asm, to avoid stack imbalance; also, it is illegal
+     * for one asm block to contain a jump to another.
+     */
+
+    __asm__ __volatile__ (
+
+	/*
+	 * Pick up parameters before messing with the stack
+	 */
+
+	"movl	    %[nativeDst],   %%ebx"	    "\n\t"
+	"movl	    %[nativeSrc],   %%ecx"	    "\n\t"
+
+	/*
+	 * Construct an TCLEXCEPTION_REGISTRATION to protect the call to
+	 * CopyFile.
+	 */
+
+	"leal	    %[registration], %%edx"	    "\n\t"
+	"movl	    %%fs:0,	    %%eax"	    "\n\t"
+	"movl	    %%eax,	    0x0(%%edx)"	    "\n\t" /* link */
+	"leal	    1f,		    %%eax"	    "\n\t"
+	"movl	    %%eax,	    0x4(%%edx)"	    "\n\t" /* handler */
+	"movl	    %%ebp,	    0x8(%%edx)"	    "\n\t" /* ebp */
+	"movl	    %%esp,	    0xc(%%edx)"	    "\n\t" /* esp */
+	"movl	    $0,		    0x10(%%edx)"    "\n\t" /* status */
+
+	/*
+	 * Link the TCLEXCEPTION_REGISTRATION on the chain.
+	 */
+
+	"movl	    %%edx,	    %%fs:0"	    "\n\t"
+
+	/*
+	 * Call CopyFile(nativeSrc, nativeDst, 0)
+	 */
+
+	"movl	    %[copyFile],    %%eax"	    "\n\t"
+	"pushl	    $0"				    "\n\t"
+	"pushl	    %%ebx"			    "\n\t"
+	"pushl	    %%ecx"			    "\n\t"
+	"call	    *%%eax"			    "\n\t"
+
+	/*
+	 * Come here on normal exit. Recover the TCLEXCEPTION_REGISTRATION and
+	 * put the status return from CopyFile into it.
+	 */
+
+	"movl	    %%fs:0,	    %%edx"	    "\n\t"
+	"movl	    %%eax,	    0x10(%%edx)"    "\n\t"
+	"jmp	    2f"				    "\n"
+
+	/*
+	 * Come here on an exception. Recover the TCLEXCEPTION_REGISTRATION
+	 */
+
+	"1:"					    "\t"
+	"movl	    %%fs:0,	    %%edx"	    "\n\t"
+	"movl	    0x8(%%edx),	    %%edx"	    "\n\t"
+
+	/*
+	 * Come here however we exited. Restore context from the
+	 * TCLEXCEPTION_REGISTRATION in case the stack is unbalanced.
+	 */
+
+	"2:"					    "\t"
+	"movl	    0xc(%%edx),	    %%esp"	    "\n\t"
+	"movl	    0x8(%%edx),	    %%ebp"	    "\n\t"
+	"movl	    0x0(%%edx),	    %%eax"	    "\n\t"
+	"movl	    %%eax,	    %%fs:0"	    "\n\t"
+
+	:
+	/* No outputs */
+	:
+	[registration]	"m"	(registration),
+	[nativeDst]	"m"	(nativeDst),
+	[nativeSrc]	"m"	(nativeSrc),
+	[copyFile]	"r"	(CopyFile)
+	:
+	"%eax", "%ebx", "%ecx", "%edx", "memory"
+	);
+    if (registration.status != FALSE) {
+	retval = TCL_OK;
+    }
+#else
+#ifndef HAVE_NO_SEH
+    __try {
+#endif
+	if (CopyFile(nativeSrc, nativeDst, 0) != FALSE) {
+	    retval = TCL_OK;
+	}
+#ifndef HAVE_NO_SEH
+    } __except (EXCEPTION_EXECUTE_HANDLER) {}
+#endif
+#endif
+
+    if (retval != -1) {
+	return retval;
+    }
+
+    TclWinConvertError(GetLastError());
+    if (Tcl_GetErrno() == EBADF) {
+	Tcl_SetErrno(EACCES);
+	return TCL_ERROR;
+    }
+    if (Tcl_GetErrno() == EACCES) {
+	DWORD srcAttr, dstAttr;
+
+	srcAttr = GetFileAttributes(nativeSrc);
+	dstAttr = GetFileAttributes(nativeDst);
+	if (srcAttr != 0xffffffff) {
+	    if (dstAttr == 0xffffffff) {
+		dstAttr = 0;
+	    }
+	    if ((srcAttr & FILE_ATTRIBUTE_DIRECTORY) ||
+		    (dstAttr & FILE_ATTRIBUTE_DIRECTORY)) {
+		if (srcAttr & FILE_ATTRIBUTE_REPARSE_POINT) {
+		    /* Source is a symbolic link -- copy it */
+		    if (TclWinSymLinkCopyDirectory(nativeSrc, nativeDst)==0) {
+			return TCL_OK;
+		    }
+		}
+		Tcl_SetErrno(EISDIR);
+	    }
+	    if (dstAttr & FILE_ATTRIBUTE_READONLY) {
+		SetFileAttributes(nativeDst,
+			dstAttr & ~((DWORD)FILE_ATTRIBUTE_READONLY));
+		if (CopyFile(nativeSrc, nativeDst,
+			0) != FALSE) {
+		    return TCL_OK;
+		}
+
+		/*
+		 * Still can't copy onto dst. Return that error, and restore
+		 * attributes of dst.
+		 */
+
+		TclWinConvertError(GetLastError());
+		SetFileAttributes(nativeDst, dstAttr);
+	    }
+	}
+    }
+    return TCL_ERROR;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpObjDeleteFile, 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
+TclpObjDeleteFile(
+    Tcl_Obj *pathPtr)
+{
+    return TclpDeleteFile(Tcl_FSGetNativePath(pathPtr));
+}
+
+int
+TclpDeleteFile(
+    const void *nativePath)	/* Pathname of file to be removed (native). */
+{
+    DWORD attr;
+    const TCHAR *path = nativePath;
+
+    /*
+     * The DeleteFile API acts differently under Win95/98 and NT WRT NULL and
+     * "". Avoid passing these values.
+     */
+
+    if (path == NULL || path[0] == '\0') {
+	Tcl_SetErrno(ENOENT);
+	return TCL_ERROR;
+    }
+
+    if (DeleteFile(path) != FALSE) {
+	return TCL_OK;
+    }
+    TclWinConvertError(GetLastError());
+
+    if (Tcl_GetErrno() == EACCES) {
+	attr = GetFileAttributes(path);
+	if (attr != 0xffffffff) {
+	    if (attr & FILE_ATTRIBUTE_DIRECTORY) {
+		if (attr & FILE_ATTRIBUTE_REPARSE_POINT) {
+		    /*
+		     * It is a symbolic link - remove it.
+		     */
+		    if (TclWinSymLinkDelete(path, 0) == 0) {
+			return TCL_OK;
+		    }
+		}
+
+		/*
+		 * If we fall through here, it is a directory.
+		 *
+		 * Windows NT reports removing a directory as EACCES instead
+		 * of EISDIR.
+		 */
+
+		Tcl_SetErrno(EISDIR);
+	    } else if (attr & FILE_ATTRIBUTE_READONLY) {
+		int res = SetFileAttributes(path,
+			attr & ~((DWORD) FILE_ATTRIBUTE_READONLY));
+
+		if ((res != 0) &&
+			(DeleteFile(path) != FALSE)) {
+		    return TCL_OK;
+		}
+		TclWinConvertError(GetLastError());
+		if (res != 0) {
+		    SetFileAttributes(path, attr);
+		}
+	    }
+	}
+    } else if (Tcl_GetErrno() == ENOENT) {
+	attr = GetFileAttributes(path);
+	if (attr != 0xffffffff) {
+	    if (attr & FILE_ATTRIBUTE_DIRECTORY) {
+		/*
+		 * Windows 95 reports removing a directory as ENOENT instead
+		 * of EISDIR.
+		 */
+
+		Tcl_SetErrno(EISDIR);
+	    }
+	}
+    } else if (Tcl_GetErrno() == EINVAL) {
+	/*
+	 * Windows NT reports removing a char device as EINVAL instead of
+	 * EACCES.
+	 */
+
+	Tcl_SetErrno(EACCES);
+    }
+
+    return TCL_ERROR;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpObjCreateDirectory --
+ *
+ *	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
+TclpObjCreateDirectory(
+    Tcl_Obj *pathPtr)
+{
+    return DoCreateDirectory(Tcl_FSGetNativePath(pathPtr));
+}
+
+static int
+DoCreateDirectory(
+    const TCHAR *nativePath)	/* Pathname of directory to create (native). */
+{
+    if (CreateDirectory(nativePath, NULL) == 0) {
+	DWORD error = GetLastError();
+
+	TclWinConvertError(error);
+	return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpObjCopyDirectory --
+ *
+ *	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
+TclpObjCopyDirectory(
+    Tcl_Obj *srcPathPtr,
+    Tcl_Obj *destPathPtr,
+    Tcl_Obj **errorPtr)
+{
+    Tcl_DString ds;
+    Tcl_DString srcString, dstString;
+    Tcl_Obj *normSrcPtr, *normDestPtr;
+    int ret;
+
+    normSrcPtr = Tcl_FSGetNormalizedPath(NULL,srcPathPtr);
+    normDestPtr = Tcl_FSGetNormalizedPath(NULL,destPathPtr);
+    if ((normSrcPtr == NULL) || (normDestPtr == NULL)) {
+	return TCL_ERROR;
+    }
+
+    Tcl_WinUtfToTChar(Tcl_GetString(normSrcPtr), -1, &srcString);
+    Tcl_WinUtfToTChar(Tcl_GetString(normDestPtr), -1, &dstString);
+
+    ret = TraverseWinTree(TraversalCopy, &srcString, &dstString, &ds);
+
+    Tcl_DStringFree(&srcString);
+    Tcl_DStringFree(&dstString);
+
+    if (ret != TCL_OK) {
+	if (!strcmp(Tcl_DStringValue(&ds), TclGetString(normSrcPtr))) {
+	    *errorPtr = srcPathPtr;
+	} else if (!strcmp(Tcl_DStringValue(&ds), TclGetString(normDestPtr))) {
+	    *errorPtr = destPathPtr;
+	} else {
+	    *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
+	}
+	Tcl_DStringFree(&ds);
+	Tcl_IncrRefCount(*errorPtr);
+    }
+    return ret;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpObjRemoveDirectory, DoRemoveDirectory --
+ *
+ *	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
+TclpObjRemoveDirectory(
+    Tcl_Obj *pathPtr,
+    int recursive,
+    Tcl_Obj **errorPtr)
+{
+    Tcl_DString ds;
+    Tcl_Obj *normPtr = NULL;
+    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;
+	normPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
+	if (normPtr == NULL) {
+	    return TCL_ERROR;
+	}
+	Tcl_WinUtfToTChar(Tcl_GetString(normPtr), -1, &native);
+	ret = DoRemoveDirectory(&native, recursive, &ds);
+	Tcl_DStringFree(&native);
+    } else {
+	ret = DoRemoveJustDirectory(Tcl_FSGetNativePath(pathPtr), 0, &ds);
+    }
+
+    if (ret != TCL_OK) {
+	if (Tcl_DStringLength(&ds) > 0) {
+	    if (normPtr != NULL &&
+		    !strcmp(Tcl_DStringValue(&ds), TclGetString(normPtr))) {
+		*errorPtr = pathPtr;
+	    } else {
+		*errorPtr = TclDStringToObj(&ds);
+	    }
+	    Tcl_IncrRefCount(*errorPtr);
+	}
+	Tcl_DStringFree(&ds);
+    }
+
+    return ret;
+}
+
+static int
+DoRemoveJustDirectory(
+    const TCHAR *nativePath,	/* Pathname of directory to be removed
+				 * (native). */
+    int ignoreError,		/* 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. */
+{
+    DWORD attr;
+
+    /*
+     * The RemoveDirectory API acts differently under Win95/98 and NT WRT NULL
+     * and "". Avoid passing these values.
+     */
+
+    if (nativePath == NULL || nativePath[0] == '\0') {
+	Tcl_SetErrno(ENOENT);
+	goto end;
+    }
+
+    attr = GetFileAttributes(nativePath);
+
+    if (attr & FILE_ATTRIBUTE_REPARSE_POINT) {
+	/*
+	 * It is a symbolic link - remove it.
+	 */
+	if (TclWinSymLinkDelete(nativePath, 0) == 0) {
+	    return TCL_OK;
+	}
+    } else {
+	/*
+	 * Ordinary directory.
+	 */
+
+	if (RemoveDirectory(nativePath) != FALSE) {
+	    return TCL_OK;
+	}
+    }
+
+    TclWinConvertError(GetLastError());
+
+    if (Tcl_GetErrno() == EACCES) {
+	attr = GetFileAttributes(nativePath);
+	if (attr != 0xffffffff) {
+	    if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
+		/*
+		 * Windows 95 reports calling RemoveDirectory on a file as an
+		 * EACCES, not an ENOTDIR.
+		 */
+
+		Tcl_SetErrno(ENOTDIR);
+		goto end;
+	    }
+
+	    if (attr & FILE_ATTRIBUTE_REPARSE_POINT) {
+		/*
+		 * It is a symbolic link - remove it.
+		 */
+
+		if (TclWinSymLinkDelete(nativePath, 1) != 0) {
+		    goto end;
+		}
+	    }
+
+	    if (attr & FILE_ATTRIBUTE_READONLY) {
+		attr &= ~FILE_ATTRIBUTE_READONLY;
+		if (SetFileAttributes(nativePath,
+			attr) == FALSE) {
+		    goto end;
+		}
+		if (RemoveDirectory(nativePath) != FALSE) {
+		    return TCL_OK;
+		}
+		TclWinConvertError(GetLastError());
+		SetFileAttributes(nativePath,
+			attr | FILE_ATTRIBUTE_READONLY);
+	    }
+	}
+    }
+
+    if (Tcl_GetErrno() == ENOTEMPTY) {
+	/*
+	 * The caller depends on EEXIST to signify that the directory is not
+	 * empty, not ENOTEMPTY.
+	 */
+
+	Tcl_SetErrno(EEXIST);
+    }
+
+    if ((ignoreError != 0) && (Tcl_GetErrno() == EEXIST)) {
+	/*
+	 * If we're being recursive, this error may actually be ok, so we
+	 * don't want to initialise the errorPtr yet.
+	 */
+	return TCL_ERROR;
+    }
+
+  end:
+    if (errorPtr != NULL) {
+	char *p;
+	Tcl_WinTCharToUtf(nativePath, -1, errorPtr);
+	p = Tcl_DStringValue(errorPtr);
+	for (; *p; ++p) {
+	    if (*p == '\\') *p = '/';
+	}
+    }
+    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((const TCHAR *)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;
+    }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * 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 (native). */
+    Tcl_DString *targetPtr,	/* Pathname of directory to traverse in
+				 * 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, *nativeTarget, *nativeErrfile;
+    int result, found, sourceLen, targetLen = 0, oldSourceLen, oldTargetLen;
+    HANDLE handle;
+    WIN32_FIND_DATA data;
+
+    nativeErrfile = NULL;
+    result = TCL_OK;
+    oldTargetLen = 0;		/* lint. */
+
+    nativeSource = (TCHAR *) Tcl_DStringValue(sourcePtr);
+    nativeTarget = (TCHAR *)
+	    (targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr));
+
+    oldSourceLen = Tcl_DStringLength(sourcePtr);
+    sourceAttr = GetFileAttributes(nativeSource);
+    if (sourceAttr == 0xffffffff) {
+	nativeErrfile = nativeSource;
+	goto end;
+    }
+
+    if (sourceAttr & FILE_ATTRIBUTE_REPARSE_POINT) {
+	/*
+	 * Process the symbolic link
+	 */
+
+	return traverseProc(nativeSource, nativeTarget, DOTREE_LINK,
+		errorPtr);
+    }
+
+    if ((sourceAttr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
+	/*
+	 * Process the regular file
+	 */
+
+	return traverseProc(nativeSource, nativeTarget, DOTREE_F, errorPtr);
+    }
+
+    Tcl_DStringAppend(sourcePtr, (char *) TEXT("\\*.*"), 4 * sizeof(TCHAR) + 1);
+    Tcl_DStringSetLength(sourcePtr, Tcl_DStringLength(sourcePtr) - 1);
+
+    nativeSource = (TCHAR *) Tcl_DStringValue(sourcePtr);
+    handle = FindFirstFile(nativeSource, &data);
+    if (handle == INVALID_HANDLE_VALUE) {
+	/*
+	 * Can't read directory.
+	 */
+
+	TclWinConvertError(GetLastError());
+	nativeErrfile = nativeSource;
+	goto end;
+    }
+
+    Tcl_DStringSetLength(sourcePtr, oldSourceLen + 1);
+    Tcl_DStringSetLength(sourcePtr, oldSourceLen);
+    result = traverseProc(nativeSource, nativeTarget, DOTREE_PRED,
+	    errorPtr);
+    if (result != TCL_OK) {
+	FindClose(handle);
+	return result;
+    }
+
+    sourceLen = oldSourceLen + sizeof(TCHAR);
+    Tcl_DStringAppend(sourcePtr, (char *) TEXT("\\"), sizeof(TCHAR) + 1);
+    Tcl_DStringSetLength(sourcePtr, sourceLen);
+    if (targetPtr != NULL) {
+	oldTargetLen = Tcl_DStringLength(targetPtr);
+
+	targetLen = oldTargetLen;
+	targetLen += sizeof(TCHAR);
+	Tcl_DStringAppend(targetPtr, (char *) TEXT("\\"), sizeof(TCHAR) + 1);
+	Tcl_DStringSetLength(targetPtr, targetLen);
+    }
+
+    found = 1;
+    for (; found; found = FindNextFile(handle, &data)) {
+	TCHAR *nativeName;
+	int len;
+
+	TCHAR *wp = data.cFileName;
+	if (*wp == '.') {
+	    wp++;
+	    if (*wp == '.') {
+		wp++;
+	    }
+	    if (*wp == '\0') {
+		continue;
+	    }
+	}
+	nativeName = (TCHAR *) data.cFileName;
+	len = _tcslen(data.cFileName) * sizeof(TCHAR);
+
+	/*
+	 * Append name after slash, and recurse on the file.
+	 */
+
+	Tcl_DStringAppend(sourcePtr, (char *) nativeName, len + 1);
+	Tcl_DStringSetLength(sourcePtr, Tcl_DStringLength(sourcePtr) - 1);
+	if (targetPtr != NULL) {
+	    Tcl_DStringAppend(targetPtr, (char *) nativeName, len + 1);
+	    Tcl_DStringSetLength(targetPtr, Tcl_DStringLength(targetPtr) - 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);
+	}
+    }
+    FindClose(handle);
+
+    /*
+     * Strip off the trailing slash we added.
+     */
+
+    Tcl_DStringSetLength(sourcePtr, oldSourceLen + 1);
+    Tcl_DStringSetLength(sourcePtr, oldSourceLen);
+    if (targetPtr != NULL) {
+	Tcl_DStringSetLength(targetPtr, oldTargetLen + 1);
+	Tcl_DStringSetLength(targetPtr, oldTargetLen);
+    }
+    if (result == TCL_OK) {
+	/*
+	 * Call traverseProc() on a directory after visiting all the
+	 * files in that directory.
+	 */
+
+	result = traverseProc((const TCHAR *)Tcl_DStringValue(sourcePtr),
+		(const TCHAR *)(targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr)),
+		DOTREE_POSTD, errorPtr);
+    }
+
+  end:
+    if (nativeErrfile != NULL) {
+	TclWinConvertError(GetLastError());
+	if (errorPtr != NULL) {
+	    Tcl_WinTCharToUtf(nativeErrfile, -1, errorPtr);
+	}
+	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(
+    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. */
+{
+    switch (type) {
+    case DOTREE_F:
+	if (DoCopyFile(nativeSrc, nativeDst) == TCL_OK) {
+	    return TCL_OK;
+	}
+	break;
+    case DOTREE_LINK:
+	if (TclWinSymLinkCopyDirectory(nativeSrc, nativeDst) == TCL_OK) {
+	    return TCL_OK;
+	}
+	break;
+    case DOTREE_PRED:
+	if (DoCreateDirectory(nativeDst) == TCL_OK) {
+	    DWORD attr = GetFileAttributes(nativeSrc);
+
+	    if (SetFileAttributes(nativeDst,
+		    attr) != 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_WinTCharToUtf(nativeDst, -1, errorPtr);
+    }
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TraversalDelete --
+ *
+ *	Called by function TraverseWinTree for every file and directory that
+ *	it encounters in a directory hierarchy. This function 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(
+    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. */
+{
+    switch (type) {
+    case DOTREE_F:
+	if (TclpDeleteFile(nativeSrc) == TCL_OK) {
+	    return TCL_OK;
+	}
+	break;
+    case DOTREE_LINK:
+	if (DoRemoveJustDirectory(nativeSrc, 0, NULL) == TCL_OK) {
+	    return TCL_OK;
+	}
+	break;
+    case DOTREE_PRED:
+	return TCL_OK;
+    case DOTREE_POSTD:
+	if (DoRemoveJustDirectory(nativeSrc, 0, NULL) == TCL_OK) {
+	    return TCL_OK;
+	}
+	break;
+    }
+
+    if (errorPtr != NULL) {
+	Tcl_WinTCharToUtf(nativeSrc, -1, errorPtr);
+    }
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StatError --
+ *
+ *	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
+StatError(
+    Tcl_Interp *interp,		/* The interp that has the error */
+    Tcl_Obj *fileName)		/* The name of the file which caused the
+				 * error. */
+{
+    TclWinConvertError(GetLastError());
+    Tcl_SetObjResult(interp, Tcl_ObjPrintf("could not read \"%s\": %s",
+	    TclGetString(fileName), Tcl_PosixError(interp)));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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. */
+    Tcl_Obj *fileName,		/* The name of the file. */
+    Tcl_Obj **attributePtrPtr)	/* A pointer to return the object with. */
+{
+    DWORD result;
+    const TCHAR *nativeName;
+    int attr;
+
+    nativeName = Tcl_FSGetNativePath(fileName);
+    result = GetFileAttributes(nativeName);
+
+    if (result == 0xffffffff) {
+	StatError(interp, fileName);
+	return TCL_ERROR;
+    }
+
+    attr = (int)(result & attributeArray[objIndex]);
+    if ((objIndex == WIN_HIDDEN_ATTRIBUTE) && (attr != 0)) {
+	/*
+	 * It is hidden. However there is a bug on some Windows OSes in which
+	 * root volumes (drives) formatted as NTFS are declared hidden when
+	 * they are not (and cannot be).
+	 *
+	 * We test for, and fix that case, here.
+	 */
+
+	int len;
+	const char *str = Tcl_GetStringFromObj(fileName,&len);
+
+	if (len < 4) {
+	    if (len == 0) {
+		/*
+		 * Not sure if this is possible, but we pass it on anyway.
+		 */
+	    } else if (len == 1 && (str[0] == '/' || str[0] == '\\')) {
+		/*
+		 * Path is pointing to the root volume.
+		 */
+
+		attr = 0;
+	    } else if ((str[1] == ':')
+		    && (len == 2 || (str[2] == '/' || str[2] == '\\'))) {
+		/*
+		 * Path is of the form 'x:' or 'x:/' or 'x:\'
+		 */
+
+		attr = 0;
+	    }
+	}
+    }
+
+    *attributePtrPtr = Tcl_NewBooleanObj(attr);
+    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.
+ *
+ *	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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConvertFileNameFormat(
+    Tcl_Interp *interp,		/* The interp we are using for errors. */
+    int objIndex,		/* The index of the attribute. */
+    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;
+    Tcl_Obj *splitPath;
+
+    splitPath = Tcl_FSSplitPath(fileName, &pathc);
+
+    if (splitPath == NULL || pathc == 0) {
+	if (interp != NULL) {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "could not read \"%s\": no such file or directory",
+		    Tcl_GetString(fileName)));
+	    errno = ENOENT;
+	    Tcl_PosixError(interp);
+	}
+	goto cleanup;
+    }
+
+    /*
+     * We will decrement this again at the end.	 It is safer to do this in
+     * case any of the calls below retain a reference to splitPath.
+     */
+
+    Tcl_IncrRefCount(splitPath);
+
+    for (i = 0; i < pathc; i++) {
+	Tcl_Obj *elt;
+	char *pathv;
+	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, just
+	     * because it looks better under Windows to do so.
+	     */
+
+	simple:
+	    /*
+	     * 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 {
+	    Tcl_Obj *tempPath;
+	    Tcl_DString ds;
+	    Tcl_DString dsTemp;
+	    const TCHAR *nativeName;
+	    const char *tempString;
+	    int tempLen;
+	    WIN32_FIND_DATA data;
+	    HANDLE handle;
+	    DWORD attr;
+
+	    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);
+	    nativeName = Tcl_WinUtfToTChar(tempString, tempLen, &ds);
+	    Tcl_DecrRefCount(tempPath);
+	    handle = FindFirstFile(nativeName, &data);
+	    if (handle == INVALID_HANDLE_VALUE) {
+		/*
+		 * FindFirstFile() doesn't like root directories. We would
+		 * only get a root directory here if the caller specified "c:"
+		 * or "c:." and the current directory on the drive was the
+		 * root directory
+		 */
+
+		attr = GetFileAttributes(nativeName);
+		if ((attr!=0xFFFFFFFF) && (attr & FILE_ATTRIBUTE_DIRECTORY)) {
+		    Tcl_DStringFree(&ds);
+		    goto simple;
+		}
+	    }
+
+	    if (handle == INVALID_HANDLE_VALUE) {
+		Tcl_DStringFree(&ds);
+		if (interp != NULL) {
+		    StatError(interp, fileName);
+		}
+		goto cleanup;
+	    }
+	    nativeName = data.cAlternateFileName;
+	    if (longShort) {
+		if (data.cFileName[0] != '\0') {
+		    nativeName = data.cFileName;
+		}
+	    } else {
+		if (data.cAlternateFileName[0] == '\0') {
+		    nativeName = (TCHAR *) data.cFileName;
+		}
+	    }
+
+	    /*
+	     * Purify reports a extraneous UMR in Tcl_WinTCharToUtf() trying
+	     * to dereference nativeName as a Unicode string. I have proven to
+	     * myself that purify is wrong by running the following example
+	     * when nativeName == data.w.cAlternateFileName and noting that
+	     * purify doesn't complain about the first line, but does complain
+	     * about the second.
+	     *
+	     *	fprintf(stderr, "%d\n", data.w.cAlternateFileName[0]);
+	     *	fprintf(stderr, "%d\n", ((WCHAR *) nativeName)[0]);
+	     */
+
+	    Tcl_DStringInit(&dsTemp);
+	    Tcl_WinTCharToUtf(nativeName, -1, &dsTemp);
+	    Tcl_DStringFree(&ds);
+
+	    /*
+	     * Deal with issues of tildes being absolute.
+	     */
+
+	    if (Tcl_DStringValue(&dsTemp)[0] == '~') {
+		TclNewLiteralStringObj(tempPath, "./");
+		Tcl_AppendToObj(tempPath, Tcl_DStringValue(&dsTemp),
+			Tcl_DStringLength(&dsTemp));
+		Tcl_DStringFree(&dsTemp);
+	    } else {
+		tempPath = TclDStringToObj(&dsTemp);
+	    }
+	    Tcl_ListObjReplace(NULL, splitPath, i, 1, 1, &tempPath);
+	    FindClose(handle);
+	}
+    }
+
+    *attributePtrPtr = Tcl_FSJoinPath(splitPath, -1);
+
+    if (splitPath != NULL) {
+	/*
+	 * Unfortunately, the object we will return may have its only refCount
+	 * as part of the list splitPath. This means if we free splitPath, the
+	 * object will disappear. So, we have to be very careful here.
+	 * Unfortunately this means we must manipulate the object's refCount
+	 * directly.
+	 */
+
+	Tcl_IncrRefCount(*attributePtrPtr);
+	Tcl_DecrRefCount(splitPath);
+	--(*attributePtrPtr)->refCount;
+    }
+    return TCL_OK;
+
+  cleanup:
+    if (splitPath != NULL) {
+	Tcl_DecrRefCount(splitPath);
+    }
+
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetWinFileLongName --
+ *
+ *	Returns a Tcl_Obj containing the long 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. */
+    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);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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. */
+    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);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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. */
+    Tcl_Obj *fileName,		/* The name of the file. */
+    Tcl_Obj *attributePtr)	/* The new value of the attribute. */
+{
+    DWORD fileAttributes, old;
+    int yesNo, result;
+    const TCHAR *nativeName;
+
+    nativeName = Tcl_FSGetNativePath(fileName);
+    fileAttributes = old = GetFileAttributes(nativeName);
+
+    if (fileAttributes == 0xffffffff) {
+	StatError(interp, fileName);
+	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 ((fileAttributes != old)
+	    && !SetFileAttributes(nativeName, fileAttributes)) {
+	StatError(interp, fileName);
+	return TCL_ERROR;
+    }
+
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 pertinent error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CannotSetAttribute(
+    Tcl_Interp *interp,		/* The interp we are using for errors. */
+    int objIndex,		/* The index of the attribute. */
+    Tcl_Obj *fileName,		/* The name of the file. */
+    Tcl_Obj *attributePtr)	/* The new value of the attribute. */
+{
+    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+	    "cannot set attribute \"%s\" for file \"%s\": attribute is readonly",
+	    tclpFileAttrStrings[objIndex], Tcl_GetString(fileName)));
+    errno = EINVAL;
+    Tcl_PosixError(interp);
+    return TCL_ERROR;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpObjListVolumes --
+ *
+ *	Lists the currently mounted volumes
+ *
+ * Results:
+ *	The list of volumes.
+ *
+ * Side effects:
+ *	None
+ *
+ *---------------------------------------------------------------------------
+ */
+
+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_NewObj();
+
+    /*
+     * On Win32s:
+     * GetLogicalDriveStrings() isn't implemented.
+     * GetLogicalDrives() returns incorrect information.
+     */
+
+    if (GetLogicalDriveStringsA(sizeof(buf), buf) == 0) {
+	/*
+	 * GetVolumeInformation() will detects all drives, but causes
+	 * chattering on empty floppy drives. We only do this if
+	 * GetLogicalDriveStrings() didn't work. It has also been reported
+	 * that on some laptops it takes a while for GetVolumeInformation() to
+	 * return when pinging an empty floppy drive, another reason to try to
+	 * avoid calling it.
+	 */
+
+	buf[1] = ':';
+	buf[2] = '/';
+	buf[3] = '\0';
+
+	for (i = 0; i < 26; i++) {
+	    buf[0] = (char) ('a' + i);
+	    if (GetVolumeInformationA(buf, NULL, 0, NULL, NULL, NULL, NULL, 0)
+		    || (GetLastError() == ERROR_NOT_READY)) {
+		elemPtr = Tcl_NewStringObj(buf, -1);
+		Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr);
+	    }
+	}
+    } else {
+	for (p = buf; *p != '\0'; p += 4) {
+	    p[2] = '/';
+	    elemPtr = Tcl_NewStringObj(p, -1);
+	    Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr);
+	}
+    }
+
+    Tcl_IncrRefCount(resultPtr);
+    return resultPtr;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */