/[dtapublic]/projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclwinfcmd.c
ViewVC logotype

Diff of /projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclwinfcmd.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 64 by dashley, Sun Oct 30 04:21:11 2016 UTC revision 71 by dashley, Sat Nov 5 11:07:06 2016 UTC
# Line 1  Line 1 
 /* $Header$ */  
   
 /*  
  * 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.1.1.1 2001/06/13 04:49:02 dtashley 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, CONST char *fileName,  
                             Tcl_Obj **attributePtrPtr));  
 static int              GetWinFileLongName _ANSI_ARGS_((Tcl_Interp *interp,  
                             int objIndex, CONST char *fileName,  
                             Tcl_Obj **attributePtrPtr));  
 static int              GetWinFileShortName _ANSI_ARGS_((Tcl_Interp *interp,  
                             int objIndex, CONST char *fileName,  
                             Tcl_Obj **attributePtrPtr));  
 static int              SetWinFileAttributes _ANSI_ARGS_((Tcl_Interp *interp,  
                             int objIndex, CONST char *fileName,  
                             Tcl_Obj *attributePtr));  
 static int              CannotSetAttribute _ANSI_ARGS_((Tcl_Interp *interp,  
                             int objIndex, CONST char *fileName,  
                             Tcl_Obj *attributePtr));  
   
 /*  
  * Constants and variables necessary for file attributes subcommand.  
  */  
   
 enum {  
     WIN_ARCHIVE_ATTRIBUTE,  
     WIN_HIDDEN_ATTRIBUTE,  
     WIN_LONGNAME_ATTRIBUTE,  
     WIN_READONLY_ATTRIBUTE,  
     WIN_SHORTNAME_ATTRIBUTE,  
     WIN_SYSTEM_ATTRIBUTE  
 };  
   
 static int attributeArray[] = {FILE_ATTRIBUTE_ARCHIVE, FILE_ATTRIBUTE_HIDDEN,  
         0, FILE_ATTRIBUTE_READONLY, 0, FILE_ATTRIBUTE_SYSTEM};  
   
   
 char *tclpFileAttrStrings[] = {  
         "-archive", "-hidden", "-longname", "-readonly",  
         "-shortname", "-system", (char *) NULL  
 };  
   
 const TclFileAttrProcs tclpFileAttrProcs[] = {  
         {GetWinFileAttributes, SetWinFileAttributes},  
         {GetWinFileAttributes, SetWinFileAttributes},  
         {GetWinFileLongName, CannotSetAttribute},  
         {GetWinFileAttributes, SetWinFileAttributes},  
         {GetWinFileShortName, CannotSetAttribute},  
         {GetWinFileAttributes, SetWinFileAttributes}};  
   
 /*  
  * Prototype for the TraverseWinTree callback function.  
  */  
   
 typedef int (TraversalProc)(Tcl_DString *srcPtr, Tcl_DString *dstPtr,  
         int type, Tcl_DString *errorPtr);  
   
 /*  
  * Declarations for local procedures defined in this file:  
  */  
   
 static void             StatError(Tcl_Interp *interp, CONST char *fileName);  
 static int              ConvertFileNameFormat(Tcl_Interp *interp,  
                             int objIndex, CONST char *fileName, int longShort,  
                             Tcl_Obj **attributePtrPtr);  
 static int              DoCopyFile(Tcl_DString *srcPtr, Tcl_DString *dstPtr);  
 static int              DoCreateDirectory(Tcl_DString *pathPtr);  
 static int              DoDeleteFile(Tcl_DString *pathPtr);  
 static int              DoRemoveDirectory(Tcl_DString *pathPtr, int recursive,  
                             Tcl_DString *errorPtr);  
 static int              DoRenameFile(const TCHAR *nativeSrc, Tcl_DString *dstPtr);  
 static int              TraversalCopy(Tcl_DString *srcPtr, Tcl_DString *dstPtr,  
                             int type, Tcl_DString *errorPtr);  
 static int              TraversalDelete(Tcl_DString *srcPtr, Tcl_DString *dstPtr,  
                             int type, Tcl_DString *errorPtr);  
 static int              TraverseWinTree(TraversalProc *traverseProc,  
                             Tcl_DString *sourcePtr, Tcl_DString *dstPtr,  
                             Tcl_DString *errorPtr);  
   
   
 /*  
  *---------------------------------------------------------------------------  
  *  
  * TclpRenameFile, 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  
 TclpRenameFile(  
     CONST char *src,            /* Pathname of file or dir to be renamed  
                                  * (UTF-8). */  
     CONST char *dst)            /* New pathname of file or directory  
                                  * (UTF-8). */  
 {  
     int result;  
     TCHAR *nativeSrc;  
     Tcl_DString srcString, dstString;  
   
     nativeSrc = Tcl_WinUtfToTChar(src, -1, &srcString);  
     Tcl_WinUtfToTChar(dst, -1, &dstString);  
   
     result = DoRenameFile(nativeSrc, &dstString);  
     Tcl_DStringFree(&srcString);  
     Tcl_DStringFree(&dstString);  
     return result;  
 }  
   
 static int  
 DoRenameFile(  
     CONST TCHAR *nativeSrc,     /* Pathname of file or dir to be renamed  
                                  * (native). */  
     Tcl_DString *dstPtr)        /* New pathname for file or directory  
                                  * (native). */  
 {      
     const TCHAR *nativeDst;  
     DWORD srcAttr, dstAttr;  
   
     nativeDst = (TCHAR *) Tcl_DStringValue(dstPtr);  
   
     /*  
      * Would throw an exception under NT if one of the arguments is a  
      * char block device.  
      */  
   
     __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, 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 (DoRemoveDirectory(dstPtr, 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;  
 }  
   
 /*  
  *---------------------------------------------------------------------------  
  *  
  * TclpCopyFile, 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  
 TclpCopyFile(  
     CONST char *src,            /* Pathname of file to be copied (UTF-8). */  
     CONST char *dst)            /* Pathname of file to copy to (UTF-8). */  
 {  
     int result;  
     Tcl_DString srcString, dstString;  
   
     Tcl_WinUtfToTChar(src, -1, &srcString);  
     Tcl_WinUtfToTChar(dst, -1, &dstString);  
     result = DoCopyFile(&srcString, &dstString);  
     Tcl_DStringFree(&srcString);  
     Tcl_DStringFree(&dstString);  
     return result;  
 }  
   
 static int  
 DoCopyFile(  
     Tcl_DString *srcPtr,        /* Pathname of file to be copied (native). */  
     Tcl_DString *dstPtr)        /* Pathname of file to copy to (native). */  
 {  
     CONST TCHAR *nativeSrc, *nativeDst;  
   
     nativeSrc = (TCHAR *) Tcl_DStringValue(srcPtr);  
     nativeDst = (TCHAR *) Tcl_DStringValue(dstPtr);  
   
     /*  
      * Would throw an exception under NT if one of the arguments is a char  
      * block device.  
      */  
   
     __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;  
 }  
   
 /*  
  *---------------------------------------------------------------------------  
  *  
  * TclpDeleteFile, 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  
 TclpDeleteFile(  
     CONST char *path)           /* Pathname of file to be removed (UTF-8). */  
 {  
     int result;  
     Tcl_DString pathString;  
   
     Tcl_WinUtfToTChar(path, -1, &pathString);  
     result = DoDeleteFile(&pathString);  
     Tcl_DStringFree(&pathString);  
     return result;  
 }  
   
 static int  
 DoDeleteFile(  
     Tcl_DString *pathPtr)       /* Pathname of file to be removed (native). */  
 {  
     DWORD attr;  
     CONST TCHAR *nativePath;  
   
     nativePath = (TCHAR *) Tcl_DStringValue(pathPtr);  
       
     if ((*tclWinProcs->deleteFileProc)(nativePath) != FALSE) {  
         return TCL_OK;  
     }  
     TclWinConvertError(GetLastError());  
   
     /*  
      * Win32s thinks that "" is the same as "." and then reports EISDIR  
      * instead of ENOENT.  
      */  
   
     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;  
 }  
   
 /*  
  *---------------------------------------------------------------------------  
  *  
  * TclpCreateDirectory --  
  *  
  *      Creates the specified directory.  All parent directories of the  
  *      specified directory must already exist.  The directory is  
  *      automatically created with permissions so that user can access  
  *      the new directory and create new files or subdirectories in it.  
  *  
  * Results:  
  *      If the directory was successfully created, returns TCL_OK.  
  *      Otherwise the return value is TCL_ERROR and errno is set to  
  *      indicate the error.  Some possible values for errno are:  
  *  
  *      EACCES:     a parent directory can't be read and/or written.  
  *      EEXIST:     path already exists.  
  *      ENOENT:     a parent directory doesn't exist.  
  *  
  * Side effects:  
  *      A directory is created.  
  *  
  *---------------------------------------------------------------------------  
  */  
   
 int  
 TclpCreateDirectory(  
     CONST char *path)           /* Pathname of directory to create (UTF-8). */  
 {  
     int result;  
     Tcl_DString pathString;  
   
     Tcl_WinUtfToTChar(path, -1, &pathString);  
     result = DoCreateDirectory(&pathString);  
     Tcl_DStringFree(&pathString);  
     return result;  
 }  
   
 static int  
 DoCreateDirectory(  
     Tcl_DString *pathPtr)       /* Pathname of directory to create (native). */  
 {  
     int error;  
     CONST TCHAR *nativePath;  
   
     nativePath = (TCHAR *) Tcl_DStringValue(pathPtr);  
     if ((*tclWinProcs->createDirectoryProc)(nativePath, NULL) == 0) {  
         error = GetLastError();  
         TclWinConvertError(error);  
         return TCL_ERROR;  
     }    
     return TCL_OK;  
 }  
   
 /*  
  *---------------------------------------------------------------------------  
  *  
  * TclpCopyDirectory --  
  *  
  *      Recursively copies a directory.  The target directory dst must  
  *      not already exist.  Note that this function does not merge two  
  *      directory hierarchies, even if the target directory is an an  
  *      empty directory.  
  *  
  * Results:  
  *      If the directory was successfully copied, returns TCL_OK.  
  *      Otherwise the return value is TCL_ERROR, errno is set to indicate  
  *      the error, and the pathname of the file that caused the error  
  *      is stored in errorPtr.  See TclpCreateDirectory and TclpCopyFile  
  *      for a description of possible values for errno.  
  *  
  * Side effects:  
  *      An exact copy of the directory hierarchy src will be created  
  *      with the name dst.  If an error occurs, the error will  
  *      be returned immediately, and remaining files will not be  
  *      processed.  
  *  
  *---------------------------------------------------------------------------  
  */  
   
 int  
 TclpCopyDirectory(  
     CONST char *src,            /* Pathname of directory to be copied  
                                  * (UTF-8). */  
     CONST char *dst,            /* Pathname of target directory (UTF-8). */  
     Tcl_DString *errorPtr)      /* If non-NULL, uninitialized or free  
                                  * DString filled with UTF-8 name of file  
                                  * causing error. */  
 {  
     int result;  
     Tcl_DString srcString, dstString;  
   
     Tcl_WinUtfToTChar(src, -1, &srcString);  
     Tcl_WinUtfToTChar(dst, -1, &dstString);  
   
     result = TraverseWinTree(TraversalCopy, &srcString, &dstString, errorPtr);  
   
     Tcl_DStringFree(&srcString);  
     Tcl_DStringFree(&dstString);  
     return result;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * TclpRemoveDirectory, 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  
 TclpRemoveDirectory(  
     CONST char *path,           /* Pathname of directory to be removed  
                                  * (UTF-8). */  
     int recursive,              /* If non-zero, removes directories that  
                                  * are nonempty.  Otherwise, will only remove  
                                  * empty directories. */  
     Tcl_DString *errorPtr)      /* If non-NULL, uninitialized or free  
                                  * DString filled with UTF-8 name of file  
                                  * causing error. */  
 {  
     int result;  
     Tcl_DString pathString;  
   
     Tcl_WinUtfToTChar(path, -1, &pathString);  
     result = DoRemoveDirectory(&pathString, recursive, errorPtr);  
     Tcl_DStringFree(&pathString);  
   
     return result;  
 }  
   
 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. */  
 {  
     CONST TCHAR *nativePath;  
     DWORD attr;  
   
     nativePath = (TCHAR *) Tcl_DStringValue(pathPtr);  
   
     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 (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) {  
                 char *path, *find;  
                 HANDLE handle;  
                 WIN32_FIND_DATAA data;  
                 Tcl_DString buffer;  
                 int len;  
   
                 path = (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 ((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);  
     }  
       
     end:  
     if (errorPtr != NULL) {  
         Tcl_WinTCharToUtf(nativePath, -1, errorPtr);  
     }  
     return TCL_ERROR;  
 }  
   
 /*  
  *---------------------------------------------------------------------------  
  *  
  * TraverseWinTree --  
  *  
  *      Traverse directory tree specified by sourcePtr, calling the function  
  *      traverseProc for each file and directory encountered.  If destPtr  
  *      is non-null, each of name in the sourcePtr directory is appended to  
  *      the directory specified by destPtr and passed as the second argument  
  *      to traverseProc() .  
  *  
  * Results:  
  *      Standard Tcl result.  
  *  
  * Side effects:  
  *      None caused by TraverseWinTree, however the user specified  
  *      traverseProc() may change state.  If an error occurs, the error will  
  *      be returned immediately, and remaining files will not be processed.  
  *  
  *---------------------------------------------------------------------------  
  */  
   
 static int  
 TraverseWinTree(  
     TraversalProc *traverseProc,/* Function to call for every file and  
                                  * directory in source hierarchy. */  
     Tcl_DString *sourcePtr,     /* Pathname of source directory to be  
                                  * traversed (native). */  
     Tcl_DString *targetPtr,     /* Pathname of directory to traverse in  
                                  * parallel with source directory (native). */  
     Tcl_DString *errorPtr)      /* If non-NULL, uninitialized or free  
                                  * DString filled with UTF-8 name of file  
                                  * causing error. */  
 {  
     DWORD sourceAttr;  
     TCHAR *nativeSource, *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);  
     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)(sourcePtr, targetPtr, 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)(sourcePtr, targetPtr, 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)(sourcePtr, 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(  
     Tcl_DString *srcPtr,        /* Source pathname to copy. */  
     Tcl_DString *dstPtr,        /* Destination pathname of copy. */  
     int type,                   /* Reason for call - see TraverseWinTree() */  
     Tcl_DString *errorPtr)      /* If non-NULL, initialized DString filled  
                                  * with UTF-8 name of file causing error. */  
 {  
     TCHAR *nativeDst, *nativeSrc;  
     DWORD attr;  
   
     switch (type) {  
         case DOTREE_F: {  
             if (DoCopyFile(srcPtr, dstPtr) == TCL_OK) {  
                 return TCL_OK;  
             }  
             break;  
         }  
         case DOTREE_PRED: {  
             if (DoCreateDirectory(dstPtr) == TCL_OK) {  
                 nativeSrc = (TCHAR *) Tcl_DStringValue(srcPtr);  
                 nativeDst = (TCHAR *) Tcl_DStringValue(dstPtr);  
                 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) {  
         nativeDst = (TCHAR *) Tcl_DStringValue(dstPtr);  
         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(  
     Tcl_DString *srcPtr,        /* Source pathname to delete. */  
     Tcl_DString *dstPtr,        /* Not used. */  
     int type,                   /* Reason for call - see TraverseWinTree() */  
     Tcl_DString *errorPtr)      /* If non-NULL, initialized DString filled  
                                  * with UTF-8 name of file causing error. */  
 {  
     TCHAR *nativeSrc;  
   
     switch (type) {  
         case DOTREE_F: {  
             if (DoDeleteFile(srcPtr) == TCL_OK) {  
                 return TCL_OK;  
             }  
             break;  
         }  
         case DOTREE_PRED: {  
             return TCL_OK;  
         }  
         case DOTREE_POSTD: {  
             if (DoRemoveDirectory(srcPtr, 0, NULL) == TCL_OK) {  
                 return TCL_OK;  
             }  
             break;  
         }  
     }  
   
     if (errorPtr != NULL) {  
         nativeSrc = (TCHAR *) Tcl_DStringValue(srcPtr);  
         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 */  
     CONST char *fileName)       /* The name of the file which caused the  
                                  * error. */  
 {  
     TclWinConvertError(GetLastError());  
     Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),  
             "could not read \"", fileName, "\": ", Tcl_PosixError(interp),  
             (char *) NULL);  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * 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. */  
     CONST char *fileName,       /* The name of the file. */  
     Tcl_Obj **attributePtrPtr)  /* A pointer to return the object with. */  
 {  
     DWORD result;  
     Tcl_DString ds;  
     TCHAR *nativeName;  
   
     nativeName = Tcl_WinUtfToTChar(fileName, -1, &ds);  
     result = (*tclWinProcs->getFileAttributesProc)(nativeName);  
     Tcl_DStringFree(&ds);  
   
     if (result == 0xffffffff) {  
         StatError(interp, fileName);  
         return TCL_ERROR;  
     }  
   
     *attributePtrPtr = Tcl_NewBooleanObj(result & attributeArray[objIndex]);  
     return TCL_OK;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * ConvertFileNameFormat --  
  *  
  *      Returns a Tcl_Obj containing either the long or short version of the  
  *      file name.  
  *  
  * Results:  
  *      Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object  
  *      will have ref count 0. If the return value is not TCL_OK,  
  *      attributePtrPtr is not touched.  
  *  
  * Side effects:  
  *      A new object is allocated if the file is valid.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static int  
 ConvertFileNameFormat(  
     Tcl_Interp *interp,         /* The interp we are using for errors. */  
     int objIndex,               /* The index of the attribute. */  
     CONST char *fileName,       /* The name of the file. */  
     int longShort,              /* 0 to short name, 1 to long name. */  
     Tcl_Obj **attributePtrPtr)  /* A pointer to return the object with. */  
 {  
     int pathc, i;  
     char **pathv, **newv;  
     char *resultStr;  
     Tcl_DString resultDString;  
     int result = TCL_OK;  
   
     Tcl_SplitPath(fileName, &pathc, &pathv);  
     newv = (char **) ckalloc(pathc * sizeof(char *));  
   
     if (pathc == 0) {  
         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),  
                 "could not read \"", fileName,  
                 "\": no such file or directory",  
                 (char *) NULL);  
         result = TCL_ERROR;  
         goto cleanup;  
     }  
       
     for (i = 0; i < pathc; i++) {  
         if ((pathv[i][0] == '/')  
                 || ((strlen(pathv[i]) == 3) && (pathv[i][1] == ':'))  
                 || (strcmp(pathv[i], ".") == 0)  
                 || (strcmp(pathv[i], "..") == 0)) {  
             /*  
              * 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:  
             pathv[i][0] = (char) Tcl_UniCharToUpper(UCHAR(pathv[i][0]));  
             newv[i] = (char *) ckalloc(strlen(pathv[i]) + 1);  
             lstrcpyA(newv[i], pathv[i]);  
         } else {  
             char *str;  
             TCHAR *nativeName;  
             Tcl_DString ds;  
             WIN32_FIND_DATAT data;  
             HANDLE handle;  
             DWORD attr;  
   
             Tcl_DStringInit(&resultDString);  
             str = Tcl_JoinPath(i + 1, pathv, &resultDString);  
             nativeName = Tcl_WinUtfToTChar(str, -1, &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);  
                     Tcl_DStringFree(&resultDString);  
   
                     goto simple;  
                 }  
             }  
             Tcl_DStringFree(&ds);  
             Tcl_DStringFree(&resultDString);  
   
             if (handle == INVALID_HANDLE_VALUE) {  
                 pathc = i - 1;  
                 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_WinTCharToUtf(nativeName, -1, &ds);  
             newv[i] = ckalloc(Tcl_DStringLength(&ds) + 1);  
             lstrcpyA(newv[i], Tcl_DStringValue(&ds));  
             Tcl_DStringFree(&ds);  
             FindClose(handle);  
         }  
     }  
   
     Tcl_DStringInit(&resultDString);  
     resultStr = Tcl_JoinPath(pathc, newv, &resultDString);  
     *attributePtrPtr = Tcl_NewStringObj(resultStr,  
             Tcl_DStringLength(&resultDString));  
     Tcl_DStringFree(&resultDString);  
   
 cleanup:  
     for (i = 0; i < pathc; i++) {  
         ckfree(newv[i]);  
     }  
     ckfree((char *) newv);  
     ckfree((char *) pathv);  
     return result;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * GetWinFileLongName --  
  *  
  *      Returns a Tcl_Obj containing the short version of the file  
  *      name.  
  *  
  * Results:  
  *      Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object  
  *      will have ref count 0. If the return value is not TCL_OK,  
  *      attributePtrPtr is not touched.  
  *  
  * Side effects:  
  *      A new object is allocated if the file is valid.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static int  
 GetWinFileLongName(  
     Tcl_Interp *interp,         /* The interp we are using for errors. */  
     int objIndex,               /* The index of the attribute. */  
     CONST char *fileName,       /* The name of the file. */  
     Tcl_Obj **attributePtrPtr)  /* A pointer to return the object with. */  
 {  
     return ConvertFileNameFormat(interp, objIndex, fileName, 1, attributePtrPtr);  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * GetWinFileShortName --  
  *  
  *      Returns a Tcl_Obj containing the short version of the file  
  *      name.  
  *  
  * Results:  
  *      Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object  
  *      will have ref count 0. If the return value is not TCL_OK,  
  *      attributePtrPtr is not touched.  
  *  
  * Side effects:  
  *      A new object is allocated if the file is valid.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static int  
 GetWinFileShortName(  
     Tcl_Interp *interp,         /* The interp we are using for errors. */  
     int objIndex,               /* The index of the attribute. */  
     CONST char *fileName,       /* The name of the file. */  
     Tcl_Obj **attributePtrPtr)  /* A pointer to return the object with. */  
 {  
     return ConvertFileNameFormat(interp, objIndex, fileName, 0, attributePtrPtr);  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * SetWinFileAttributes --  
  *  
  *      Set the file attributes to the value given by attributePtr.  
  *      This routine sets the -hidden, -readonly, or -system attributes.  
  *  
  * Results:  
  *      Standard TCL error.  
  *  
  * Side effects:  
  *      The file's attribute is set.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static int  
 SetWinFileAttributes(  
     Tcl_Interp *interp,         /* The interp we are using for errors. */  
     int objIndex,               /* The index of the attribute. */  
     CONST char *fileName,       /* The name of the file. */  
     Tcl_Obj *attributePtr)      /* The new value of the attribute. */  
 {  
     DWORD fileAttributes;  
     int yesNo;  
     int result;  
     Tcl_DString ds;  
     TCHAR *nativeName;  
   
     nativeName = Tcl_WinUtfToTChar(fileName, -1, &ds);  
     fileAttributes = (*tclWinProcs->getFileAttributesProc)(nativeName);  
   
     if (fileAttributes == 0xffffffff) {  
         StatError(interp, fileName);  
         result = TCL_ERROR;  
         goto end;  
     }  
   
     result = Tcl_GetBooleanFromObj(interp, attributePtr, &yesNo);  
     if (result != TCL_OK) {  
         goto end;  
     }  
   
     if (yesNo) {  
         fileAttributes |= (attributeArray[objIndex]);  
     } else {  
         fileAttributes &= ~(attributeArray[objIndex]);  
     }  
   
     if (!(*tclWinProcs->setFileAttributesProc)(nativeName, fileAttributes)) {  
         StatError(interp, fileName);  
         result = TCL_ERROR;  
         goto end;  
     }  
   
     end:  
     Tcl_DStringFree(&ds);  
   
     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 pertinant error message.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static int  
 CannotSetAttribute(  
     Tcl_Interp *interp,         /* The interp we are using for errors. */  
     int objIndex,               /* The index of the attribute. */  
     CONST char *fileName,       /* The name of the file. */  
     Tcl_Obj *attributePtr)      /* The new value of the attribute. */  
 {  
     Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),  
             "cannot set attribute \"", tclpFileAttrStrings[objIndex],  
             "\" for file \"", fileName, "\": attribute is readonly",  
             (char *) NULL);  
     return TCL_ERROR;  
 }  
   
   
 /*  
  *---------------------------------------------------------------------------  
  *  
  * TclpListVolumes --  
  *  
  *      Lists the currently mounted volumes  
  *  
  * Results:  
  *      A standard Tcl result.  Will always be TCL_OK, since there is no way  
  *      that this command can fail.  Also, the interpreter's result is set to  
  *      the list of volumes.  
  *  
  * Side effects:  
  *      None  
  *  
  *---------------------------------------------------------------------------  
  */  
   
 int  
 TclpListVolumes(  
     Tcl_Interp *interp)         /* Interpreter for returning volume list. */  
 {  
     Tcl_Obj *resultPtr, *elemPtr;  
     char buf[40 * 4];           /* There couldn't be more than 30 drives??? */  
     int i;  
     char *p;  
   
     resultPtr = Tcl_GetObjResult(interp);  
   
     /*  
      * 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);  
         }  
     }  
     return TCL_OK;        
 }  
   
   
 /* $History: tclwinfcmd.c $  
  *  
  * *****************  Version 1  *****************  
  * User: Dtashley     Date: 1/02/01    Time: 12:39a  
  * Created in $/IjuScripter, IjuConsole/Source/Tcl Base  
  * Initial check-in.  
  */  
   
 /* End of TCLWINFCMD.C */  
1    /* $Header$ */
2    /*
3     * tclWinFCmd.c
4     *
5     *      This file implements the Windows specific portion of file manipulation
6     *      subcommands of the "file" command.
7     *
8     * Copyright (c) 1996-1998 Sun Microsystems, Inc.
9     *
10     * See the file "license.terms" for information on usage and redistribution
11     * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
12     *
13     * RCS: @(#) $Id: tclwinfcmd.c,v 1.1.1.1 2001/06/13 04:49:02 dtashley Exp $
14     */
15    
16    #include "tclWinInt.h"
17    
18    /*
19     * The following constants specify the type of callback when
20     * TraverseWinTree() calls the traverseProc()
21     */
22    
23    #define DOTREE_PRED   1     /* pre-order directory  */
24    #define DOTREE_POSTD  2     /* post-order directory */
25    #define DOTREE_F      3     /* regular file */
26    
27    /*
28     * Callbacks for file attributes code.
29     */
30    
31    static int              GetWinFileAttributes _ANSI_ARGS_((Tcl_Interp *interp,
32                                int objIndex, CONST char *fileName,
33                                Tcl_Obj **attributePtrPtr));
34    static int              GetWinFileLongName _ANSI_ARGS_((Tcl_Interp *interp,
35                                int objIndex, CONST char *fileName,
36                                Tcl_Obj **attributePtrPtr));
37    static int              GetWinFileShortName _ANSI_ARGS_((Tcl_Interp *interp,
38                                int objIndex, CONST char *fileName,
39                                Tcl_Obj **attributePtrPtr));
40    static int              SetWinFileAttributes _ANSI_ARGS_((Tcl_Interp *interp,
41                                int objIndex, CONST char *fileName,
42                                Tcl_Obj *attributePtr));
43    static int              CannotSetAttribute _ANSI_ARGS_((Tcl_Interp *interp,
44                                int objIndex, CONST char *fileName,
45                                Tcl_Obj *attributePtr));
46    
47    /*
48     * Constants and variables necessary for file attributes subcommand.
49     */
50    
51    enum {
52        WIN_ARCHIVE_ATTRIBUTE,
53        WIN_HIDDEN_ATTRIBUTE,
54        WIN_LONGNAME_ATTRIBUTE,
55        WIN_READONLY_ATTRIBUTE,
56        WIN_SHORTNAME_ATTRIBUTE,
57        WIN_SYSTEM_ATTRIBUTE
58    };
59    
60    static int attributeArray[] = {FILE_ATTRIBUTE_ARCHIVE, FILE_ATTRIBUTE_HIDDEN,
61            0, FILE_ATTRIBUTE_READONLY, 0, FILE_ATTRIBUTE_SYSTEM};
62    
63    
64    char *tclpFileAttrStrings[] = {
65            "-archive", "-hidden", "-longname", "-readonly",
66            "-shortname", "-system", (char *) NULL
67    };
68    
69    const TclFileAttrProcs tclpFileAttrProcs[] = {
70            {GetWinFileAttributes, SetWinFileAttributes},
71            {GetWinFileAttributes, SetWinFileAttributes},
72            {GetWinFileLongName, CannotSetAttribute},
73            {GetWinFileAttributes, SetWinFileAttributes},
74            {GetWinFileShortName, CannotSetAttribute},
75            {GetWinFileAttributes, SetWinFileAttributes}};
76    
77    /*
78     * Prototype for the TraverseWinTree callback function.
79     */
80    
81    typedef int (TraversalProc)(Tcl_DString *srcPtr, Tcl_DString *dstPtr,
82            int type, Tcl_DString *errorPtr);
83    
84    /*
85     * Declarations for local procedures defined in this file:
86     */
87    
88    static void             StatError(Tcl_Interp *interp, CONST char *fileName);
89    static int              ConvertFileNameFormat(Tcl_Interp *interp,
90                                int objIndex, CONST char *fileName, int longShort,
91                                Tcl_Obj **attributePtrPtr);
92    static int              DoCopyFile(Tcl_DString *srcPtr, Tcl_DString *dstPtr);
93    static int              DoCreateDirectory(Tcl_DString *pathPtr);
94    static int              DoDeleteFile(Tcl_DString *pathPtr);
95    static int              DoRemoveDirectory(Tcl_DString *pathPtr, int recursive,
96                                Tcl_DString *errorPtr);
97    static int              DoRenameFile(const TCHAR *nativeSrc, Tcl_DString *dstPtr);
98    static int              TraversalCopy(Tcl_DString *srcPtr, Tcl_DString *dstPtr,
99                                int type, Tcl_DString *errorPtr);
100    static int              TraversalDelete(Tcl_DString *srcPtr, Tcl_DString *dstPtr,
101                                int type, Tcl_DString *errorPtr);
102    static int              TraverseWinTree(TraversalProc *traverseProc,
103                                Tcl_DString *sourcePtr, Tcl_DString *dstPtr,
104                                Tcl_DString *errorPtr);
105    
106    
107    /*
108     *---------------------------------------------------------------------------
109     *
110     * TclpRenameFile, DoRenameFile --
111     *
112     *      Changes the name of an existing file or directory, from src to dst.
113     *      If src and dst refer to the same file or directory, does nothing
114     *      and returns success.  Otherwise if dst already exists, it will be
115     *      deleted and replaced by src subject to the following conditions:
116     *          If src is a directory, dst may be an empty directory.
117     *          If src is a file, dst may be a file.
118     *      In any other situation where dst already exists, the rename will
119     *      fail.  
120     *
121     * Results:
122     *      If the file or directory was successfully renamed, returns TCL_OK.
123     *      Otherwise the return value is TCL_ERROR and errno is set to
124     *      indicate the error.  Some possible values for errno are:
125     *
126     *      ENAMETOOLONG: src or dst names are too long.
127     *      EACCES:     src or dst parent directory can't be read and/or written.
128     *      EEXIST:     dst is a non-empty directory.
129     *      EINVAL:     src is a root directory or dst is a subdirectory of src.
130     *      EISDIR:     dst is a directory, but src is not.
131     *      ENOENT:     src doesn't exist.  src or dst is "".
132     *      ENOTDIR:    src is a directory, but dst is not.  
133     *      EXDEV:      src and dst are on different filesystems.
134     *
135     *      EACCES:     exists an open file already referring to src or dst.
136     *      EACCES:     src or dst specify the current working directory (NT).
137     *      EACCES:     src specifies a char device (nul:, com1:, etc.)
138     *      EEXIST:     dst specifies a char device (nul:, com1:, etc.) (NT)
139     *      EACCES:     dst specifies a char device (nul:, com1:, etc.) (95)
140     *      
141     * Side effects:
142     *      The implementation supports cross-filesystem renames of files,
143     *      but the caller should be prepared to emulate cross-filesystem
144     *      renames of directories if errno is EXDEV.
145     *
146     *---------------------------------------------------------------------------
147     */
148    
149    int
150    TclpRenameFile(
151        CONST char *src,            /* Pathname of file or dir to be renamed
152                                     * (UTF-8). */
153        CONST char *dst)            /* New pathname of file or directory
154                                     * (UTF-8). */
155    {
156        int result;
157        TCHAR *nativeSrc;
158        Tcl_DString srcString, dstString;
159    
160        nativeSrc = Tcl_WinUtfToTChar(src, -1, &srcString);
161        Tcl_WinUtfToTChar(dst, -1, &dstString);
162    
163        result = DoRenameFile(nativeSrc, &dstString);
164        Tcl_DStringFree(&srcString);
165        Tcl_DStringFree(&dstString);
166        return result;
167    }
168    
169    static int
170    DoRenameFile(
171        CONST TCHAR *nativeSrc,     /* Pathname of file or dir to be renamed
172                                     * (native). */
173        Tcl_DString *dstPtr)        /* New pathname for file or directory
174                                     * (native). */
175    {    
176        const TCHAR *nativeDst;
177        DWORD srcAttr, dstAttr;
178    
179        nativeDst = (TCHAR *) Tcl_DStringValue(dstPtr);
180    
181        /*
182         * Would throw an exception under NT if one of the arguments is a
183         * char block device.
184         */
185    
186        __try {
187            if ((*tclWinProcs->moveFileProc)(nativeSrc, nativeDst) != FALSE) {
188                return TCL_OK;
189            }
190        } __except (-1) {}
191    
192        TclWinConvertError(GetLastError());
193    
194        srcAttr = (*tclWinProcs->getFileAttributesProc)(nativeSrc);
195        dstAttr = (*tclWinProcs->getFileAttributesProc)(nativeDst);
196        if (srcAttr == 0xffffffff) {
197            if ((*tclWinProcs->getFullPathNameProc)(nativeSrc, 0, NULL, NULL) >= MAX_PATH) {
198                errno = ENAMETOOLONG;
199                return TCL_ERROR;
200            }
201            srcAttr = 0;
202        }
203        if (dstAttr == 0xffffffff) {
204            if ((*tclWinProcs->getFullPathNameProc)(nativeDst, 0, NULL, NULL) >= MAX_PATH) {
205                errno = ENAMETOOLONG;
206                return TCL_ERROR;
207            }
208            dstAttr = 0;
209        }
210    
211        if (errno == EBADF) {
212            errno = EACCES;
213            return TCL_ERROR;
214        }
215        if (errno == EACCES) {
216            decode:
217            if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) {
218                TCHAR *nativeSrcRest, *nativeDstRest;
219                char **srcArgv, **dstArgv;
220                int size, srcArgc, dstArgc;
221                WCHAR nativeSrcPath[MAX_PATH];
222                WCHAR nativeDstPath[MAX_PATH];
223                Tcl_DString srcString, dstString;
224                CONST char *src, *dst;
225    
226                size = (*tclWinProcs->getFullPathNameProc)(nativeSrc, MAX_PATH,
227                        nativeSrcPath, &nativeSrcRest);
228                if ((size == 0) || (size > MAX_PATH)) {
229                    return TCL_ERROR;
230                }
231                size = (*tclWinProcs->getFullPathNameProc)(nativeDst, MAX_PATH,
232                        nativeDstPath, &nativeDstRest);
233                if ((size == 0) || (size > MAX_PATH)) {
234                    return TCL_ERROR;
235                }
236                (*tclWinProcs->charLowerProc)((TCHAR *) nativeSrcPath);
237                (*tclWinProcs->charLowerProc)((TCHAR *) nativeDstPath);
238    
239                src = Tcl_WinTCharToUtf((TCHAR *) nativeSrcPath, -1, &srcString);
240                dst = Tcl_WinTCharToUtf((TCHAR *) nativeDstPath, -1, &dstString);
241                if (strncmp(src, dst, Tcl_DStringLength(&srcString)) == 0) {
242                    /*
243                     * Trying to move a directory into itself.
244                     */
245    
246                    errno = EINVAL;
247                    Tcl_DStringFree(&srcString);
248                    Tcl_DStringFree(&dstString);
249                    return TCL_ERROR;
250                }
251                Tcl_SplitPath(src, &srcArgc, &srcArgv);
252                Tcl_SplitPath(dst, &dstArgc, &dstArgv);
253                Tcl_DStringFree(&srcString);
254                Tcl_DStringFree(&dstString);
255    
256                if (srcArgc == 1) {
257                    /*
258                     * They are trying to move a root directory.  Whether
259                     * or not it is across filesystems, this cannot be
260                     * done.
261                     */
262    
263                    Tcl_SetErrno(EINVAL);
264                } else if ((srcArgc > 0) && (dstArgc > 0) &&
265                        (strcmp(srcArgv[0], dstArgv[0]) != 0)) {
266                    /*
267                     * If src is a directory and dst filesystem != src
268                     * filesystem, errno should be EXDEV.  It is very
269                     * important to get this behavior, so that the caller
270                     * can respond to a cross filesystem rename by
271                     * simulating it with copy and delete.  The MoveFile
272                     * system call already handles the case of moving a
273                     * file between filesystems.
274                     */
275    
276                    Tcl_SetErrno(EXDEV);
277                }
278    
279                ckfree((char *) srcArgv);
280                ckfree((char *) dstArgv);
281            }
282    
283            /*
284             * Other types of access failure is that dst is a read-only
285             * filesystem, that an open file referred to src or dest, or that
286             * src or dest specified the current working directory on the
287             * current filesystem.  EACCES is returned for those cases.
288             */
289    
290        } else if (Tcl_GetErrno() == EEXIST) {
291            /*
292             * Reports EEXIST any time the target already exists.  If it makes
293             * sense, remove the old file and try renaming again.
294             */
295    
296            if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) {
297                if (dstAttr & FILE_ATTRIBUTE_DIRECTORY) {
298                    /*
299                     * Overwrite empty dst directory with src directory.  The
300                     * following call will remove an empty directory.  If it
301                     * fails, it's because it wasn't empty.
302                     */
303    
304                    if (DoRemoveDirectory(dstPtr, 0, NULL) == TCL_OK) {
305                        /*
306                         * Now that that empty directory is gone, we can try
307                         * renaming again.  If that fails, we'll put this empty
308                         * directory back, for completeness.
309                         */
310    
311                        if ((*tclWinProcs->moveFileProc)(nativeSrc, nativeDst) != FALSE) {
312                            return TCL_OK;
313                        }
314    
315                        /*
316                         * Some new error has occurred.  Don't know what it
317                         * could be, but report this one.
318                         */
319    
320                        TclWinConvertError(GetLastError());
321                        (*tclWinProcs->createDirectoryProc)(nativeDst, NULL);
322                        (*tclWinProcs->setFileAttributesProc)(nativeDst, dstAttr);
323                        if (Tcl_GetErrno() == EACCES) {
324                            /*
325                             * Decode the EACCES to a more meaningful error.
326                             */
327    
328                            goto decode;
329                        }
330                    }
331                } else {    /* (dstAttr & FILE_ATTRIBUTE_DIRECTORY) == 0 */
332                    Tcl_SetErrno(ENOTDIR);
333                }
334            } else {    /* (srcAttr & FILE_ATTRIBUTE_DIRECTORY) == 0 */
335                if (dstAttr & FILE_ATTRIBUTE_DIRECTORY) {
336                    Tcl_SetErrno(EISDIR);
337                } else {
338                    /*
339                     * Overwrite existing file by:
340                     *
341                     * 1. Rename existing file to temp name.
342                     * 2. Rename old file to new name.
343                     * 3. If success, delete temp file.  If failure,
344                     *    put temp file back to old name.
345                     */
346    
347                    TCHAR *nativeRest, *nativeTmp, *nativePrefix;
348                    int result, size;
349                    WCHAR tempBuf[MAX_PATH];
350                    
351                    size = (*tclWinProcs->getFullPathNameProc)(nativeDst, MAX_PATH,
352                            tempBuf, &nativeRest);
353                    if ((size == 0) || (size > MAX_PATH) || (nativeRest == NULL)) {
354                        return TCL_ERROR;
355                    }
356                    nativeTmp = (TCHAR *) tempBuf;
357                    ((char *) nativeRest)[0] = '\0';
358                    ((char *) nativeRest)[1] = '\0';    /* In case it's Unicode. */
359    
360                    result = TCL_ERROR;
361                    nativePrefix = (tclWinProcs->useWide)
362                            ? (TCHAR *) L"tclr" : (TCHAR *) "tclr";
363                    if ((*tclWinProcs->getTempFileNameProc)(nativeTmp,
364                            nativePrefix, 0, tempBuf) != 0) {
365                        /*
366                         * Strictly speaking, need the following DeleteFile and
367                         * MoveFile to be joined as an atomic operation so no
368                         * other app comes along in the meantime and creates the
369                         * same temp file.
370                         */
371                        
372                        nativeTmp = (TCHAR *) tempBuf;
373                        (*tclWinProcs->deleteFileProc)(nativeTmp);
374                        if ((*tclWinProcs->moveFileProc)(nativeDst, nativeTmp) != FALSE) {
375                            if ((*tclWinProcs->moveFileProc)(nativeSrc, nativeDst) != FALSE) {
376                                (*tclWinProcs->setFileAttributesProc)(nativeTmp,
377                                        FILE_ATTRIBUTE_NORMAL);
378                                (*tclWinProcs->deleteFileProc)(nativeTmp);
379                                return TCL_OK;
380                            } else {
381                                (*tclWinProcs->deleteFileProc)(nativeDst);
382                                (*tclWinProcs->moveFileProc)(nativeTmp, nativeDst);
383                            }
384                        }
385    
386                        /*
387                         * Can't backup dst file or move src file.  Return that
388                         * error.  Could happen if an open file refers to dst.
389                         */
390    
391                        TclWinConvertError(GetLastError());
392                        if (Tcl_GetErrno() == EACCES) {
393                            /*
394                             * Decode the EACCES to a more meaningful error.
395                             */
396    
397                            goto decode;
398                        }
399                    }
400                    return result;
401                }
402            }
403        }
404        return TCL_ERROR;
405    }
406    
407    /*
408     *---------------------------------------------------------------------------
409     *
410     * TclpCopyFile, DoCopyFile --
411     *
412     *      Copy a single file (not a directory).  If dst already exists and
413     *      is not a directory, it is removed.
414     *
415     * Results:
416     *      If the file was successfully copied, returns TCL_OK.  Otherwise
417     *      the return value is TCL_ERROR and errno is set to indicate the
418     *      error.  Some possible values for errno are:
419     *
420     *      EACCES:     src or dst parent directory can't be read and/or written.
421     *      EISDIR:     src or dst is a directory.
422     *      ENOENT:     src doesn't exist.  src or dst is "".
423     *
424     *      EACCES:     exists an open file already referring to dst (95).
425     *      EACCES:     src specifies a char device (nul:, com1:, etc.) (NT)
426     *      ENOENT:     src specifies a char device (nul:, com1:, etc.) (95)
427     *
428     * Side effects:
429     *      It is not an error to copy to a char device.
430     *
431     *---------------------------------------------------------------------------
432     */
433    
434    int
435    TclpCopyFile(
436        CONST char *src,            /* Pathname of file to be copied (UTF-8). */
437        CONST char *dst)            /* Pathname of file to copy to (UTF-8). */
438    {
439        int result;
440        Tcl_DString srcString, dstString;
441    
442        Tcl_WinUtfToTChar(src, -1, &srcString);
443        Tcl_WinUtfToTChar(dst, -1, &dstString);
444        result = DoCopyFile(&srcString, &dstString);
445        Tcl_DStringFree(&srcString);
446        Tcl_DStringFree(&dstString);
447        return result;
448    }
449    
450    static int
451    DoCopyFile(
452        Tcl_DString *srcPtr,        /* Pathname of file to be copied (native). */
453        Tcl_DString *dstPtr)        /* Pathname of file to copy to (native). */
454    {
455        CONST TCHAR *nativeSrc, *nativeDst;
456    
457        nativeSrc = (TCHAR *) Tcl_DStringValue(srcPtr);
458        nativeDst = (TCHAR *) Tcl_DStringValue(dstPtr);
459    
460        /*
461         * Would throw an exception under NT if one of the arguments is a char
462         * block device.
463         */
464    
465        __try {
466            if ((*tclWinProcs->copyFileProc)(nativeSrc, nativeDst, 0) != FALSE) {
467                return TCL_OK;
468            }
469        } __except (-1) {}
470    
471        TclWinConvertError(GetLastError());
472        if (Tcl_GetErrno() == EBADF) {
473            Tcl_SetErrno(EACCES);
474            return TCL_ERROR;
475        }
476        if (Tcl_GetErrno() == EACCES) {
477            DWORD srcAttr, dstAttr;
478    
479            srcAttr = (*tclWinProcs->getFileAttributesProc)(nativeSrc);
480            dstAttr = (*tclWinProcs->getFileAttributesProc)(nativeDst);
481            if (srcAttr != 0xffffffff) {
482                if (dstAttr == 0xffffffff) {
483                    dstAttr = 0;
484                }
485                if ((srcAttr & FILE_ATTRIBUTE_DIRECTORY) ||
486                        (dstAttr & FILE_ATTRIBUTE_DIRECTORY)) {
487                    Tcl_SetErrno(EISDIR);
488                }
489                if (dstAttr & FILE_ATTRIBUTE_READONLY) {
490                    (*tclWinProcs->setFileAttributesProc)(nativeDst,
491                            dstAttr & ~FILE_ATTRIBUTE_READONLY);
492                    if ((*tclWinProcs->copyFileProc)(nativeSrc, nativeDst, 0) != FALSE) {
493                        return TCL_OK;
494                    }
495                    /*
496                     * Still can't copy onto dst.  Return that error, and
497                     * restore attributes of dst.
498                     */
499    
500                    TclWinConvertError(GetLastError());
501                    (*tclWinProcs->setFileAttributesProc)(nativeDst, dstAttr);
502                }
503            }
504        }
505        return TCL_ERROR;
506    }
507    
508    /*
509     *---------------------------------------------------------------------------
510     *
511     * TclpDeleteFile, DoDeleteFile --
512     *
513     *      Removes a single file (not a directory).
514     *
515     * Results:
516     *      If the file was successfully deleted, returns TCL_OK.  Otherwise
517     *      the return value is TCL_ERROR and errno is set to indicate the
518     *      error.  Some possible values for errno are:
519     *
520     *      EACCES:     a parent directory can't be read and/or written.
521     *      EISDIR:     path is a directory.
522     *      ENOENT:     path doesn't exist or is "".
523     *
524     *      EACCES:     exists an open file already referring to path.
525     *      EACCES:     path is a char device (nul:, com1:, etc.)
526     *
527     * Side effects:
528     *      The file is deleted, even if it is read-only.
529     *
530     *---------------------------------------------------------------------------
531     */
532    
533    int
534    TclpDeleteFile(
535        CONST char *path)           /* Pathname of file to be removed (UTF-8). */
536    {
537        int result;
538        Tcl_DString pathString;
539    
540        Tcl_WinUtfToTChar(path, -1, &pathString);
541        result = DoDeleteFile(&pathString);
542        Tcl_DStringFree(&pathString);
543        return result;
544    }
545    
546    static int
547    DoDeleteFile(
548        Tcl_DString *pathPtr)       /* Pathname of file to be removed (native). */
549    {
550        DWORD attr;
551        CONST TCHAR *nativePath;
552    
553        nativePath = (TCHAR *) Tcl_DStringValue(pathPtr);
554        
555        if ((*tclWinProcs->deleteFileProc)(nativePath) != FALSE) {
556            return TCL_OK;
557        }
558        TclWinConvertError(GetLastError());
559    
560        /*
561         * Win32s thinks that "" is the same as "." and then reports EISDIR
562         * instead of ENOENT.
563         */
564    
565        if (tclWinProcs->useWide) {
566            if (((WCHAR *) nativePath)[0] == '\0') {
567                Tcl_SetErrno(ENOENT);
568                return TCL_ERROR;
569            }
570        } else {
571            if (((char *) nativePath)[0] == '\0') {
572                Tcl_SetErrno(ENOENT);
573                return TCL_ERROR;
574            }
575        }
576        if (Tcl_GetErrno() == EACCES) {
577            attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
578            if (attr != 0xffffffff) {
579                if (attr & FILE_ATTRIBUTE_DIRECTORY) {
580                    /*
581                     * Windows NT reports removing a directory as EACCES instead
582                     * of EISDIR.
583                     */
584    
585                    Tcl_SetErrno(EISDIR);
586                } else if (attr & FILE_ATTRIBUTE_READONLY) {
587                    (*tclWinProcs->setFileAttributesProc)(nativePath,
588                            attr & ~FILE_ATTRIBUTE_READONLY);
589                    if ((*tclWinProcs->deleteFileProc)(nativePath) != FALSE) {
590                        return TCL_OK;
591                    }
592                    TclWinConvertError(GetLastError());
593                    (*tclWinProcs->setFileAttributesProc)(nativePath, attr);
594                }
595            }
596        } else if (Tcl_GetErrno() == ENOENT) {
597            attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
598            if (attr != 0xffffffff) {
599                if (attr & FILE_ATTRIBUTE_DIRECTORY) {
600                    /*
601                     * Windows 95 reports removing a directory as ENOENT instead
602                     * of EISDIR.
603                     */
604    
605                    Tcl_SetErrno(EISDIR);
606                }
607            }
608        } else if (Tcl_GetErrno() == EINVAL) {
609            /*
610             * Windows NT reports removing a char device as EINVAL instead of
611             * EACCES.
612             */
613    
614            Tcl_SetErrno(EACCES);
615        }
616    
617        return TCL_ERROR;
618    }
619    
620    /*
621     *---------------------------------------------------------------------------
622     *
623     * TclpCreateDirectory --
624     *
625     *      Creates the specified directory.  All parent directories of the
626     *      specified directory must already exist.  The directory is
627     *      automatically created with permissions so that user can access
628     *      the new directory and create new files or subdirectories in it.
629     *
630     * Results:
631     *      If the directory was successfully created, returns TCL_OK.
632     *      Otherwise the return value is TCL_ERROR and errno is set to
633     *      indicate the error.  Some possible values for errno are:
634     *
635     *      EACCES:     a parent directory can't be read and/or written.
636     *      EEXIST:     path already exists.
637     *      ENOENT:     a parent directory doesn't exist.
638     *
639     * Side effects:
640     *      A directory is created.
641     *
642     *---------------------------------------------------------------------------
643     */
644    
645    int
646    TclpCreateDirectory(
647        CONST char *path)           /* Pathname of directory to create (UTF-8). */
648    {
649        int result;
650        Tcl_DString pathString;
651    
652        Tcl_WinUtfToTChar(path, -1, &pathString);
653        result = DoCreateDirectory(&pathString);
654        Tcl_DStringFree(&pathString);
655        return result;
656    }
657    
658    static int
659    DoCreateDirectory(
660        Tcl_DString *pathPtr)       /* Pathname of directory to create (native). */
661    {
662        int error;
663        CONST TCHAR *nativePath;
664    
665        nativePath = (TCHAR *) Tcl_DStringValue(pathPtr);
666        if ((*tclWinProcs->createDirectoryProc)(nativePath, NULL) == 0) {
667            error = GetLastError();
668            TclWinConvertError(error);
669            return TCL_ERROR;
670        }  
671        return TCL_OK;
672    }
673    
674    /*
675     *---------------------------------------------------------------------------
676     *
677     * TclpCopyDirectory --
678     *
679     *      Recursively copies a directory.  The target directory dst must
680     *      not already exist.  Note that this function does not merge two
681     *      directory hierarchies, even if the target directory is an an
682     *      empty directory.
683     *
684     * Results:
685     *      If the directory was successfully copied, returns TCL_OK.
686     *      Otherwise the return value is TCL_ERROR, errno is set to indicate
687     *      the error, and the pathname of the file that caused the error
688     *      is stored in errorPtr.  See TclpCreateDirectory and TclpCopyFile
689     *      for a description of possible values for errno.
690     *
691     * Side effects:
692     *      An exact copy of the directory hierarchy src will be created
693     *      with the name dst.  If an error occurs, the error will
694     *      be returned immediately, and remaining files will not be
695     *      processed.
696     *
697     *---------------------------------------------------------------------------
698     */
699    
700    int
701    TclpCopyDirectory(
702        CONST char *src,            /* Pathname of directory to be copied
703                                     * (UTF-8). */
704        CONST char *dst,            /* Pathname of target directory (UTF-8). */
705        Tcl_DString *errorPtr)      /* If non-NULL, uninitialized or free
706                                     * DString filled with UTF-8 name of file
707                                     * causing error. */
708    {
709        int result;
710        Tcl_DString srcString, dstString;
711    
712        Tcl_WinUtfToTChar(src, -1, &srcString);
713        Tcl_WinUtfToTChar(dst, -1, &dstString);
714    
715        result = TraverseWinTree(TraversalCopy, &srcString, &dstString, errorPtr);
716    
717        Tcl_DStringFree(&srcString);
718        Tcl_DStringFree(&dstString);
719        return result;
720    }
721    
722    /*
723     *----------------------------------------------------------------------
724     *
725     * TclpRemoveDirectory, DoRemoveDirectory --
726     *
727     *      Removes directory (and its contents, if the recursive flag is set).
728     *
729     * Results:
730     *      If the directory was successfully removed, returns TCL_OK.
731     *      Otherwise the return value is TCL_ERROR, errno is set to indicate
732     *      the error, and the pathname of the file that caused the error
733     *      is stored in errorPtr.  Some possible values for errno are:
734     *
735     *      EACCES:     path directory can't be read and/or written.
736     *      EEXIST:     path is a non-empty directory.
737     *      EINVAL:     path is root directory or current directory.
738     *      ENOENT:     path doesn't exist or is "".
739     *      ENOTDIR:    path is not a directory.
740     *
741     *      EACCES:     path is a char device (nul:, com1:, etc.) (95)
742     *      EINVAL:     path is a char device (nul:, com1:, etc.) (NT)
743     *
744     * Side effects:
745     *      Directory removed.  If an error occurs, the error will be returned
746     *      immediately, and remaining files will not be deleted.
747     *
748     *----------------------------------------------------------------------
749     */
750    
751    int
752    TclpRemoveDirectory(
753        CONST char *path,           /* Pathname of directory to be removed
754                                     * (UTF-8). */
755        int recursive,              /* If non-zero, removes directories that
756                                     * are nonempty.  Otherwise, will only remove
757                                     * empty directories. */
758        Tcl_DString *errorPtr)      /* If non-NULL, uninitialized or free
759                                     * DString filled with UTF-8 name of file
760                                     * causing error. */
761    {
762        int result;
763        Tcl_DString pathString;
764    
765        Tcl_WinUtfToTChar(path, -1, &pathString);
766        result = DoRemoveDirectory(&pathString, recursive, errorPtr);
767        Tcl_DStringFree(&pathString);
768    
769        return result;
770    }
771    
772    static int
773    DoRemoveDirectory(
774        Tcl_DString *pathPtr,       /* Pathname of directory to be removed
775                                     * (native). */
776        int recursive,              /* If non-zero, removes directories that
777                                     * are nonempty.  Otherwise, will only remove
778                                     * empty directories. */
779        Tcl_DString *errorPtr)      /* If non-NULL, uninitialized or free
780                                     * DString filled with UTF-8 name of file
781                                     * causing error. */
782    {
783        CONST TCHAR *nativePath;
784        DWORD attr;
785    
786        nativePath = (TCHAR *) Tcl_DStringValue(pathPtr);
787    
788        if ((*tclWinProcs->removeDirectoryProc)(nativePath) != FALSE) {
789            return TCL_OK;
790        }
791        TclWinConvertError(GetLastError());
792    
793        /*
794         * Win32s thinks that "" is the same as "." and then reports EACCES
795         * instead of ENOENT.
796         */
797    
798    
799        if (tclWinProcs->useWide) {
800            if (((WCHAR *) nativePath)[0] == '\0') {
801                Tcl_SetErrno(ENOENT);
802                return TCL_ERROR;
803            }
804        } else {
805            if (((char *) nativePath)[0] == '\0') {
806                Tcl_SetErrno(ENOENT);
807                return TCL_ERROR;
808            }
809        }
810        if (Tcl_GetErrno() == EACCES) {
811            attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
812            if (attr != 0xffffffff) {
813                if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
814                    /*
815                     * Windows 95 reports calling RemoveDirectory on a file as an
816                     * EACCES, not an ENOTDIR.
817                     */
818                    
819                    Tcl_SetErrno(ENOTDIR);
820                    goto end;
821                }
822    
823                if (attr & FILE_ATTRIBUTE_READONLY) {
824                    attr &= ~FILE_ATTRIBUTE_READONLY;
825                    if ((*tclWinProcs->setFileAttributesProc)(nativePath, attr) == FALSE) {
826                        goto end;
827                    }
828                    if ((*tclWinProcs->removeDirectoryProc)(nativePath) != FALSE) {
829                        return TCL_OK;
830                    }
831                    TclWinConvertError(GetLastError());
832                    (*tclWinProcs->setFileAttributesProc)(nativePath,
833                            attr | FILE_ATTRIBUTE_READONLY);
834                }
835    
836                /*
837                 * Windows 95 and Win32s report removing a non-empty directory
838                 * as EACCES, not EEXIST.  If the directory is not empty,
839                 * change errno so caller knows what's going on.
840                 */
841    
842                if (TclWinGetPlatformId() != VER_PLATFORM_WIN32_NT) {
843                    char *path, *find;
844                    HANDLE handle;
845                    WIN32_FIND_DATAA data;
846                    Tcl_DString buffer;
847                    int len;
848    
849                    path = (char *) nativePath;
850    
851                    Tcl_DStringInit(&buffer);
852                    len = strlen(path);
853                    find = Tcl_DStringAppend(&buffer, path, len);
854                    if ((len > 0) && (find[len - 1] != '\\')) {
855                        Tcl_DStringAppend(&buffer, "\\", 1);
856                    }
857                    find = Tcl_DStringAppend(&buffer, "*.*", 3);
858                    handle = FindFirstFileA(find, &data);
859                    if (handle != INVALID_HANDLE_VALUE) {
860                        while (1) {
861                            if ((strcmp(data.cFileName, ".") != 0)
862                                    && (strcmp(data.cFileName, "..") != 0)) {
863                                /*
864                                 * Found something in this directory.
865                                 */
866    
867                                Tcl_SetErrno(EEXIST);
868                                break;
869                            }
870                            if (FindNextFileA(handle, &data) == FALSE) {
871                                break;
872                            }
873                        }
874                        FindClose(handle);
875                    }
876                    Tcl_DStringFree(&buffer);
877                }
878            }
879        }
880        if (Tcl_GetErrno() == ENOTEMPTY) {
881            /*
882             * The caller depends on EEXIST to signify that the directory is
883             * not empty, not ENOTEMPTY.
884             */
885    
886            Tcl_SetErrno(EEXIST);
887        }
888        if ((recursive != 0) && (Tcl_GetErrno() == EEXIST)) {
889            /*
890             * The directory is nonempty, but the recursive flag has been
891             * specified, so we recursively remove all the files in the directory.
892             */
893    
894            return TraverseWinTree(TraversalDelete, pathPtr, NULL, errorPtr);
895        }
896        
897        end:
898        if (errorPtr != NULL) {
899            Tcl_WinTCharToUtf(nativePath, -1, errorPtr);
900        }
901        return TCL_ERROR;
902    }
903    
904    /*
905     *---------------------------------------------------------------------------
906     *
907     * TraverseWinTree --
908     *
909     *      Traverse directory tree specified by sourcePtr, calling the function
910     *      traverseProc for each file and directory encountered.  If destPtr
911     *      is non-null, each of name in the sourcePtr directory is appended to
912     *      the directory specified by destPtr and passed as the second argument
913     *      to traverseProc() .
914     *
915     * Results:
916     *      Standard Tcl result.
917     *
918     * Side effects:
919     *      None caused by TraverseWinTree, however the user specified
920     *      traverseProc() may change state.  If an error occurs, the error will
921     *      be returned immediately, and remaining files will not be processed.
922     *
923     *---------------------------------------------------------------------------
924     */
925    
926    static int
927    TraverseWinTree(
928        TraversalProc *traverseProc,/* Function to call for every file and
929                                     * directory in source hierarchy. */
930        Tcl_DString *sourcePtr,     /* Pathname of source directory to be
931                                     * traversed (native). */
932        Tcl_DString *targetPtr,     /* Pathname of directory to traverse in
933                                     * parallel with source directory (native). */
934        Tcl_DString *errorPtr)      /* If non-NULL, uninitialized or free
935                                     * DString filled with UTF-8 name of file
936                                     * causing error. */
937    {
938        DWORD sourceAttr;
939        TCHAR *nativeSource, *nativeErrfile;
940        int result, found, sourceLen, targetLen, oldSourceLen, oldTargetLen;
941        HANDLE handle;
942        WIN32_FIND_DATAT data;
943    
944        nativeErrfile = NULL;
945        result = TCL_OK;
946        oldTargetLen = 0;           /* lint. */
947    
948        nativeSource = (TCHAR *) Tcl_DStringValue(sourcePtr);
949        oldSourceLen = Tcl_DStringLength(sourcePtr);
950        sourceAttr = (*tclWinProcs->getFileAttributesProc)(nativeSource);
951        if (sourceAttr == 0xffffffff) {
952            nativeErrfile = nativeSource;
953            goto end;
954        }
955        if ((sourceAttr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
956            /*
957             * Process the regular file
958             */
959    
960            return (*traverseProc)(sourcePtr, targetPtr, DOTREE_F, errorPtr);
961        }
962    
963        if (tclWinProcs->useWide) {
964            Tcl_DStringAppend(sourcePtr, (char *) L"\\*.*", 4 * sizeof(WCHAR) + 1);
965            Tcl_DStringSetLength(sourcePtr, Tcl_DStringLength(sourcePtr) - 1);
966        } else {
967            Tcl_DStringAppend(sourcePtr, "\\*.*", 4);
968        }
969        nativeSource = (TCHAR *) Tcl_DStringValue(sourcePtr);
970        handle = (*tclWinProcs->findFirstFileProc)(nativeSource, &data);
971        if (handle == INVALID_HANDLE_VALUE) {      
972            /*
973             * Can't read directory
974             */
975    
976            TclWinConvertError(GetLastError());
977            nativeErrfile = nativeSource;
978            goto end;
979        }
980    
981        nativeSource[oldSourceLen + 1] = '\0';
982        Tcl_DStringSetLength(sourcePtr, oldSourceLen);
983        result = (*traverseProc)(sourcePtr, targetPtr, DOTREE_PRED, errorPtr);
984        if (result != TCL_OK) {
985            FindClose(handle);
986            return result;
987        }
988    
989        sourceLen = oldSourceLen;
990    
991        if (tclWinProcs->useWide) {
992            sourceLen += sizeof(WCHAR);
993            Tcl_DStringAppend(sourcePtr, (char *) L"\\", sizeof(WCHAR) + 1);
994            Tcl_DStringSetLength(sourcePtr, sourceLen);
995        } else {
996            sourceLen += 1;
997            Tcl_DStringAppend(sourcePtr, "\\", 1);
998        }
999        if (targetPtr != NULL) {
1000            oldTargetLen = Tcl_DStringLength(targetPtr);
1001    
1002            targetLen = oldTargetLen;
1003            if (tclWinProcs->useWide) {
1004                targetLen += sizeof(WCHAR);
1005                Tcl_DStringAppend(targetPtr, (char *) L"\\", sizeof(WCHAR) + 1);
1006                Tcl_DStringSetLength(targetPtr, targetLen);
1007            } else {
1008                targetLen += 1;
1009                Tcl_DStringAppend(targetPtr, "\\", 1);
1010            }
1011        }
1012    
1013        found = 1;
1014        for ( ; found; found = (*tclWinProcs->findNextFileProc)(handle, &data)) {
1015            TCHAR *nativeName;
1016            int len;
1017    
1018            if (tclWinProcs->useWide) {
1019                WCHAR *wp;
1020    
1021                wp = data.w.cFileName;
1022                if (*wp == '.') {
1023                    wp++;
1024                    if (*wp == '.') {
1025                        wp++;
1026                    }
1027                    if (*wp == '\0') {
1028                        continue;
1029                    }
1030                }
1031                nativeName = (TCHAR *) data.w.cFileName;
1032                len = Tcl_UniCharLen(data.w.cFileName) * sizeof(WCHAR);
1033            } else {
1034                if ((strcmp(data.a.cFileName, ".") == 0)
1035                        || (strcmp(data.a.cFileName, "..") == 0)) {
1036                    continue;
1037                }
1038                nativeName = (TCHAR *) data.a.cFileName;
1039                len = strlen(data.a.cFileName);
1040            }
1041    
1042            /*
1043             * Append name after slash, and recurse on the file.
1044             */
1045    
1046            Tcl_DStringAppend(sourcePtr, (char *) nativeName, len + 1);
1047            Tcl_DStringSetLength(sourcePtr, Tcl_DStringLength(sourcePtr) - 1);
1048            if (targetPtr != NULL) {
1049                Tcl_DStringAppend(targetPtr, (char *) nativeName, len + 1);
1050                Tcl_DStringSetLength(targetPtr, Tcl_DStringLength(targetPtr) - 1);
1051            }
1052            result = TraverseWinTree(traverseProc, sourcePtr, targetPtr,
1053                    errorPtr);
1054            if (result != TCL_OK) {
1055                break;
1056            }
1057    
1058            /*
1059             * Remove name after slash.
1060             */
1061    
1062            Tcl_DStringSetLength(sourcePtr, sourceLen);
1063            if (targetPtr != NULL) {
1064                Tcl_DStringSetLength(targetPtr, targetLen);
1065            }
1066        }
1067        FindClose(handle);
1068    
1069        /*
1070         * Strip off the trailing slash we added
1071         */
1072    
1073        Tcl_DStringSetLength(sourcePtr, oldSourceLen + 1);
1074        Tcl_DStringSetLength(sourcePtr, oldSourceLen);
1075        if (targetPtr != NULL) {
1076            Tcl_DStringSetLength(targetPtr, oldTargetLen + 1);
1077            Tcl_DStringSetLength(targetPtr, oldTargetLen);
1078        }
1079        if (result == TCL_OK) {
1080            /*
1081             * Call traverseProc() on a directory after visiting all the
1082             * files in that directory.
1083             */
1084    
1085            result = (*traverseProc)(sourcePtr, targetPtr, DOTREE_POSTD,
1086                    errorPtr);
1087        }
1088        end:
1089        if (nativeErrfile != NULL) {
1090            TclWinConvertError(GetLastError());
1091            if (errorPtr != NULL) {
1092                Tcl_WinTCharToUtf(nativeErrfile, -1, errorPtr);
1093            }
1094            result = TCL_ERROR;
1095        }
1096                
1097        return result;
1098    }
1099    
1100    /*
1101     *----------------------------------------------------------------------
1102     *
1103     * TraversalCopy
1104     *
1105     *      Called from TraverseUnixTree in order to execute a recursive
1106     *      copy of a directory.
1107     *
1108     * Results:
1109     *      Standard Tcl result.
1110     *
1111     * Side effects:
1112     *      Depending on the value of type, src may be copied to dst.
1113     *      
1114     *----------------------------------------------------------------------
1115     */
1116    
1117    static int
1118    TraversalCopy(
1119        Tcl_DString *srcPtr,        /* Source pathname to copy. */
1120        Tcl_DString *dstPtr,        /* Destination pathname of copy. */
1121        int type,                   /* Reason for call - see TraverseWinTree() */
1122        Tcl_DString *errorPtr)      /* If non-NULL, initialized DString filled
1123                                     * with UTF-8 name of file causing error. */
1124    {
1125        TCHAR *nativeDst, *nativeSrc;
1126        DWORD attr;
1127    
1128        switch (type) {
1129            case DOTREE_F: {
1130                if (DoCopyFile(srcPtr, dstPtr) == TCL_OK) {
1131                    return TCL_OK;
1132                }
1133                break;
1134            }
1135            case DOTREE_PRED: {
1136                if (DoCreateDirectory(dstPtr) == TCL_OK) {
1137                    nativeSrc = (TCHAR *) Tcl_DStringValue(srcPtr);
1138                    nativeDst = (TCHAR *) Tcl_DStringValue(dstPtr);
1139                    attr = (*tclWinProcs->getFileAttributesProc)(nativeSrc);
1140                    if ((*tclWinProcs->setFileAttributesProc)(nativeDst, attr) != FALSE) {
1141                        return TCL_OK;
1142                    }
1143                    TclWinConvertError(GetLastError());
1144                }
1145                break;
1146            }
1147            case DOTREE_POSTD: {
1148                return TCL_OK;
1149            }
1150        }
1151    
1152        /*
1153         * There shouldn't be a problem with src, because we already
1154         * checked it to get here.
1155         */
1156    
1157        if (errorPtr != NULL) {
1158            nativeDst = (TCHAR *) Tcl_DStringValue(dstPtr);
1159            Tcl_WinTCharToUtf(nativeDst, -1, errorPtr);
1160        }
1161        return TCL_ERROR;
1162    }
1163    
1164    /*
1165     *----------------------------------------------------------------------
1166     *
1167     * TraversalDelete --
1168     *
1169     *      Called by procedure TraverseWinTree for every file and
1170     *      directory that it encounters in a directory hierarchy. This
1171     *      procedure unlinks files, and removes directories after all the
1172     *      containing files have been processed.
1173     *
1174     * Results:
1175     *      Standard Tcl result.
1176     *
1177     * Side effects:
1178     *      Files or directory specified by src will be deleted. If an
1179     *      error occurs, the windows error is converted to a Posix error
1180     *      and errno is set accordingly.
1181     *
1182     *----------------------------------------------------------------------
1183     */
1184    
1185    static int
1186    TraversalDelete(
1187        Tcl_DString *srcPtr,        /* Source pathname to delete. */
1188        Tcl_DString *dstPtr,        /* Not used. */
1189        int type,                   /* Reason for call - see TraverseWinTree() */
1190        Tcl_DString *errorPtr)      /* If non-NULL, initialized DString filled
1191                                     * with UTF-8 name of file causing error. */
1192    {
1193        TCHAR *nativeSrc;
1194    
1195        switch (type) {
1196            case DOTREE_F: {
1197                if (DoDeleteFile(srcPtr) == TCL_OK) {
1198                    return TCL_OK;
1199                }
1200                break;
1201            }
1202            case DOTREE_PRED: {
1203                return TCL_OK;
1204            }
1205            case DOTREE_POSTD: {
1206                if (DoRemoveDirectory(srcPtr, 0, NULL) == TCL_OK) {
1207                    return TCL_OK;
1208                }
1209                break;
1210            }
1211        }
1212    
1213        if (errorPtr != NULL) {
1214            nativeSrc = (TCHAR *) Tcl_DStringValue(srcPtr);
1215            Tcl_WinTCharToUtf(nativeSrc, -1, errorPtr);
1216        }
1217        return TCL_ERROR;
1218    }
1219    
1220    /*
1221     *----------------------------------------------------------------------
1222     *
1223     * StatError --
1224     *
1225     *      Sets the object result with the appropriate error.
1226     *
1227     * Results:
1228     *      None.
1229     *
1230     * Side effects:
1231     *      The interp's object result is set with an error message
1232     *      based on the objIndex, fileName and errno.
1233     *
1234     *----------------------------------------------------------------------
1235     */
1236    
1237    static void
1238    StatError(
1239        Tcl_Interp *interp,         /* The interp that has the error */
1240        CONST char *fileName)       /* The name of the file which caused the
1241                                     * error. */
1242    {
1243        TclWinConvertError(GetLastError());
1244        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
1245                "could not read \"", fileName, "\": ", Tcl_PosixError(interp),
1246                (char *) NULL);
1247    }
1248    
1249    /*
1250     *----------------------------------------------------------------------
1251     *
1252     * GetWinFileAttributes --
1253     *
1254     *      Returns a Tcl_Obj containing the value of a file attribute.
1255     *      This routine gets the -hidden, -readonly or -system attribute.
1256     *
1257     * Results:
1258     *      Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object
1259     *      will have ref count 0. If the return value is not TCL_OK,
1260     *      attributePtrPtr is not touched.
1261     *
1262     * Side effects:
1263     *      A new object is allocated if the file is valid.
1264     *
1265     *----------------------------------------------------------------------
1266     */
1267    
1268    static int
1269    GetWinFileAttributes(
1270        Tcl_Interp *interp,         /* The interp we are using for errors. */
1271        int objIndex,               /* The index of the attribute. */
1272        CONST char *fileName,       /* The name of the file. */
1273        Tcl_Obj **attributePtrPtr)  /* A pointer to return the object with. */
1274    {
1275        DWORD result;
1276        Tcl_DString ds;
1277        TCHAR *nativeName;
1278    
1279        nativeName = Tcl_WinUtfToTChar(fileName, -1, &ds);
1280        result = (*tclWinProcs->getFileAttributesProc)(nativeName);
1281        Tcl_DStringFree(&ds);
1282    
1283        if (result == 0xffffffff) {
1284            StatError(interp, fileName);
1285            return TCL_ERROR;
1286        }
1287    
1288        *attributePtrPtr = Tcl_NewBooleanObj(result & attributeArray[objIndex]);
1289        return TCL_OK;
1290    }
1291    
1292    /*
1293     *----------------------------------------------------------------------
1294     *
1295     * ConvertFileNameFormat --
1296     *
1297     *      Returns a Tcl_Obj containing either the long or short version of the
1298     *      file name.
1299     *
1300     * Results:
1301     *      Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object
1302     *      will have ref count 0. If the return value is not TCL_OK,
1303     *      attributePtrPtr is not touched.
1304     *
1305     * Side effects:
1306     *      A new object is allocated if the file is valid.
1307     *
1308     *----------------------------------------------------------------------
1309     */
1310    
1311    static int
1312    ConvertFileNameFormat(
1313        Tcl_Interp *interp,         /* The interp we are using for errors. */
1314        int objIndex,               /* The index of the attribute. */
1315        CONST char *fileName,       /* The name of the file. */
1316        int longShort,              /* 0 to short name, 1 to long name. */
1317        Tcl_Obj **attributePtrPtr)  /* A pointer to return the object with. */
1318    {
1319        int pathc, i;
1320        char **pathv, **newv;
1321        char *resultStr;
1322        Tcl_DString resultDString;
1323        int result = TCL_OK;
1324    
1325        Tcl_SplitPath(fileName, &pathc, &pathv);
1326        newv = (char **) ckalloc(pathc * sizeof(char *));
1327    
1328        if (pathc == 0) {
1329            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
1330                    "could not read \"", fileName,
1331                    "\": no such file or directory",
1332                    (char *) NULL);
1333            result = TCL_ERROR;
1334            goto cleanup;
1335        }
1336        
1337        for (i = 0; i < pathc; i++) {
1338            if ((pathv[i][0] == '/')
1339                    || ((strlen(pathv[i]) == 3) && (pathv[i][1] == ':'))
1340                    || (strcmp(pathv[i], ".") == 0)
1341                    || (strcmp(pathv[i], "..") == 0)) {
1342                /*
1343                 * Handle "/", "//machine/export", "c:/", "." or ".." by just
1344                 * copying the string literally.  Uppercase the drive letter,
1345                 * just because it looks better under Windows to do so.
1346                 */
1347    
1348                simple:
1349                pathv[i][0] = (char) Tcl_UniCharToUpper(UCHAR(pathv[i][0]));
1350                newv[i] = (char *) ckalloc(strlen(pathv[i]) + 1);
1351                lstrcpyA(newv[i], pathv[i]);
1352            } else {
1353                char *str;
1354                TCHAR *nativeName;
1355                Tcl_DString ds;
1356                WIN32_FIND_DATAT data;
1357                HANDLE handle;
1358                DWORD attr;
1359    
1360                Tcl_DStringInit(&resultDString);
1361                str = Tcl_JoinPath(i + 1, pathv, &resultDString);
1362                nativeName = Tcl_WinUtfToTChar(str, -1, &ds);
1363                handle = (*tclWinProcs->findFirstFileProc)(nativeName, &data);
1364                if (handle == INVALID_HANDLE_VALUE) {
1365                    /*
1366                     * FindFirstFile() doesn't like root directories.  We
1367                     * would only get a root directory here if the caller
1368                     * specified "c:" or "c:." and the current directory on the
1369                     * drive was the root directory
1370                     */
1371    
1372                    attr = (*tclWinProcs->getFileAttributesProc)(nativeName);
1373                    if ((attr != 0xFFFFFFFF) && (attr & FILE_ATTRIBUTE_DIRECTORY)) {
1374                        Tcl_DStringFree(&ds);
1375                        Tcl_DStringFree(&resultDString);
1376    
1377                        goto simple;
1378                    }
1379                }
1380                Tcl_DStringFree(&ds);
1381                Tcl_DStringFree(&resultDString);
1382    
1383                if (handle == INVALID_HANDLE_VALUE) {
1384                    pathc = i - 1;
1385                    StatError(interp, fileName);
1386                    result = TCL_ERROR;
1387                    goto cleanup;
1388                }
1389                if (tclWinProcs->useWide) {
1390                    nativeName = (TCHAR *) data.w.cAlternateFileName;
1391                    if (longShort) {
1392                        if (data.w.cFileName[0] != '\0') {
1393                            nativeName = (TCHAR *) data.w.cFileName;
1394                        }
1395                    } else {
1396                        if (data.w.cAlternateFileName[0] == '\0') {
1397                            nativeName = (TCHAR *) data.w.cFileName;
1398                        }
1399                    }
1400                } else {
1401                    nativeName = (TCHAR *) data.a.cAlternateFileName;
1402                    if (longShort) {
1403                        if (data.a.cFileName[0] != '\0') {
1404                            nativeName = (TCHAR *) data.a.cFileName;
1405                        }
1406                    } else {
1407                        if (data.a.cAlternateFileName[0] == '\0') {
1408                            nativeName = (TCHAR *) data.a.cFileName;
1409                        }
1410                    }
1411                }
1412    
1413                /*
1414                 * Purify reports a extraneous UMR in Tcl_WinTCharToUtf() trying
1415                 * to dereference nativeName as a Unicode string.  I have proven
1416                 * to myself that purify is wrong by running the following
1417                 * example when nativeName == data.w.cAlternateFileName and
1418                 * noting that purify doesn't complain about the first line,
1419                 * but does complain about the second.
1420                 *
1421                 *  fprintf(stderr, "%d\n", data.w.cAlternateFileName[0]);
1422                 *  fprintf(stderr, "%d\n", ((WCHAR *) nativeName)[0]);
1423                 */
1424    
1425                Tcl_WinTCharToUtf(nativeName, -1, &ds);
1426                newv[i] = ckalloc(Tcl_DStringLength(&ds) + 1);
1427                lstrcpyA(newv[i], Tcl_DStringValue(&ds));
1428                Tcl_DStringFree(&ds);
1429                FindClose(handle);
1430            }
1431        }
1432    
1433        Tcl_DStringInit(&resultDString);
1434        resultStr = Tcl_JoinPath(pathc, newv, &resultDString);
1435        *attributePtrPtr = Tcl_NewStringObj(resultStr,
1436                Tcl_DStringLength(&resultDString));
1437        Tcl_DStringFree(&resultDString);
1438    
1439    cleanup:
1440        for (i = 0; i < pathc; i++) {
1441            ckfree(newv[i]);
1442        }
1443        ckfree((char *) newv);
1444        ckfree((char *) pathv);
1445        return result;
1446    }
1447    
1448    /*
1449     *----------------------------------------------------------------------
1450     *
1451     * GetWinFileLongName --
1452     *
1453     *      Returns a Tcl_Obj containing the short version of the file
1454     *      name.
1455     *
1456     * Results:
1457     *      Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object
1458     *      will have ref count 0. If the return value is not TCL_OK,
1459     *      attributePtrPtr is not touched.
1460     *
1461     * Side effects:
1462     *      A new object is allocated if the file is valid.
1463     *
1464     *----------------------------------------------------------------------
1465     */
1466    
1467    static int
1468    GetWinFileLongName(
1469        Tcl_Interp *interp,         /* The interp we are using for errors. */
1470        int objIndex,               /* The index of the attribute. */
1471        CONST char *fileName,       /* The name of the file. */
1472        Tcl_Obj **attributePtrPtr)  /* A pointer to return the object with. */
1473    {
1474        return ConvertFileNameFormat(interp, objIndex, fileName, 1, attributePtrPtr);
1475    }
1476    
1477    /*
1478     *----------------------------------------------------------------------
1479     *
1480     * GetWinFileShortName --
1481     *
1482     *      Returns a Tcl_Obj containing the short version of the file
1483     *      name.
1484     *
1485     * Results:
1486     *      Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object
1487     *      will have ref count 0. If the return value is not TCL_OK,
1488     *      attributePtrPtr is not touched.
1489     *
1490     * Side effects:
1491     *      A new object is allocated if the file is valid.
1492     *
1493     *----------------------------------------------------------------------
1494     */
1495    
1496    static int
1497    GetWinFileShortName(
1498        Tcl_Interp *interp,         /* The interp we are using for errors. */
1499        int objIndex,               /* The index of the attribute. */
1500        CONST char *fileName,       /* The name of the file. */
1501        Tcl_Obj **attributePtrPtr)  /* A pointer to return the object with. */
1502    {
1503        return ConvertFileNameFormat(interp, objIndex, fileName, 0, attributePtrPtr);
1504    }
1505    
1506    /*
1507     *----------------------------------------------------------------------
1508     *
1509     * SetWinFileAttributes --
1510     *
1511     *      Set the file attributes to the value given by attributePtr.
1512     *      This routine sets the -hidden, -readonly, or -system attributes.
1513     *
1514     * Results:
1515     *      Standard TCL error.
1516     *
1517     * Side effects:
1518     *      The file's attribute is set.
1519     *
1520     *----------------------------------------------------------------------
1521     */
1522    
1523    static int
1524    SetWinFileAttributes(
1525        Tcl_Interp *interp,         /* The interp we are using for errors. */
1526        int objIndex,               /* The index of the attribute. */
1527        CONST char *fileName,       /* The name of the file. */
1528        Tcl_Obj *attributePtr)      /* The new value of the attribute. */
1529    {
1530        DWORD fileAttributes;
1531        int yesNo;
1532        int result;
1533        Tcl_DString ds;
1534        TCHAR *nativeName;
1535    
1536        nativeName = Tcl_WinUtfToTChar(fileName, -1, &ds);
1537        fileAttributes = (*tclWinProcs->getFileAttributesProc)(nativeName);
1538    
1539        if (fileAttributes == 0xffffffff) {
1540            StatError(interp, fileName);
1541            result = TCL_ERROR;
1542            goto end;
1543        }
1544    
1545        result = Tcl_GetBooleanFromObj(interp, attributePtr, &yesNo);
1546        if (result != TCL_OK) {
1547            goto end;
1548        }
1549    
1550        if (yesNo) {
1551            fileAttributes |= (attributeArray[objIndex]);
1552        } else {
1553            fileAttributes &= ~(attributeArray[objIndex]);
1554        }
1555    
1556        if (!(*tclWinProcs->setFileAttributesProc)(nativeName, fileAttributes)) {
1557            StatError(interp, fileName);
1558            result = TCL_ERROR;
1559            goto end;
1560        }
1561    
1562        end:
1563        Tcl_DStringFree(&ds);
1564    
1565        return result;
1566    }
1567    
1568    /*
1569     *----------------------------------------------------------------------
1570     *
1571     * SetWinFileLongName --
1572     *
1573     *      The attribute in question is a readonly attribute and cannot
1574     *      be set.
1575     *
1576     * Results:
1577     *      TCL_ERROR
1578     *
1579     * Side effects:
1580     *      The object result is set to a pertinant error message.
1581     *
1582     *----------------------------------------------------------------------
1583     */
1584    
1585    static int
1586    CannotSetAttribute(
1587        Tcl_Interp *interp,         /* The interp we are using for errors. */
1588        int objIndex,               /* The index of the attribute. */
1589        CONST char *fileName,       /* The name of the file. */
1590        Tcl_Obj *attributePtr)      /* The new value of the attribute. */
1591    {
1592        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
1593                "cannot set attribute \"", tclpFileAttrStrings[objIndex],
1594                "\" for file \"", fileName, "\": attribute is readonly",
1595                (char *) NULL);
1596        return TCL_ERROR;
1597    }
1598    
1599    
1600    /*
1601     *---------------------------------------------------------------------------
1602     *
1603     * TclpListVolumes --
1604     *
1605     *      Lists the currently mounted volumes
1606     *
1607     * Results:
1608     *      A standard Tcl result.  Will always be TCL_OK, since there is no way
1609     *      that this command can fail.  Also, the interpreter's result is set to
1610     *      the list of volumes.
1611     *
1612     * Side effects:
1613     *      None
1614     *
1615     *---------------------------------------------------------------------------
1616     */
1617    
1618    int
1619    TclpListVolumes(
1620        Tcl_Interp *interp)         /* Interpreter for returning volume list. */
1621    {
1622        Tcl_Obj *resultPtr, *elemPtr;
1623        char buf[40 * 4];           /* There couldn't be more than 30 drives??? */
1624        int i;
1625        char *p;
1626    
1627        resultPtr = Tcl_GetObjResult(interp);
1628    
1629        /*
1630         * On Win32s:
1631         * GetLogicalDriveStrings() isn't implemented.
1632         * GetLogicalDrives() returns incorrect information.
1633         */
1634    
1635        if (GetLogicalDriveStringsA(sizeof(buf), buf) == 0) {
1636            /*
1637             * GetVolumeInformation() will detects all drives, but causes
1638             * chattering on empty floppy drives.  We only do this if
1639             * GetLogicalDriveStrings() didn't work.  It has also been reported
1640             * that on some laptops it takes a while for GetVolumeInformation()
1641             * to return when pinging an empty floppy drive, another reason to
1642             * try to avoid calling it.
1643             */
1644    
1645            buf[1] = ':';
1646            buf[2] = '/';
1647            buf[3] = '\0';
1648    
1649            for (i = 0; i < 26; i++) {
1650                buf[0] = (char) ('a' + i);
1651                if (GetVolumeInformationA(buf, NULL, 0, NULL, NULL, NULL, NULL, 0)  
1652                        || (GetLastError() == ERROR_NOT_READY)) {
1653                    elemPtr = Tcl_NewStringObj(buf, -1);
1654                    Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr);
1655                }
1656            }
1657        } else {
1658            for (p = buf; *p != '\0'; p += 4) {
1659                p[2] = '/';
1660                elemPtr = Tcl_NewStringObj(p, -1);
1661                Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr);
1662            }
1663        }
1664        return TCL_OK;      
1665    }
1666    
1667    /* End of tclwinfcmd.c */
Legend:
Removed from v.64  
changed lines
  Added in v.71
dashley@gmail.com
 ViewVC Help
Powered by ViewVC 1.1.25