/*
 * 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.
 *
 * RCS: @(#) $Id: tclWinFCmd.c,v 1.16 2001/11/19 17:45:12 vincentdarley Exp $
 */

#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, Tcl_Obj *fileName,
			    Tcl_Obj **attributePtrPtr));
static int		GetWinFileLongName _ANSI_ARGS_((Tcl_Interp *interp,
			    int objIndex, Tcl_Obj *fileName,
			    Tcl_Obj **attributePtrPtr));
static int		GetWinFileShortName _ANSI_ARGS_((Tcl_Interp *interp,
			    int objIndex, Tcl_Obj *fileName,
			    Tcl_Obj **attributePtrPtr));
static int		SetWinFileAttributes _ANSI_ARGS_((Tcl_Interp *interp,
			    int objIndex, Tcl_Obj *fileName,
			    Tcl_Obj *attributePtr));
static int		CannotSetAttribute _ANSI_ARGS_((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 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)(CONST TCHAR *srcPtr, CONST TCHAR *dstPtr, 
	int type, Tcl_DString *errorPtr);

/*
 * Declarations for local procedures defined in this file:
 */

static void		StatError(Tcl_Interp *interp, 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		DoDeleteFile(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(srcPathPtr, destPathPtr)
    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). */
{    
    DWORD srcAttr, dstAttr;

    /*
     * Would throw an exception under NT if one of the arguments is a 
     * char block device.
     */

    __try {
	if ((*tclWinProcs->moveFileProc)(nativeSrc, nativeDst) != FALSE) {
	    return TCL_OK;
	}
    } __except (-1) {}

    TclWinConvertError(GetLastError());

    srcAttr = (*tclWinProcs->getFileAttributesProc)(nativeSrc);
    dstAttr = (*tclWinProcs->getFileAttributesProc)(nativeDst);
    if (srcAttr == 0xffffffff) {
	if ((*tclWinProcs->getFullPathNameProc)(nativeSrc, 0, NULL, NULL) >= MAX_PATH) {
	    errno = ENAMETOOLONG;
	    return TCL_ERROR;
	}
	srcAttr = 0;
    }
    if (dstAttr == 0xffffffff) {
	if ((*tclWinProcs->getFullPathNameProc)(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;
	    char **srcArgv, **dstArgv;
	    int size, srcArgc, dstArgc;
	    WCHAR nativeSrcPath[MAX_PATH];
	    WCHAR nativeDstPath[MAX_PATH];
	    Tcl_DString srcString, dstString;
	    CONST char *src, *dst;

	    size = (*tclWinProcs->getFullPathNameProc)(nativeSrc, MAX_PATH, 
		    nativeSrcPath, &nativeSrcRest);
	    if ((size == 0) || (size > MAX_PATH)) {
		return TCL_ERROR;
	    }
	    size = (*tclWinProcs->getFullPathNameProc)(nativeDst, MAX_PATH, 
		    nativeDstPath, &nativeDstRest);
	    if ((size == 0) || (size > MAX_PATH)) {
		return TCL_ERROR;
	    }
	    (*tclWinProcs->charLowerProc)((TCHAR *) nativeSrcPath);
	    (*tclWinProcs->charLowerProc)((TCHAR *) nativeDstPath);

	    src = Tcl_WinTCharToUtf((TCHAR *) nativeSrcPath, -1, &srcString);
	    dst = Tcl_WinTCharToUtf((TCHAR *) nativeDstPath, -1, &dstString);
	    if (strncmp(src, dst, (size_t) 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((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 (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 ((*tclWinProcs->moveFileProc)(nativeSrc, nativeDst) != FALSE) {
			return TCL_OK;
		    }

		    /*
		     * Some new error has occurred.  Don't know what it
		     * could be, but report this one.
		     */

		    TclWinConvertError(GetLastError());
		    (*tclWinProcs->createDirectoryProc)(nativeDst, NULL);
		    (*tclWinProcs->setFileAttributesProc)(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;
		WCHAR tempBuf[MAX_PATH];
		
		size = (*tclWinProcs->getFullPathNameProc)(nativeDst, MAX_PATH, 
			tempBuf, &nativeRest);
		if ((size == 0) || (size > MAX_PATH) || (nativeRest == NULL)) {
		    return TCL_ERROR;
		}
		nativeTmp = (TCHAR *) tempBuf;
		((char *) nativeRest)[0] = '\0';
		((char *) nativeRest)[1] = '\0';    /* In case it's Unicode. */

		result = TCL_ERROR;
		nativePrefix = (tclWinProcs->useWide) 
			? (TCHAR *) L"tclr" : (TCHAR *) "tclr";
		if ((*tclWinProcs->getTempFileNameProc)(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 = (TCHAR *) tempBuf;
		    (*tclWinProcs->deleteFileProc)(nativeTmp);
		    if ((*tclWinProcs->moveFileProc)(nativeDst, nativeTmp) != FALSE) {
			if ((*tclWinProcs->moveFileProc)(nativeSrc, nativeDst) != FALSE) {
			    (*tclWinProcs->setFileAttributesProc)(nativeTmp, 
				    FILE_ATTRIBUTE_NORMAL);
			    (*tclWinProcs->deleteFileProc)(nativeTmp);
			    return TCL_OK;
			} else {
			    (*tclWinProcs->deleteFileProc)(nativeDst);
			    (*tclWinProcs->moveFileProc)(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(srcPathPtr, destPathPtr)
    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). */
{
    /*
     * Would throw an exception under NT if one of the arguments is a char
     * block device.
     */

    /* 
     * If 'nativeDst' is NULL, the following code can lock the process
     * up, at least under Windows2000.  Therefore we have to bail at
     * that point.
     */
    if (nativeDst == NULL) {
	Tcl_SetErrno(ENOENT);
        return TCL_ERROR;
    }
    
    /*
     * Similarly, if 'nativeSrc' is NULL or empty, the following code
     * locks up the process on WinNT; bail out.
     */
    
    if (nativeSrc == NULL || nativeSrc[0] == '\0') {
	Tcl_SetErrno(ENOENT);
	return TCL_ERROR;
    }
    
    /*
     * OK, now try the copy.
     */
    
    __try {
	if ((*tclWinProcs->copyFileProc)(nativeSrc, nativeDst, 0) != FALSE) {
	    return TCL_OK;
	}
    } __except (-1) {}

    TclWinConvertError(GetLastError());
    if (Tcl_GetErrno() == EBADF) {
	Tcl_SetErrno(EACCES);
	return TCL_ERROR;
    }
    if (Tcl_GetErrno() == EACCES) {
	DWORD srcAttr, dstAttr;

	srcAttr = (*tclWinProcs->getFileAttributesProc)(nativeSrc);
	dstAttr = (*tclWinProcs->getFileAttributesProc)(nativeDst);
	if (srcAttr != 0xffffffff) {
	    if (dstAttr == 0xffffffff) {
		dstAttr = 0;
	    }
	    if ((srcAttr & FILE_ATTRIBUTE_DIRECTORY) ||
		    (dstAttr & FILE_ATTRIBUTE_DIRECTORY)) {
		Tcl_SetErrno(EISDIR);
	    }
	    if (dstAttr & FILE_ATTRIBUTE_READONLY) {
		(*tclWinProcs->setFileAttributesProc)(nativeDst, 
			dstAttr & ~FILE_ATTRIBUTE_READONLY);
		if ((*tclWinProcs->copyFileProc)(nativeSrc, nativeDst, 0) != FALSE) {
		    return TCL_OK;
		}
		/*
		 * Still can't copy onto dst.  Return that error, and
		 * restore attributes of dst.
		 */

		TclWinConvertError(GetLastError());
		(*tclWinProcs->setFileAttributesProc)(nativeDst, dstAttr);
	    }
	}
    }
    return TCL_ERROR;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpObjDeleteFile, DoDeleteFile --
 *
 *      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(pathPtr)
    Tcl_Obj *pathPtr;
{
    return DoDeleteFile(Tcl_FSGetNativePath(pathPtr));
}

static int
DoDeleteFile(
    CONST TCHAR *nativePath)	/* Pathname of file to be removed (native). */
{
    DWORD attr;
    
    if ((*tclWinProcs->deleteFileProc)(nativePath) != FALSE) {
	return TCL_OK;
    }
    TclWinConvertError(GetLastError());

    /*
     * Win32s thinks that "" is the same as "." and then reports EISDIR
     * instead of ENOENT.
     */

    if (nativePath == NULL) {
	Tcl_SetErrno(ENOENT);
	return TCL_ERROR;
    }
        
    if (tclWinProcs->useWide) {
	if (((WCHAR *) nativePath)[0] == '\0') {
	    Tcl_SetErrno(ENOENT);
	    return TCL_ERROR;
	}
    } else {
	if (((char *) nativePath)[0] == '\0') {
	    Tcl_SetErrno(ENOENT);
	    return TCL_ERROR;
	}
    }
    if (Tcl_GetErrno() == EACCES) {
        attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
	if (attr != 0xffffffff) {
	    if (attr & FILE_ATTRIBUTE_DIRECTORY) {
		/*
		 * Windows NT reports removing a directory as EACCES instead
		 * of EISDIR.
		 */

		Tcl_SetErrno(EISDIR);
	    } else if (attr & FILE_ATTRIBUTE_READONLY) {
		(*tclWinProcs->setFileAttributesProc)(nativePath, 
			attr & ~FILE_ATTRIBUTE_READONLY);
		if ((*tclWinProcs->deleteFileProc)(nativePath) != FALSE) {
		    return TCL_OK;
		}
		TclWinConvertError(GetLastError());
		(*tclWinProcs->setFileAttributesProc)(nativePath, attr);
	    }
	}
    } else if (Tcl_GetErrno() == ENOENT) {
        attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
	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(pathPtr)
    Tcl_Obj *pathPtr;
{
    return DoCreateDirectory(Tcl_FSGetNativePath(pathPtr));
}

static int
DoCreateDirectory(
    CONST TCHAR *nativePath)	/* Pathname of directory to create (native). */
{
    DWORD error;
    if ((*tclWinProcs->createDirectoryProc)(nativePath, NULL) == 0) {
	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(srcPathPtr, destPathPtr, errorPtr)
    Tcl_Obj *srcPathPtr;
    Tcl_Obj *destPathPtr;
    Tcl_Obj **errorPtr;
{
    Tcl_DString ds;
    Tcl_DString srcString, dstString;
    int ret;

    Tcl_WinUtfToTChar(Tcl_FSGetTranslatedStringPath(NULL,srcPathPtr), 
		      -1, &srcString);
    Tcl_WinUtfToTChar(Tcl_FSGetTranslatedStringPath(NULL,destPathPtr), 
		      -1, &dstString);

    ret = TraverseWinTree(TraversalCopy, &srcString, &dstString, &ds);

    Tcl_DStringFree(&srcString);
    Tcl_DStringFree(&dstString);

    if (ret != TCL_OK) {
	*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(pathPtr, recursive, errorPtr)
    Tcl_Obj *pathPtr;
    int recursive;
    Tcl_Obj **errorPtr;
{
    Tcl_DString ds;
    int ret;
    if (recursive) {
	/* 
	 * In the recursive case, the string rep is used to construct a
	 * Tcl_DString which may be used extensively, so we can't
	 * optimize this case easily.
	 */
	Tcl_DString native;
	Tcl_WinUtfToTChar(Tcl_FSGetTranslatedStringPath(NULL, pathPtr), 
			  -1, &native);
	ret = DoRemoveDirectory(&native, recursive, &ds);
	Tcl_DStringFree(&native);
    } else {
	ret = DoRemoveJustDirectory(Tcl_FSGetNativePath(pathPtr), 
				    0, &ds);
    }
    if (ret != TCL_OK) {
	int len = Tcl_DStringLength(&ds);
	if (len > 0) {
	    *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
	    Tcl_IncrRefCount(*errorPtr);
	}
	Tcl_DStringFree(&ds);
    }
    return ret;
}

static int
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;

    if ((*tclWinProcs->removeDirectoryProc)(nativePath) != FALSE) {
	return TCL_OK;
    }
    TclWinConvertError(GetLastError());

    /*
     * Win32s thinks that "" is the same as "." and then reports EACCES
     * instead of ENOENT.
     */

    if (nativePath == NULL) {
	Tcl_SetErrno(ENOENT);
	goto end;
    }
	
    if (tclWinProcs->useWide) {
	if (((WCHAR *) nativePath)[0] == '\0') {
	    Tcl_SetErrno(ENOENT);
	    return TCL_ERROR;
	}
    } else {
	if (((char *) nativePath)[0] == '\0') {
	    Tcl_SetErrno(ENOENT);
	    return TCL_ERROR;
	}
    }
    if (Tcl_GetErrno() == EACCES) {
	attr = (*tclWinProcs->getFileAttributesProc)(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_READONLY) {
		attr &= ~FILE_ATTRIBUTE_READONLY;
		if ((*tclWinProcs->setFileAttributesProc)(nativePath, attr) == FALSE) {
		    goto end;
		}
		if ((*tclWinProcs->removeDirectoryProc)(nativePath) != FALSE) {
		    return TCL_OK;
		}
		TclWinConvertError(GetLastError());
		(*tclWinProcs->setFileAttributesProc)(nativePath, 
			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) {
		CONST char *path, *find;
		HANDLE handle;
		WIN32_FIND_DATAA data;
		Tcl_DString buffer;
		int len;

		path = (CONST char *) nativePath;

		Tcl_DStringInit(&buffer);
		len = strlen(path);
		find = Tcl_DStringAppend(&buffer, path, len);
		if ((len > 0) && (find[len - 1] != '\\')) {
		    Tcl_DStringAppend(&buffer, "\\", 1);
		}
		find = Tcl_DStringAppend(&buffer, "*.*", 3);
		handle = FindFirstFileA(find, &data);
		if (handle != INVALID_HANDLE_VALUE) {
		    while (1) {
			if ((strcmp(data.cFileName, ".") != 0)
				&& (strcmp(data.cFileName, "..") != 0)) {
			    /*
			     * Found something in this directory.
			     */

			    Tcl_SetErrno(EEXIST);
			    break;
			}
			if (FindNextFileA(handle, &data) == FALSE) {
			    break;
			}
		    }
		    FindClose(handle);
		}
		Tcl_DStringFree(&buffer);
	    }
	}
    }
    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) {
	Tcl_WinTCharToUtf(nativePath, -1, errorPtr);
    }
    return TCL_ERROR;

}

static int
DoRemoveDirectory(
    Tcl_DString *pathPtr,	/* Pathname of directory to be removed
				 * (native). */
    int recursive,		/* If non-zero, removes directories that
				 * are nonempty.  Otherwise, will only remove
				 * empty directories. */
    Tcl_DString *errorPtr)	/* If non-NULL, uninitialized or free
				 * DString filled with UTF-8 name of file
				 * causing error. */
{
    int res = DoRemoveJustDirectory(Tcl_DStringValue(pathPtr), recursive, 
				    errorPtr);
    
    if ((res == TCL_ERROR) && (recursive != 0) && (Tcl_GetErrno() == EEXIST)) {
	/*
	 * The directory is nonempty, but the recursive flag has been
	 * specified, so we recursively remove all the files in the directory.
	 */
	return TraverseWinTree(TraversalDelete, pathPtr, NULL, errorPtr);
    } else {
	return res;
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * 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, oldSourceLen, oldTargetLen;
    HANDLE handle;
    WIN32_FIND_DATAT 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 = (*tclWinProcs->getFileAttributesProc)(nativeSource);
    if (sourceAttr == 0xffffffff) {
	nativeErrfile = nativeSource;
	goto end;
    }
    if ((sourceAttr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
	/*
	 * Process the regular file
	 */

	return (*traverseProc)(nativeSource, nativeTarget, DOTREE_F, errorPtr);
    }

    if (tclWinProcs->useWide) {
	Tcl_DStringAppend(sourcePtr, (char *) L"\\*.*", 4 * sizeof(WCHAR) + 1);
	Tcl_DStringSetLength(sourcePtr, Tcl_DStringLength(sourcePtr) - 1);
    } else {
	Tcl_DStringAppend(sourcePtr, "\\*.*", 4);
    }
    nativeSource = (TCHAR *) Tcl_DStringValue(sourcePtr);
    handle = (*tclWinProcs->findFirstFileProc)(nativeSource, &data);
    if (handle == INVALID_HANDLE_VALUE) {      
	/* 
	 * Can't read directory
	 */

	TclWinConvertError(GetLastError());
	nativeErrfile = nativeSource;
	goto end;
    }

    nativeSource[oldSourceLen + 1] = '\0';
    Tcl_DStringSetLength(sourcePtr, oldSourceLen);
    result = (*traverseProc)(nativeSource, nativeTarget, DOTREE_PRED, errorPtr);
    if (result != TCL_OK) {
	FindClose(handle);
	return result;
    }

    sourceLen = oldSourceLen;

    if (tclWinProcs->useWide) {
	sourceLen += sizeof(WCHAR);
	Tcl_DStringAppend(sourcePtr, (char *) L"\\", sizeof(WCHAR) + 1);
	Tcl_DStringSetLength(sourcePtr, sourceLen);
    } else {
	sourceLen += 1;
	Tcl_DStringAppend(sourcePtr, "\\", 1);
    }
    if (targetPtr != NULL) {
	oldTargetLen = Tcl_DStringLength(targetPtr);

	targetLen = oldTargetLen;
	if (tclWinProcs->useWide) {
	    targetLen += sizeof(WCHAR);
	    Tcl_DStringAppend(targetPtr, (char *) L"\\", sizeof(WCHAR) + 1);
	    Tcl_DStringSetLength(targetPtr, targetLen);
	} else {
	    targetLen += 1;
	    Tcl_DStringAppend(targetPtr, "\\", 1);
	}
    }

    found = 1;
    for ( ; found; found = (*tclWinProcs->findNextFileProc)(handle, &data)) {
	TCHAR *nativeName;
	int len;

	if (tclWinProcs->useWide) {
	    WCHAR *wp;

	    wp = data.w.cFileName;
	    if (*wp == '.') {
		wp++;
		if (*wp == '.') {
		    wp++;
		}
		if (*wp == '\0') {
		    continue;
		}
	    }
	    nativeName = (TCHAR *) data.w.cFileName;
	    len = Tcl_UniCharLen(data.w.cFileName) * sizeof(WCHAR);
	} else {
	    if ((strcmp(data.a.cFileName, ".") == 0) 
		    || (strcmp(data.a.cFileName, "..") == 0)) {
		continue;
	    }
	    nativeName = (TCHAR *) data.a.cFileName;
	    len = strlen(data.a.cFileName);
	}

	/* 
	 * 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)(Tcl_DStringValue(sourcePtr), 
			(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. */
{
    DWORD attr;

    switch (type) {
	case DOTREE_F: {
	    if (DoCopyFile(nativeSrc, nativeDst) == TCL_OK) {
		return TCL_OK;
	    }
	    break;
	}
	case DOTREE_PRED: {
	    if (DoCreateDirectory(nativeDst) == TCL_OK) {
		attr = (*tclWinProcs->getFileAttributesProc)(nativeSrc);
		if ((*tclWinProcs->setFileAttributesProc)(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 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( 
    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 (DoDeleteFile(nativeSrc) == 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_AppendStringsToObj(Tcl_GetObjResult(interp), 
			   "could not read \"", Tcl_GetString(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. */
    Tcl_Obj *fileName,	        /* The name of the file. */
    Tcl_Obj **attributePtrPtr)	/* A pointer to return the object with. */
{
    DWORD result;
    TCHAR *nativeName;

    nativeName = Tcl_FSGetNativePath(fileName);
    result = (*tclWinProcs->getFileAttributesProc)(nativeName);

    if (result == 0xffffffff) {
	StatError(interp, fileName);
	return TCL_ERROR;
    }

    *attributePtrPtr = Tcl_NewBooleanObj((int) (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.
 *	
 *	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;
    int result = TCL_OK;

    splitPath = Tcl_FSSplitPath(fileName, &pathc);

    if (splitPath == NULL || pathc == 0) {
	if (interp != NULL) {
	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), 
		"could not read \"", Tcl_GetString(fileName),
		"\": no such file or directory", 
		(char *) NULL);
	}
	result = TCL_ERROR;
	goto cleanup;
    }
    
    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;
	    TCHAR *nativeName;
	    char *tempString;
	    int tempLen;
	    WIN32_FIND_DATAT 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);
	    Tcl_WinUtfToTChar(tempString, tempLen, &ds);
	    Tcl_DecrRefCount(tempPath);
	    nativeName = Tcl_DStringValue(&ds);
	    handle = (*tclWinProcs->findFirstFileProc)(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 = (*tclWinProcs->getFileAttributesProc)(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);
		}
		result = TCL_ERROR;
		goto cleanup;
	    }
	    if (tclWinProcs->useWide) {
		nativeName = (TCHAR *) data.w.cAlternateFileName;
		if (longShort) {
		    if (data.w.cFileName[0] != '\0') {
			nativeName = (TCHAR *) data.w.cFileName;
		    } 
		} else {
		    if (data.w.cAlternateFileName[0] == '\0') {
			nativeName = (TCHAR *) data.w.cFileName;
		    }
		}
	    } else {
		nativeName = (TCHAR *) data.a.cAlternateFileName;
		if (longShort) {
		    if (data.a.cFileName[0] != '\0') {
			nativeName = (TCHAR *) data.a.cFileName;
		    } 
		} else {
		    if (data.a.cAlternateFileName[0] == '\0') {
			nativeName = (TCHAR *) data.a.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);
	    /* Deal with issues of tildes being absolute */
	    if (Tcl_DStringValue(&dsTemp)[0] == '~') {
		tempPath = Tcl_NewStringObj("./",2);
		Tcl_AppendToObj(tempPath, Tcl_DStringValue(&dsTemp), 
				Tcl_DStringLength(&dsTemp));
	    } else {
		tempPath = Tcl_NewStringObj(Tcl_DStringValue(&dsTemp), 
					    Tcl_DStringLength(&dsTemp));
	    }
	    Tcl_ListObjReplace(NULL, splitPath, i, 1, 1, &tempPath);
	    Tcl_DStringFree(&ds);
	    Tcl_DStringFree(&dsTemp);
	    FindClose(handle);
	}
    }

    *attributePtrPtr = Tcl_FSJoinPath(splitPath, -1);

cleanup:
    if (splitPath != NULL) {
	Tcl_DecrRefCount(splitPath);
    }
  
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * 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;
    int yesNo;
    int result;
    TCHAR *nativeName;

    nativeName = Tcl_FSGetNativePath(fileName);
    fileAttributes = (*tclWinProcs->getFileAttributesProc)(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 (!(*tclWinProcs->setFileAttributesProc)(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_AppendStringsToObj(Tcl_GetObjResult(interp), 
	    "cannot set attribute \"", tclpFileAttrStrings[objIndex],
	    "\" for file \"", Tcl_GetString(fileName), 
	    "\": attribute is readonly", 
	    (char *) NULL);
    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;
}

/* 
 * This function could be thoroughly tested and then substituted in
 * below to speed up file normalization on Windows NT/2000/XP
 */
#if 0

void WinGetLongPathName(CONST TCHAR* origPath, Tcl_DString *dsPtr);

#define IsDirSep(a) (a == '/' || a == '\\')

void WinGetLongPathName(CONST TCHAR* pszOriginal, Tcl_DString *dsPtr) {
    TCHAR szResult[_MAX_PATH * 2 + 1];		
    
    TCHAR* pchResult = szResult;
    const TCHAR* pchScan = pszOriginal;
    WIN32_FIND_DATA wfd;
    
    /* Do Drive Letter check... */
    if (pchScan[0] && pchScan[1] == ':') {
	/* Copy drive letter and colon, ensuring drive is upper case. */
	char drive = *pchScan++;
	*pchResult++ = (drive < 97 ? drive : drive - 32);
	*pchResult++ = *pchScan++;
    } else if (IsDirSep(pchScan[0]) && IsDirSep(pchScan[1])) {
	/* Copy \\ and machine name. */
	*pchResult++ = *pchScan++;
	*pchResult++ = *pchScan++;
	while (*pchScan && !IsDirSep(*pchScan)) {
	    *pchResult++ = *pchScan++;
	}
	/* 
	 * Note that the code below will fail since FindFirstFile
	 * on a UNC path seems not to work on directory name searches?
	 */
    }
  
    if (!IsDirSep(*pchScan)) {
	while ((*pchResult++ = *pchScan++) != '\0');
    } else {
	/* Now loop through directories and files... */
	while (IsDirSep(*pchScan)) {
	    char* pchReplace;
	    const TCHAR* pchEnd;
	    HANDLE hFind;
	    
	    *pchResult++ = *pchScan++;
	    pchReplace = pchResult;
	    
	    pchEnd = pchScan;
	    while (*pchEnd && !IsDirSep(*pchEnd)) {
		*pchResult++ = *pchEnd++;
	    }
	    
	    *pchResult = '\0';
	    
	    /* Now run this through FindFirstFile... */
	    hFind = FindFirstFileA(szResult, &wfd);
	    if (hFind != INVALID_HANDLE_VALUE) {
		FindClose(hFind);
		strcpy(pchReplace, wfd.cFileName);
		pchResult = pchReplace + strlen(pchReplace);
	    } else {
		/* Copy rest of input path & end. */
		strcat(pchResult, pchEnd);
		break;
	    }
	    pchScan = pchEnd;
	}
    }
    /* Copy it over */
    Tcl_ExternalToUtfDString(NULL, szResult, -1, dsPtr);
}
    
#endif


/*
 *---------------------------------------------------------------------------
 *
 * TclpObjNormalizePath --
 *
 *	This function scans through a path specification and replaces
 *	it, in place, with a normalized version.  On windows this
 *	means using the 'longname'.
 *
 * Results:
 *	The new 'nextCheckpoint' value, giving as far as we could
 *	understand in the path.
 *
 * Side effects:
 *	The pathPtr string, which must contain a valid path, is
 *	possibly modified in place.
 *
 *---------------------------------------------------------------------------
 */

int
TclpObjNormalizePath(interp, pathPtr, nextCheckpoint)
    Tcl_Interp *interp;
    Tcl_Obj *pathPtr;
    int nextCheckpoint;
{
    char *lastValidPathEnd = NULL;
    Tcl_DString ds;
    int pathLen;
    
    char *path = Tcl_GetStringFromObj(pathPtr, &pathLen);

    if (TclWinGetPlatformId() == VER_PLATFORM_WIN32_WINDOWS) {
	Tcl_DString eDs;
	char *nativePath;
	int nativeLen;

	nativePath = Tcl_UtfToExternalDString(NULL, path, -1, &ds);
	nativeLen = Tcl_DStringLength(&ds);

	/* We're on Windows 95/98 */
	lastValidPathEnd = nativePath + Tcl_DStringLength(&ds);
	
	while (1) {
	    DWORD res = GetShortPathNameA(nativePath, nativePath, 1+nativeLen);
	    if (res != 0) {
		/* We found an ok path */
		break;
	    }
	    /* Undo the null-termination we put in before */
	    if (lastValidPathEnd != (nativePath + nativeLen)) {
		*lastValidPathEnd = '/';
	    }
	    /* 
	     * The path doesn't exist.  Back up the path, one component
	     * (directory/file) at a time, until one does exist. 
	     */
	    while (1) {
		char cur;
		lastValidPathEnd--;
		if (lastValidPathEnd == nativePath) {
		    /* We didn't accept any of the path */
		    Tcl_DStringFree(&ds);
		    return nextCheckpoint;
		}
		cur = *(--lastValidPathEnd);
		if (cur == '/' || cur == '\\') {
		    /* Reached directory separator */
		    break;
		}
	    }
	    /* Temporarily terminate the string */
	    *lastValidPathEnd = '\0';
	}
	/* 
	 * If we get here, we found a valid path, which we've converted to
	 * short form, and the valid string ends at or before 'lastValidPathEnd'
	 * and the invalid string starts at 'lastValidPathEnd'.
	 */

	/* Copy over the valid part of the path and find its length */
	path = Tcl_ExternalToUtfDString(NULL, nativePath, -1, &eDs);
	if (path[1] == ':') {
	    if (path[0] >= 'a' && path[0] <= 'z') {
		/* Make uppercase */
	        path[0] -= 32;
	    }
	}
	nextCheckpoint = Tcl_DStringLength(&eDs);
	Tcl_SetStringObj(pathPtr, path, Tcl_DStringLength(&eDs));
	Tcl_DStringFree(&eDs);
	if (lastValidPathEnd != (nativePath + nativeLen)) {
	    *lastValidPathEnd = '/';
	    /* Now copy over the invalid (i.e. non-existent) part of the path */
	    path = Tcl_ExternalToUtfDString(NULL, lastValidPathEnd, -1, &eDs);
	    Tcl_AppendToObj(pathPtr, path, Tcl_DStringLength(&eDs));
	    Tcl_DStringFree(&eDs);
	}
	Tcl_DStringFree(&ds);
    } else {
	/* We're on WinNT or 2000 or XP */
	char *nativePath;
#if 0
	/* 
	 * We don't use this simpler version, because the speed
	 * increase does not seem significant at present and the version
	 * below is thoroughly debugged.
	 */
	int nativeLen;
	Tcl_DString eDs;
	nativePath = Tcl_UtfToExternalDString(NULL, path, -1, &ds);
	nativeLen = Tcl_DStringLength(&ds);
	WinGetLongPathName(nativePath, &eDs);
	/* 
	 * We need to add code here to calculate the new value of 
	 * 'nextCheckpoint' -- i.e. the longest part of the path
	 * which is an existing file.
	 */
	Tcl_SetStringObj(pathPtr, Tcl_DStringValue(&eDs), Tcl_DStringLength(&eDs));
	Tcl_DStringFree(&eDs);
	Tcl_DStringFree(&ds);
#else
	char *currentPathEndPosition;
	WIN32_FILE_ATTRIBUTE_DATA data;
	nativePath = Tcl_WinUtfToTChar(path, -1, &ds);

	if ((*tclWinProcs->getFileAttributesExProc)(nativePath, 
						    GetFileExInfoStandard, 
						    &data) == TRUE) {
	    currentPathEndPosition = path + pathLen;
	    nextCheckpoint = pathLen;
	    lastValidPathEnd = currentPathEndPosition;
	    Tcl_DStringFree(&ds);
	} else {
	    Tcl_DStringFree(&ds);
	    currentPathEndPosition = path + nextCheckpoint;
	    while (1) {
		char cur = *currentPathEndPosition;
		if ((cur == '/' || cur == 0) && (path != currentPathEndPosition)) {
		    /* Reached directory separator, or end of string */
		    nativePath = Tcl_WinUtfToTChar(path, currentPathEndPosition - path, 
						   &ds);
		    if ((*tclWinProcs->getFileAttributesExProc)(nativePath,
			GetFileExInfoStandard, &data) != TRUE) {
			/* File doesn't exist */
			Tcl_DStringFree(&ds);
			break;
		    }
		    Tcl_DStringFree(&ds);

		    lastValidPathEnd = currentPathEndPosition;
		    /* File does exist */
		    if (cur == 0) {
			break;
		    }
		}
		currentPathEndPosition++;
	    }
	    nextCheckpoint = currentPathEndPosition - path;
	}
	if (lastValidPathEnd != NULL) {
	    Tcl_Obj *tmpPathPtr;
	    /* 
	     * The leading end of the path description was acceptable to
	     * us.  We therefore convert it to its long form, and return
	     * that.
	     */
	    Tcl_Obj* objPtr = NULL;
	    int endOfString;
	    int useLength = lastValidPathEnd - path;
	    if (*lastValidPathEnd == 0) {
		tmpPathPtr = Tcl_NewStringObj(path, useLength);
		endOfString = 1;
	    } else {
		tmpPathPtr = Tcl_NewStringObj(path, useLength + 1);
		endOfString = 0;
	    }
	    /* 
	     * If this returns an error, we have a strange situation; the
	     * file exists, but we can't get its long name.  We will have
	     * to assume the name we have is ok.
	     */
	    Tcl_IncrRefCount(tmpPathPtr);
	    if (ConvertFileNameFormat(interp, 0, tmpPathPtr, 1, &objPtr) == TCL_OK) {
		int len;
		(void) Tcl_GetStringFromObj(objPtr,&len);
		if (!endOfString) {
		    /* Be nice and fix the string before we clear it */
		    Tcl_AppendToObj(objPtr, lastValidPathEnd, -1);
		}
		nextCheckpoint += (len - useLength);
		path = Tcl_GetStringFromObj(objPtr,&len);
		Tcl_SetStringObj(pathPtr,path, len);
		Tcl_DecrRefCount(objPtr);
	    }
	    Tcl_DecrRefCount(tmpPathPtr);
	}
#endif
    }
    return nextCheckpoint;
}