summaryrefslogtreecommitdiffstats
path: root/win/tclWinFCmd.c
diff options
context:
space:
mode:
Diffstat (limited to 'win/tclWinFCmd.c')
-rw-r--r--win/tclWinFCmd.c681
1 files changed, 324 insertions, 357 deletions
diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c
index 5d45fe1..441337e 100644
--- a/win/tclWinFCmd.c
+++ b/win/tclWinFCmd.c
@@ -4,7 +4,7 @@
* This file implements the Windows specific portion of file manipulation
* subcommands of the "file" command.
*
- * Copyright © 1996-1998 Sun Microsystems, Inc.
+ * 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.
@@ -54,12 +54,12 @@ static const int attributeArray[] = {FILE_ATTRIBUTE_ARCHIVE, FILE_ATTRIBUTE_HIDD
0, FILE_ATTRIBUTE_READONLY, 0, FILE_ATTRIBUTE_SYSTEM};
-const char *const tclpFileAttrStrings[] = {
+CONST char *tclpFileAttrStrings[] = {
"-archive", "-hidden", "-longname", "-readonly",
- "-shortname", "-system", NULL
+ "-shortname", "-system", (char *) NULL
};
-const TclFileAttrProcs tclpFileAttrProcs[] = {
+CONST TclFileAttrProcs tclpFileAttrProcs[] = {
{GetWinFileAttributes, SetWinFileAttributes},
{GetWinFileAttributes, SetWinFileAttributes},
{GetWinFileLongName, CannotSetAttribute},
@@ -71,7 +71,7 @@ const TclFileAttrProcs tclpFileAttrProcs[] = {
* Prototype for the TraverseWinTree callback function.
*/
-typedef int (TraversalProc)(const WCHAR *srcPtr, const WCHAR *dstPtr,
+typedef int (TraversalProc)(CONST TCHAR *srcPtr, CONST TCHAR *dstPtr,
int type, Tcl_DString *errorPtr);
/*
@@ -82,18 +82,18 @@ static void StatError(Tcl_Interp *interp, Tcl_Obj *fileName);
static int ConvertFileNameFormat(Tcl_Interp *interp,
int objIndex, Tcl_Obj *fileName, int longShort,
Tcl_Obj **attributePtrPtr);
-static int DoCopyFile(const WCHAR *srcPtr, const WCHAR *dstPtr);
-static int DoCreateDirectory(const WCHAR *pathPtr);
-static int DoRemoveJustDirectory(const WCHAR *nativeSrc,
+static int DoCopyFile(CONST TCHAR *srcPtr, CONST TCHAR *dstPtr);
+static int DoCreateDirectory(CONST TCHAR *pathPtr);
+static int DoRemoveJustDirectory(CONST TCHAR *nativeSrc,
int ignoreError, Tcl_DString *errorPtr);
static int DoRemoveDirectory(Tcl_DString *pathPtr, int recursive,
Tcl_DString *errorPtr);
-static int DoRenameFile(const WCHAR *nativeSrc,
- const WCHAR *dstPtr);
-static int TraversalCopy(const WCHAR *srcPtr, const WCHAR *dstPtr,
+static int DoRenameFile(CONST TCHAR *nativeSrc,
+ CONST TCHAR *dstPtr);
+static int TraversalCopy(CONST TCHAR *srcPtr, CONST TCHAR *dstPtr,
int type, Tcl_DString *errorPtr);
-static int TraversalDelete(const WCHAR *srcPtr,
- const WCHAR *dstPtr, int type,
+static int TraversalDelete(CONST TCHAR *srcPtr,
+ CONST TCHAR *dstPtr, int type,
Tcl_DString *errorPtr);
static int TraverseWinTree(TraversalProc *traverseProc,
Tcl_DString *sourcePtr, Tcl_DString *dstPtr,
@@ -145,15 +145,15 @@ TclpObjRenameFile(
Tcl_Obj *srcPathPtr,
Tcl_Obj *destPathPtr)
{
- return DoRenameFile((const WCHAR *)Tcl_FSGetNativePath(srcPathPtr),
- (const WCHAR *)Tcl_FSGetNativePath(destPathPtr));
+ return DoRenameFile(Tcl_FSGetNativePath(srcPathPtr),
+ Tcl_FSGetNativePath(destPathPtr));
}
static int
DoRenameFile(
- const WCHAR *nativeSrc, /* Pathname of file or dir to be renamed
+ CONST TCHAR *nativeSrc, /* Pathname of file or dir to be renamed
* (native). */
- const WCHAR *nativeDst) /* New pathname for file or directory
+ CONST TCHAR *nativeDst) /* New pathname for file or directory
* (native). */
{
#if defined(HAVE_NO_SEH) && !defined(_WIN64)
@@ -204,7 +204,7 @@ DoRenameFile(
"leal 1f, %%eax" "\n\t"
"movl %%eax, 0x4(%%edx)" "\n\t" /* handler */
"movl %%ebp, 0x8(%%edx)" "\n\t" /* ebp */
- "movl %%esp, 0xC(%%edx)" "\n\t" /* esp */
+ "movl %%esp, 0xc(%%edx)" "\n\t" /* esp */
"movl $0, 0x10(%%edx)" "\n\t" /* status */
/*
@@ -214,12 +214,12 @@ DoRenameFile(
"movl %%edx, %%fs:0" "\n\t"
/*
- * Call MoveFileW(nativeSrc, nativeDst)
+ * Call MoveFile(nativeSrc, nativeDst)
*/
"pushl %%ebx" "\n\t"
"pushl %%ecx" "\n\t"
- "movl %[moveFileW], %%eax" "\n\t"
+ "movl %[moveFile], %%eax" "\n\t"
"call *%%eax" "\n\t"
/*
@@ -245,7 +245,7 @@ DoRenameFile(
*/
"2:" "\t"
- "movl 0xC(%%edx), %%esp" "\n\t"
+ "movl 0xc(%%edx), %%esp" "\n\t"
"movl 0x8(%%edx), %%ebp" "\n\t"
"movl 0x0(%%edx), %%eax" "\n\t"
"movl %%eax, %%fs:0" "\n\t"
@@ -256,7 +256,7 @@ DoRenameFile(
[registration] "m" (registration),
[nativeDst] "m" (nativeDst),
[nativeSrc] "m" (nativeSrc),
- [moveFileW] "r" (MoveFileW)
+ [moveFile] "r" (tclWinProcs->moveFileProc)
:
"%eax", "%ebx", "%ecx", "%edx", "memory"
);
@@ -267,7 +267,7 @@ DoRenameFile(
#ifndef HAVE_NO_SEH
__try {
#endif
- if ((*MoveFileW)(nativeSrc, nativeDst) != FALSE) {
+ if ((*tclWinProcs->moveFileProc)(nativeSrc, nativeDst) != FALSE) {
retval = TCL_OK;
}
#ifndef HAVE_NO_SEH
@@ -279,20 +279,20 @@ DoRenameFile(
return retval;
}
- Tcl_WinConvertError(GetLastError());
+ TclWinConvertError(GetLastError());
- srcAttr = GetFileAttributesW(nativeSrc);
- dstAttr = GetFileAttributesW(nativeDst);
- if (srcAttr == 0xFFFFFFFF) {
- if (GetFullPathNameW(nativeSrc, 0, NULL,
+ 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 (GetFullPathNameW(nativeDst, 0, NULL,
+ if (dstAttr == 0xffffffff) {
+ if ((*tclWinProcs->getFullPathNameProc)(nativeDst, 0, NULL,
NULL) >= MAX_PATH) {
errno = ENAMETOOLONG;
return TCL_ERROR;
@@ -307,31 +307,29 @@ DoRenameFile(
if (errno == EACCES) {
decode:
if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) {
- WCHAR *nativeSrcRest, *nativeDstRest;
- const char **srcArgv, **dstArgv;
- Tcl_Size size, srcArgc, dstArgc;
+ TCHAR *nativeSrcRest, *nativeDstRest;
+ CONST char **srcArgv, **dstArgv;
+ int size, srcArgc, dstArgc;
WCHAR nativeSrcPath[MAX_PATH];
WCHAR nativeDstPath[MAX_PATH];
Tcl_DString srcString, dstString;
- const char *src, *dst;
+ CONST char *src, *dst;
- size = GetFullPathNameW(nativeSrc, MAX_PATH,
+ size = (*tclWinProcs->getFullPathNameProc)(nativeSrc, MAX_PATH,
nativeSrcPath, &nativeSrcRest);
- if ((size <= 0) || (size > MAX_PATH)) {
+ if ((size == 0) || (size > MAX_PATH)) {
return TCL_ERROR;
}
- size = GetFullPathNameW(nativeDst, MAX_PATH,
+ size = (*tclWinProcs->getFullPathNameProc)(nativeDst, MAX_PATH,
nativeDstPath, &nativeDstRest);
if ((size == 0) || (size > MAX_PATH)) {
return TCL_ERROR;
}
- CharLowerW(nativeSrcPath);
- CharLowerW(nativeDstPath);
+ (*tclWinProcs->charLowerProc)((TCHAR *) nativeSrcPath);
+ (*tclWinProcs->charLowerProc)((TCHAR *) nativeDstPath);
- Tcl_DStringInit(&srcString);
- Tcl_DStringInit(&dstString);
- src = Tcl_WCharToUtfDString(nativeSrcPath, TCL_INDEX_NONE, &srcString);
- dst = Tcl_WCharToUtfDString(nativeDstPath, TCL_INDEX_NONE, &dstString);
+ src = Tcl_WinTCharToUtf((TCHAR *) nativeSrcPath, -1, &srcString);
+ dst = Tcl_WinTCharToUtf((TCHAR *) nativeDstPath, -1, &dstString);
/*
* Check whether the destination path is actually inside the
@@ -339,7 +337,7 @@ DoRenameFile(
* character is either end-of-string or a directory separator
*/
- if ((strncmp(src, dst, Tcl_DStringLength(&srcString))==0)
+ if ((strncmp(src, dst, (size_t) Tcl_DStringLength(&srcString))==0)
&& (dst[Tcl_DStringLength(&srcString)] == '\\'
|| dst[Tcl_DStringLength(&srcString)] == '/'
|| dst[Tcl_DStringLength(&srcString)] == '\0')) {
@@ -378,8 +376,8 @@ DoRenameFile(
Tcl_SetErrno(EXDEV);
}
- ckfree(srcArgv);
- ckfree(dstArgv);
+ ckfree((char *) srcArgv);
+ ckfree((char *) dstArgv);
}
/*
@@ -410,7 +408,8 @@ DoRenameFile(
* directory back, for completeness.
*/
- if (MoveFileW(nativeSrc, nativeDst) != FALSE) {
+ if ((*tclWinProcs->moveFileProc)(nativeSrc,
+ nativeDst) != FALSE) {
return TCL_OK;
}
@@ -419,9 +418,9 @@ DoRenameFile(
* be, but report this one.
*/
- Tcl_WinConvertError(GetLastError());
- CreateDirectoryW(nativeDst, NULL);
- SetFileAttributesW(nativeDst, dstAttr);
+ TclWinConvertError(GetLastError());
+ (*tclWinProcs->createDirectoryProc)(nativeDst, NULL);
+ (*tclWinProcs->setFileAttributesProc)(nativeDst, dstAttr);
if (Tcl_GetErrno() == EACCES) {
/*
* Decode the EACCES to a more meaningful error.
@@ -446,22 +445,24 @@ DoRenameFile(
* back to old name.
*/
- WCHAR *nativeRest, *nativeTmp, *nativePrefix;
+ TCHAR *nativeRest, *nativeTmp, *nativePrefix;
int result, size;
WCHAR tempBuf[MAX_PATH];
- size = GetFullPathNameW(nativeDst, MAX_PATH,
+ size = (*tclWinProcs->getFullPathNameProc)(nativeDst, MAX_PATH,
tempBuf, &nativeRest);
if ((size == 0) || (size > MAX_PATH) || (nativeRest == NULL)) {
return TCL_ERROR;
}
- nativeTmp = (WCHAR *) tempBuf;
- nativeRest[0] = '\0';
+ nativeTmp = (TCHAR *) tempBuf;
+ ((char *) nativeRest)[0] = '\0';
+ ((char *) nativeRest)[1] = '\0'; /* In case it's Unicode. */
result = TCL_ERROR;
- nativePrefix = (WCHAR *)L"tclr";
- if (GetTempFileNameW(nativeTmp, nativePrefix,
- 0, tempBuf) != 0) {
+ 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
@@ -469,16 +470,19 @@ DoRenameFile(
* same temp file.
*/
- nativeTmp = tempBuf;
- DeleteFileW(nativeTmp);
- if (MoveFileW(nativeDst, nativeTmp) != FALSE) {
- if (MoveFileW(nativeSrc, nativeDst) != FALSE) {
- SetFileAttributesW(nativeTmp, FILE_ATTRIBUTE_NORMAL);
- DeleteFileW(nativeTmp);
+ 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 {
- DeleteFileW(nativeDst);
- MoveFileW(nativeTmp, nativeDst);
+ (*tclWinProcs->deleteFileProc)(nativeDst);
+ (*tclWinProcs->moveFileProc)(nativeTmp, nativeDst);
}
}
@@ -487,7 +491,7 @@ DoRenameFile(
* error. Could happen if an open file refers to dst.
*/
- Tcl_WinConvertError(GetLastError());
+ TclWinConvertError(GetLastError());
if (Tcl_GetErrno() == EACCES) {
/*
* Decode the EACCES to a more meaningful error.
@@ -535,14 +539,14 @@ TclpObjCopyFile(
Tcl_Obj *srcPathPtr,
Tcl_Obj *destPathPtr)
{
- return DoCopyFile((const WCHAR *)Tcl_FSGetNativePath(srcPathPtr),
- (const WCHAR *)Tcl_FSGetNativePath(destPathPtr));
+ return DoCopyFile(Tcl_FSGetNativePath(srcPathPtr),
+ Tcl_FSGetNativePath(destPathPtr));
}
static int
DoCopyFile(
- const WCHAR *nativeSrc, /* Pathname of file to be copied (native). */
- const WCHAR *nativeDst) /* Pathname of file to copy to (native). */
+ CONST TCHAR *nativeSrc, /* Pathname of file to be copied (native). */
+ CONST TCHAR *nativeDst) /* Pathname of file to copy to (native). */
{
#if defined(HAVE_NO_SEH) && !defined(_WIN64)
TCLEXCEPTION_REGISTRATION registration;
@@ -592,7 +596,7 @@ DoCopyFile(
"leal 1f, %%eax" "\n\t"
"movl %%eax, 0x4(%%edx)" "\n\t" /* handler */
"movl %%ebp, 0x8(%%edx)" "\n\t" /* ebp */
- "movl %%esp, 0xC(%%edx)" "\n\t" /* esp */
+ "movl %%esp, 0xc(%%edx)" "\n\t" /* esp */
"movl $0, 0x10(%%edx)" "\n\t" /* status */
/*
@@ -602,10 +606,10 @@ DoCopyFile(
"movl %%edx, %%fs:0" "\n\t"
/*
- * Call CopyFileW(nativeSrc, nativeDst, 0)
+ * Call CopyFile(nativeSrc, nativeDst, 0)
*/
- "movl %[copyFileW], %%eax" "\n\t"
+ "movl %[copyFile], %%eax" "\n\t"
"pushl $0" "\n\t"
"pushl %%ebx" "\n\t"
"pushl %%ecx" "\n\t"
@@ -634,7 +638,7 @@ DoCopyFile(
*/
"2:" "\t"
- "movl 0xC(%%edx), %%esp" "\n\t"
+ "movl 0xc(%%edx), %%esp" "\n\t"
"movl 0x8(%%edx), %%ebp" "\n\t"
"movl 0x0(%%edx), %%eax" "\n\t"
"movl %%eax, %%fs:0" "\n\t"
@@ -645,7 +649,7 @@ DoCopyFile(
[registration] "m" (registration),
[nativeDst] "m" (nativeDst),
[nativeSrc] "m" (nativeSrc),
- [copyFileW] "r" (CopyFileW)
+ [copyFile] "r" (tclWinProcs->copyFileProc)
:
"%eax", "%ebx", "%ecx", "%edx", "memory"
);
@@ -656,7 +660,7 @@ DoCopyFile(
#ifndef HAVE_NO_SEH
__try {
#endif
- if (CopyFileW(nativeSrc, nativeDst, 0) != FALSE) {
+ if ((*tclWinProcs->copyFileProc)(nativeSrc, nativeDst, 0) != FALSE) {
retval = TCL_OK;
}
#ifndef HAVE_NO_SEH
@@ -668,7 +672,7 @@ DoCopyFile(
return retval;
}
- Tcl_WinConvertError(GetLastError());
+ TclWinConvertError(GetLastError());
if (Tcl_GetErrno() == EBADF) {
Tcl_SetErrno(EACCES);
return TCL_ERROR;
@@ -676,10 +680,10 @@ DoCopyFile(
if (Tcl_GetErrno() == EACCES) {
DWORD srcAttr, dstAttr;
- srcAttr = GetFileAttributesW(nativeSrc);
- dstAttr = GetFileAttributesW(nativeDst);
- if (srcAttr != 0xFFFFFFFF) {
- if (dstAttr == 0xFFFFFFFF) {
+ srcAttr = (*tclWinProcs->getFileAttributesProc)(nativeSrc);
+ dstAttr = (*tclWinProcs->getFileAttributesProc)(nativeDst);
+ if (srcAttr != 0xffffffff) {
+ if (dstAttr == 0xffffffff) {
dstAttr = 0;
}
if ((srcAttr & FILE_ATTRIBUTE_DIRECTORY) ||
@@ -693,9 +697,10 @@ DoCopyFile(
Tcl_SetErrno(EISDIR);
}
if (dstAttr & FILE_ATTRIBUTE_READONLY) {
- SetFileAttributesW(nativeDst,
+ (*tclWinProcs->setFileAttributesProc)(nativeDst,
dstAttr & ~((DWORD)FILE_ATTRIBUTE_READONLY));
- if (CopyFileW(nativeSrc, nativeDst, 0) != FALSE) {
+ if ((*tclWinProcs->copyFileProc)(nativeSrc, nativeDst,
+ 0) != FALSE) {
return TCL_OK;
}
@@ -704,8 +709,8 @@ DoCopyFile(
* attributes of dst.
*/
- Tcl_WinConvertError(GetLastError());
- SetFileAttributesW(nativeDst, dstAttr);
+ TclWinConvertError(GetLastError());
+ (*tclWinProcs->setFileAttributesProc)(nativeDst, dstAttr);
}
}
}
@@ -746,35 +751,34 @@ TclpObjDeleteFile(
int
TclpDeleteFile(
- const void *nativePath) /* Pathname of file to be removed (native). */
+ CONST TCHAR *nativePath) /* Pathname of file to be removed (native). */
{
DWORD attr;
- const WCHAR *path = (const WCHAR *)nativePath;
/*
* The DeleteFile API acts differently under Win95/98 and NT WRT NULL and
* "". Avoid passing these values.
*/
- if (path == NULL || path[0] == '\0') {
+ if (nativePath == NULL || nativePath[0] == '\0') {
Tcl_SetErrno(ENOENT);
return TCL_ERROR;
}
- if (DeleteFileW(path) != FALSE) {
+ if ((*tclWinProcs->deleteFileProc)(nativePath) != FALSE) {
return TCL_OK;
}
- Tcl_WinConvertError(GetLastError());
+ TclWinConvertError(GetLastError());
if (Tcl_GetErrno() == EACCES) {
- attr = GetFileAttributesW(path);
- if (attr != 0xFFFFFFFF) {
+ attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
+ if (attr != 0xffffffff) {
if (attr & FILE_ATTRIBUTE_DIRECTORY) {
if (attr & FILE_ATTRIBUTE_REPARSE_POINT) {
/*
* It is a symbolic link - remove it.
*/
- if (TclWinSymLinkDelete(path, 0) == 0) {
+ if (TclWinSymLinkDelete(nativePath, 0) == 0) {
return TCL_OK;
}
}
@@ -788,21 +792,22 @@ TclpDeleteFile(
Tcl_SetErrno(EISDIR);
} else if (attr & FILE_ATTRIBUTE_READONLY) {
- int res = SetFileAttributesW(path,
- attr & ~((DWORD) FILE_ATTRIBUTE_READONLY));
+ int res = (*tclWinProcs->setFileAttributesProc)(nativePath,
+ attr & ~((DWORD)FILE_ATTRIBUTE_READONLY));
- if ((res != 0) && (DeleteFileW(path) != FALSE)) {
+ if ((res != 0) && ((*tclWinProcs->deleteFileProc)(nativePath)
+ != FALSE)) {
return TCL_OK;
}
- Tcl_WinConvertError(GetLastError());
+ TclWinConvertError(GetLastError());
if (res != 0) {
- SetFileAttributesW(path, attr);
+ (*tclWinProcs->setFileAttributesProc)(nativePath, attr);
}
}
}
} else if (Tcl_GetErrno() == ENOENT) {
- attr = GetFileAttributesW(path);
- if (attr != 0xFFFFFFFF) {
+ attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
+ if (attr != 0xffffffff) {
if (attr & FILE_ATTRIBUTE_DIRECTORY) {
/*
* Windows 95 reports removing a directory as ENOENT instead
@@ -853,17 +858,17 @@ int
TclpObjCreateDirectory(
Tcl_Obj *pathPtr)
{
- return DoCreateDirectory((const WCHAR *)Tcl_FSGetNativePath(pathPtr));
+ return DoCreateDirectory(Tcl_FSGetNativePath(pathPtr));
}
static int
DoCreateDirectory(
- const WCHAR *nativePath) /* Pathname of directory to create (native). */
+ CONST TCHAR *nativePath) /* Pathname of directory to create (native). */
{
- if (CreateDirectoryW(nativePath, NULL) == 0) {
- DWORD error = GetLastError();
-
- Tcl_WinConvertError(error);
+ DWORD error;
+ if ((*tclWinProcs->createDirectoryProc)(nativePath, NULL) == 0) {
+ error = GetLastError();
+ TclWinConvertError(error);
return TCL_ERROR;
}
return TCL_OK;
@@ -876,7 +881,7 @@ DoCreateDirectory(
*
* 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 empty directory.
+ * hierarchies, even if the target directory is an an empty directory.
*
* Results:
* If the directory was successfully copied, returns TCL_OK. Otherwise
@@ -910,10 +915,8 @@ TclpObjCopyDirectory(
return TCL_ERROR;
}
- Tcl_DStringInit(&srcString);
- Tcl_DStringInit(&dstString);
- Tcl_UtfToWCharDString(TclGetString(normSrcPtr), TCL_INDEX_NONE, &srcString);
- Tcl_UtfToWCharDString(TclGetString(normDestPtr), TCL_INDEX_NONE, &dstString);
+ Tcl_WinUtfToTChar(Tcl_GetString(normSrcPtr), -1, &srcString);
+ Tcl_WinUtfToTChar(Tcl_GetString(normDestPtr), -1, &dstString);
ret = TraverseWinTree(TraversalCopy, &srcString, &dstString, &ds);
@@ -926,7 +929,7 @@ TclpObjCopyDirectory(
} else if (!strcmp(Tcl_DStringValue(&ds), TclGetString(normDestPtr))) {
*errorPtr = destPathPtr;
} else {
- *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), TCL_INDEX_NONE);
+ *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
}
Tcl_DStringFree(&ds);
Tcl_IncrRefCount(*errorPtr);
@@ -985,21 +988,21 @@ TclpObjRemoveDirectory(
if (normPtr == NULL) {
return TCL_ERROR;
}
- Tcl_DStringInit(&native);
- Tcl_UtfToWCharDString(TclGetString(normPtr), TCL_INDEX_NONE, &native);
+ Tcl_WinUtfToTChar(Tcl_GetString(normPtr), -1, &native);
ret = DoRemoveDirectory(&native, recursive, &ds);
Tcl_DStringFree(&native);
} else {
- ret = DoRemoveJustDirectory((const WCHAR *)Tcl_FSGetNativePath(pathPtr), 0, &ds);
+ ret = DoRemoveJustDirectory(Tcl_FSGetNativePath(pathPtr), 0, &ds);
}
if (ret != TCL_OK) {
- if (Tcl_DStringLength(&ds) > 0) {
+ int len = Tcl_DStringLength(&ds);
+ if (len > 0) {
if (normPtr != NULL &&
!strcmp(Tcl_DStringValue(&ds), TclGetString(normPtr))) {
*errorPtr = pathPtr;
} else {
- *errorPtr = Tcl_DStringToObj(&ds);
+ *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
}
Tcl_IncrRefCount(*errorPtr);
}
@@ -1011,7 +1014,7 @@ TclpObjRemoveDirectory(
static int
DoRemoveJustDirectory(
- const WCHAR *nativePath, /* Pathname of directory to be removed
+ CONST TCHAR *nativePath, /* Pathname of directory to be removed
* (native). */
int ignoreError, /* If non-zero, don't initialize the errorPtr
* under some circumstances on return. */
@@ -1028,11 +1031,10 @@ DoRemoveJustDirectory(
if (nativePath == NULL || nativePath[0] == '\0') {
Tcl_SetErrno(ENOENT);
- Tcl_DStringInit(errorPtr);
- return TCL_ERROR;
+ goto end;
}
- attr = GetFileAttributesW(nativePath);
+ attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
if (attr & FILE_ATTRIBUTE_REPARSE_POINT) {
/*
@@ -1046,16 +1048,16 @@ DoRemoveJustDirectory(
* Ordinary directory.
*/
- if (RemoveDirectoryW(nativePath) != FALSE) {
+ if ((*tclWinProcs->removeDirectoryProc)(nativePath) != FALSE) {
return TCL_OK;
}
}
- Tcl_WinConvertError(GetLastError());
+ TclWinConvertError(GetLastError());
if (Tcl_GetErrno() == EACCES) {
- attr = GetFileAttributesW(nativePath);
- if (attr != 0xFFFFFFFF) {
+ attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
+ if (attr != 0xffffffff) {
if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
/*
* Windows 95 reports calling RemoveDirectory on a file as an
@@ -1078,16 +1080,60 @@ DoRemoveJustDirectory(
if (attr & FILE_ATTRIBUTE_READONLY) {
attr &= ~FILE_ATTRIBUTE_READONLY;
- if (SetFileAttributesW(nativePath, attr) == FALSE) {
+ if ((*tclWinProcs->setFileAttributesProc)(nativePath,
+ attr) == FALSE) {
goto end;
}
- if (RemoveDirectoryW(nativePath) != FALSE) {
+ if ((*tclWinProcs->removeDirectoryProc)(nativePath) != FALSE) {
return TCL_OK;
}
- Tcl_WinConvertError(GetLastError());
- SetFileAttributesW(nativePath,
+ TclWinConvertError(GetLastError());
+ (*tclWinProcs->setFileAttributesProc)(nativePath,
attr | FILE_ATTRIBUTE_READONLY);
}
+
+ /*
+ * Windows 95 and Win32s report removing a non-empty directory as
+ * EACCES, not EEXIST. If the directory is not empty, change errno
+ * so caller knows what's going on.
+ */
+
+ if (TclWinGetPlatformId() != VER_PLATFORM_WIN32_NT) {
+ CONST char *path, *find;
+ HANDLE handle;
+ WIN32_FIND_DATAA data;
+ Tcl_DString buffer;
+ int len;
+
+ path = (CONST char *) nativePath;
+
+ Tcl_DStringInit(&buffer);
+ len = strlen(path);
+ find = Tcl_DStringAppend(&buffer, path, len);
+ if ((len > 0) && (find[len - 1] != '\\')) {
+ Tcl_DStringAppend(&buffer, "\\", 1);
+ }
+ find = Tcl_DStringAppend(&buffer, "*.*", 3);
+ handle = FindFirstFileA(find, &data);
+ if (handle != INVALID_HANDLE_VALUE) {
+ while (1) {
+ if ((strcmp(data.cFileName, ".") != 0)
+ && (strcmp(data.cFileName, "..") != 0)) {
+ /*
+ * Found something in this directory.
+ */
+
+ Tcl_SetErrno(EEXIST);
+ break;
+ }
+ if (FindNextFileA(handle, &data) == FALSE) {
+ break;
+ }
+ }
+ FindClose(handle);
+ }
+ Tcl_DStringFree(&buffer);
+ }
}
}
@@ -1111,13 +1157,10 @@ DoRemoveJustDirectory(
end:
if (errorPtr != NULL) {
char *p;
-
- Tcl_DStringInit(errorPtr);
- p = Tcl_WCharToUtfDString(nativePath, TCL_INDEX_NONE, errorPtr);
+ Tcl_WinTCharToUtf(nativePath, -1, errorPtr);
+ p = Tcl_DStringValue(errorPtr);
for (; *p; ++p) {
- if (*p == '\\') {
- *p = '/';
- }
+ if (*p == '\\') *p = '/';
}
}
return TCL_ERROR;
@@ -1135,7 +1178,7 @@ DoRemoveDirectory(
* filled with UTF-8 name of file causing
* error. */
{
- int res = DoRemoveJustDirectory((const WCHAR *)Tcl_DStringValue(pathPtr), recursive,
+ int res = DoRemoveJustDirectory(Tcl_DStringValue(pathPtr), recursive,
errorPtr);
if ((res == TCL_ERROR) && (recursive != 0) && (Tcl_GetErrno() == EEXIST)) {
@@ -1186,22 +1229,22 @@ TraverseWinTree(
* error. */
{
DWORD sourceAttr;
- WCHAR *nativeSource, *nativeTarget, *nativeErrfile;
+ TCHAR *nativeSource, *nativeTarget, *nativeErrfile;
int result, found, sourceLen, targetLen = 0, oldSourceLen, oldTargetLen;
HANDLE handle;
- WIN32_FIND_DATAW data;
+ WIN32_FIND_DATAT data;
nativeErrfile = NULL;
result = TCL_OK;
- oldTargetLen = 0;
+ oldTargetLen = 0; /* lint. */
- nativeSource = (WCHAR *) Tcl_DStringValue(sourcePtr);
- nativeTarget = (WCHAR *)
+ nativeSource = (TCHAR *) Tcl_DStringValue(sourcePtr);
+ nativeTarget = (TCHAR *)
(targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr));
oldSourceLen = Tcl_DStringLength(sourcePtr);
- sourceAttr = GetFileAttributesW(nativeSource);
- if (sourceAttr == 0xFFFFFFFF) {
+ sourceAttr = (*tclWinProcs->getFileAttributesProc)(nativeSource);
+ if (sourceAttr == 0xffffffff) {
nativeErrfile = nativeSource;
goto end;
}
@@ -1211,7 +1254,7 @@ TraverseWinTree(
* Process the symbolic link
*/
- return traverseProc(nativeSource, nativeTarget, DOTREE_LINK,
+ return (*traverseProc)(nativeSource, nativeTarget, DOTREE_LINK,
errorPtr);
}
@@ -1220,62 +1263,89 @@ TraverseWinTree(
* Process the regular file
*/
- return traverseProc(nativeSource, nativeTarget, DOTREE_F, errorPtr);
+ return (*traverseProc)(nativeSource, nativeTarget, DOTREE_F, errorPtr);
}
- Tcl_DStringAppend(sourcePtr, (char *) L"\\*.*", 4 * sizeof(WCHAR) + 1);
- Tcl_DStringSetLength(sourcePtr, Tcl_DStringLength(sourcePtr) - 1);
+ 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 = (WCHAR *) Tcl_DStringValue(sourcePtr);
- handle = FindFirstFileW(nativeSource, &data);
+ nativeSource = (TCHAR *) Tcl_DStringValue(sourcePtr);
+ handle = (*tclWinProcs->findFirstFileProc)(nativeSource, &data);
if (handle == INVALID_HANDLE_VALUE) {
/*
* Can't read directory.
*/
- Tcl_WinConvertError(GetLastError());
+ TclWinConvertError(GetLastError());
nativeErrfile = nativeSource;
goto end;
}
- Tcl_DStringSetLength(sourcePtr, oldSourceLen + 1);
+ nativeSource[oldSourceLen + 1] = '\0';
Tcl_DStringSetLength(sourcePtr, oldSourceLen);
- result = traverseProc(nativeSource, nativeTarget, DOTREE_PRED,
+ result = (*traverseProc)(nativeSource, nativeTarget, DOTREE_PRED,
errorPtr);
if (result != TCL_OK) {
FindClose(handle);
return result;
}
- sourceLen = oldSourceLen + sizeof(WCHAR);
- Tcl_DStringAppend(sourcePtr, (char *) L"\\", sizeof(WCHAR) + 1);
- Tcl_DStringSetLength(sourcePtr, sourceLen);
+ 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;
- targetLen += sizeof(WCHAR);
- Tcl_DStringAppend(targetPtr, (char *) L"\\", sizeof(WCHAR) + 1);
- Tcl_DStringSetLength(targetPtr, targetLen);
+ 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 = FindNextFileW(handle, &data)) {
- WCHAR *nativeName;
+ for (; found; found = (*tclWinProcs->findNextFileProc)(handle, &data)) {
+ TCHAR *nativeName;
int len;
- WCHAR *wp = data.cFileName;
- if (*wp == '.') {
- wp++;
+ if (tclWinProcs->useWide) {
+ WCHAR *wp;
+
+ wp = data.w.cFileName;
if (*wp == '.') {
wp++;
+ if (*wp == '.') {
+ wp++;
+ }
+ if (*wp == '\0') {
+ continue;
+ }
}
- if (*wp == '\0') {
+ nativeName = (TCHAR *) data.w.cFileName;
+ len = wcslen(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);
}
- nativeName = (WCHAR *) data.cFileName;
- len = wcslen(data.cFileName) * sizeof(WCHAR);
/*
* Append name after slash, and recurse on the file.
@@ -1320,17 +1390,16 @@ TraverseWinTree(
* files in that directory.
*/
- result = traverseProc((const WCHAR *)Tcl_DStringValue(sourcePtr),
- (const WCHAR *)(targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr)),
+ result = (*traverseProc)(Tcl_DStringValue(sourcePtr),
+ (targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr)),
DOTREE_POSTD, errorPtr);
}
end:
if (nativeErrfile != NULL) {
- Tcl_WinConvertError(GetLastError());
+ TclWinConvertError(GetLastError());
if (errorPtr != NULL) {
- Tcl_DStringInit(errorPtr);
- Tcl_WCharToUtfDString(nativeErrfile, TCL_INDEX_NONE, errorPtr);
+ Tcl_WinTCharToUtf(nativeErrfile, -1, errorPtr);
}
result = TCL_ERROR;
}
@@ -1357,8 +1426,8 @@ TraverseWinTree(
static int
TraversalCopy(
- const WCHAR *nativeSrc, /* Source pathname to copy. */
- const WCHAR *nativeDst, /* Destination pathname of copy. */
+ CONST TCHAR *nativeSrc, /* Source pathname to copy. */
+ CONST TCHAR *nativeDst, /* Destination pathname of copy. */
int type, /* Reason for call - see TraverseWinTree() */
Tcl_DString *errorPtr) /* If non-NULL, initialized DString filled
* with UTF-8 name of file causing error. */
@@ -1376,12 +1445,13 @@ TraversalCopy(
break;
case DOTREE_PRED:
if (DoCreateDirectory(nativeDst) == TCL_OK) {
- DWORD attr = GetFileAttributesW(nativeSrc);
+ DWORD attr = (tclWinProcs->getFileAttributesProc)(nativeSrc);
- if (SetFileAttributesW(nativeDst, attr) != FALSE) {
+ if ((tclWinProcs->setFileAttributesProc)(nativeDst,
+ attr) != FALSE) {
return TCL_OK;
}
- Tcl_WinConvertError(GetLastError());
+ TclWinConvertError(GetLastError());
}
break;
case DOTREE_POSTD:
@@ -1394,8 +1464,7 @@ TraversalCopy(
*/
if (errorPtr != NULL) {
- Tcl_DStringInit(errorPtr);
- Tcl_WCharToUtfDString(nativeDst, TCL_INDEX_NONE, errorPtr);
+ Tcl_WinTCharToUtf(nativeDst, -1, errorPtr);
}
return TCL_ERROR;
}
@@ -1423,8 +1492,8 @@ TraversalCopy(
static int
TraversalDelete(
- const WCHAR *nativeSrc, /* Source pathname to delete. */
- TCL_UNUSED(const WCHAR *) /*dstPtr*/,
+ CONST TCHAR *nativeSrc, /* Source pathname to delete. */
+ CONST TCHAR *dstPtr, /* Not used. */
int type, /* Reason for call - see TraverseWinTree() */
Tcl_DString *errorPtr) /* If non-NULL, initialized DString filled
* with UTF-8 name of file causing error. */
@@ -1450,8 +1519,7 @@ TraversalDelete(
}
if (errorPtr != NULL) {
- Tcl_DStringInit(errorPtr);
- Tcl_WCharToUtfDString(nativeSrc, TCL_INDEX_NONE, errorPtr);
+ Tcl_WinTCharToUtf(nativeSrc, -1, errorPtr);
}
return TCL_ERROR;
}
@@ -1479,9 +1547,9 @@ StatError(
Tcl_Obj *fileName) /* The name of the file which caused the
* error. */
{
- Tcl_WinConvertError(GetLastError());
- Tcl_SetObjResult(interp, Tcl_ObjPrintf("could not read \"%s\": %s",
- TclGetString(fileName), Tcl_PosixError(interp)));
+ TclWinConvertError(GetLastError());
+ Tcl_AppendResult(interp, "could not read \"", TclGetString(fileName),
+ "\": ", Tcl_PosixError(interp), (char *) NULL);
}
/*
@@ -1511,13 +1579,13 @@ GetWinFileAttributes(
Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */
{
DWORD result;
- const WCHAR *nativeName;
+ CONST TCHAR *nativeName;
int attr;
- nativeName = (const WCHAR *)Tcl_FSGetNativePath(fileName);
- result = GetFileAttributesW(nativeName);
+ nativeName = Tcl_FSGetNativePath(fileName);
+ result = (*tclWinProcs->getFileAttributesProc)(nativeName);
- if (result == 0xFFFFFFFF) {
+ if (result == 0xffffffff) {
StatError(interp, fileName);
return TCL_ERROR;
}
@@ -1532,8 +1600,8 @@ GetWinFileAttributes(
* We test for, and fix that case, here.
*/
- Tcl_Size len;
- const char *str = TclGetStringFromObj(fileName, &len);
+ int len;
+ char *str = Tcl_GetStringFromObj(fileName,&len);
if (len < 4) {
if (len == 0) {
@@ -1557,7 +1625,7 @@ GetWinFileAttributes(
}
}
- TclNewIntObj(*attributePtrPtr, attr != 0);
+ *attributePtrPtr = Tcl_NewBooleanObj(attr);
return TCL_OK;
}
@@ -1587,23 +1655,21 @@ GetWinFileAttributes(
static int
ConvertFileNameFormat(
Tcl_Interp *interp, /* The interp we are using for errors. */
- TCL_UNUSED(int) /*objIndex*/,
+ int objIndex, /* The index of the attribute. */
Tcl_Obj *fileName, /* The name of the file. */
int longShort, /* 0 to short name, 1 to long name. */
Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */
{
- Tcl_Size pathc, i, length;
+ int pathc, i;
Tcl_Obj *splitPath;
splitPath = Tcl_FSSplitPath(fileName, &pathc);
if (splitPath == NULL || pathc == 0) {
if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "could not read \"%s\": no such file or directory",
- TclGetString(fileName)));
- errno = ENOENT;
- Tcl_PosixError(interp);
+ Tcl_AppendResult(interp, "could not read \"",
+ Tcl_GetString(fileName), "\": no such file or directory",
+ (char *) NULL);
}
goto cleanup;
}
@@ -1618,11 +1684,12 @@ ConvertFileNameFormat(
for (i = 0; i < pathc; i++) {
Tcl_Obj *elt;
char *pathv;
+ int pathLen;
Tcl_ListObjIndex(NULL, splitPath, i, &elt);
- pathv = TclGetStringFromObj(elt, &length);
- if ((pathv[0] == '/') || ((length == 3) && (pathv[1] == ':'))
+ pathv = Tcl_GetStringFromObj(elt, &pathLen);
+ if ((pathv[0] == '/') || ((pathLen == 3) && (pathv[1] == ':'))
|| (strcmp(pathv, ".") == 0) || (strcmp(pathv, "..") == 0)) {
/*
* Handle "/", "//machine/export", "c:/", "." or ".." by just
@@ -1643,9 +1710,10 @@ ConvertFileNameFormat(
Tcl_Obj *tempPath;
Tcl_DString ds;
Tcl_DString dsTemp;
- const WCHAR *nativeName;
- const char *tempString;
- WIN32_FIND_DATAW data;
+ TCHAR *nativeName;
+ char *tempString;
+ int tempLen;
+ WIN32_FIND_DATAT data;
HANDLE handle;
DWORD attr;
@@ -1657,20 +1725,20 @@ ConvertFileNameFormat(
* likely to lead to infinite loops.
*/
- tempString = TclGetStringFromObj(tempPath, &length);
Tcl_DStringInit(&ds);
- nativeName = Tcl_UtfToWCharDString(tempString, length, &ds);
+ tempString = Tcl_GetStringFromObj(tempPath,&tempLen);
+ nativeName = Tcl_WinUtfToTChar(tempString, tempLen, &ds);
Tcl_DecrRefCount(tempPath);
- handle = FindFirstFileW(nativeName, &data);
+ handle = (*tclWinProcs->findFirstFileProc)(nativeName, &data);
if (handle == INVALID_HANDLE_VALUE) {
/*
- * FindFirstFileW() doesn't like root directories. We would
+ * 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 = GetFileAttributesW(nativeName);
+ attr = (*tclWinProcs->getFileAttributesProc)(nativeName);
if ((attr!=0xFFFFFFFF) && (attr & FILE_ATTRIBUTE_DIRECTORY)) {
Tcl_DStringFree(&ds);
goto simple;
@@ -1684,19 +1752,32 @@ ConvertFileNameFormat(
}
goto cleanup;
}
- nativeName = data.cAlternateFileName;
- if (longShort) {
- if (data.cFileName[0] != '\0') {
- nativeName = data.cFileName;
+ 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 {
- if (data.cAlternateFileName[0] == '\0') {
- nativeName = (WCHAR *) data.cFileName;
+ 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_WCharToUtfDString() trying
+ * 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
@@ -1708,27 +1789,28 @@ ConvertFileNameFormat(
*/
Tcl_DStringInit(&dsTemp);
- Tcl_WCharToUtfDString(nativeName, TCL_INDEX_NONE, &dsTemp);
- Tcl_DStringFree(&ds);
+ Tcl_WinTCharToUtf(nativeName, -1, &dsTemp);
/*
* Deal with issues of tildes being absolute.
*/
if (Tcl_DStringValue(&dsTemp)[0] == '~') {
- TclNewLiteralStringObj(tempPath, "./");
+ tempPath = Tcl_NewStringObj("./",2);
Tcl_AppendToObj(tempPath, Tcl_DStringValue(&dsTemp),
Tcl_DStringLength(&dsTemp));
- Tcl_DStringFree(&dsTemp);
} else {
- tempPath = Tcl_DStringToObj(&dsTemp);
+ tempPath = Tcl_NewStringObj(Tcl_DStringValue(&dsTemp),
+ Tcl_DStringLength(&dsTemp));
}
Tcl_ListObjReplace(NULL, splitPath, i, 1, 1, &tempPath);
+ Tcl_DStringFree(&ds);
+ Tcl_DStringFree(&dsTemp);
FindClose(handle);
}
}
- *attributePtrPtr = Tcl_FSJoinPath(splitPath, TCL_INDEX_NONE);
+ *attributePtrPtr = Tcl_FSJoinPath(splitPath, -1);
if (splitPath != NULL) {
/*
@@ -1835,14 +1917,15 @@ SetWinFileAttributes(
Tcl_Obj *fileName, /* The name of the file. */
Tcl_Obj *attributePtr) /* The new value of the attribute. */
{
- DWORD fileAttributes, old;
- int yesNo, result;
- const WCHAR *nativeName;
+ DWORD fileAttributes;
+ int yesNo;
+ int result;
+ CONST TCHAR *nativeName;
- nativeName = (const WCHAR *)Tcl_FSGetNativePath(fileName);
- fileAttributes = old = GetFileAttributesW(nativeName);
+ nativeName = Tcl_FSGetNativePath(fileName);
+ fileAttributes = (*tclWinProcs->getFileAttributesProc)(nativeName);
- if (fileAttributes == 0xFFFFFFFF) {
+ if (fileAttributes == 0xffffffff) {
StatError(interp, fileName);
return TCL_ERROR;
}
@@ -1858,8 +1941,7 @@ SetWinFileAttributes(
fileAttributes &= ~(attributeArray[objIndex]);
}
- if ((fileAttributes != old)
- && !SetFileAttributesW(nativeName, fileAttributes)) {
+ if (!(*tclWinProcs->setFileAttributesProc)(nativeName, fileAttributes)) {
StatError(interp, fileName);
return TCL_ERROR;
}
@@ -1888,15 +1970,15 @@ CannotSetAttribute(
Tcl_Interp *interp, /* The interp we are using for errors. */
int objIndex, /* The index of the attribute. */
Tcl_Obj *fileName, /* The name of the file. */
- TCL_UNUSED(Tcl_Obj *) /*attributePtr*/)
+ Tcl_Obj *attributePtr) /* The new value of the attribute. */
{
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "cannot set attribute \"%s\" for file \"%s\": attribute is readonly",
- tclpFileAttrStrings[objIndex], TclGetString(fileName)));
- errno = EINVAL;
- Tcl_PosixError(interp);
+ Tcl_AppendResult(interp, "cannot set attribute \"",
+ tclpFileAttrStrings[objIndex], "\" for file \"",
+ Tcl_GetString(fileName), "\": attribute is readonly",
+ (char *) NULL);
return TCL_ERROR;
}
+
/*
*---------------------------------------------------------------------------
@@ -1914,7 +1996,7 @@ CannotSetAttribute(
*---------------------------------------------------------------------------
*/
-Tcl_Obj *
+Tcl_Obj*
TclpObjListVolumes(void)
{
Tcl_Obj *resultPtr, *elemPtr;
@@ -1922,7 +2004,7 @@ TclpObjListVolumes(void)
int i;
char *p;
- TclNewObj(resultPtr);
+ resultPtr = Tcl_NewObj();
/*
* On Win32s:
@@ -1932,10 +2014,10 @@ TclpObjListVolumes(void)
if (GetLogicalDriveStringsA(sizeof(buf), buf) == 0) {
/*
- * GetVolumeInformationW() will detects all drives, but causes
+ * 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 GetVolumeInformationW() to
+ * 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.
*/
@@ -1948,14 +2030,14 @@ TclpObjListVolumes(void)
buf[0] = (char) ('a' + i);
if (GetVolumeInformationA(buf, NULL, 0, NULL, NULL, NULL, NULL, 0)
|| (GetLastError() == ERROR_NOT_READY)) {
- elemPtr = Tcl_NewStringObj(buf, TCL_INDEX_NONE);
+ elemPtr = Tcl_NewStringObj(buf, -1);
Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr);
}
}
} else {
for (p = buf; *p != '\0'; p += 4) {
p[2] = '/';
- elemPtr = Tcl_NewStringObj(p, TCL_INDEX_NONE);
+ elemPtr = Tcl_NewStringObj(p, -1);
Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr);
}
}
@@ -1965,121 +2047,6 @@ TclpObjListVolumes(void)
}
/*
- *----------------------------------------------------------------------
- *
- * TclpCreateTemporaryDirectory --
- *
- * Creates a temporary directory, possibly based on the supplied bits and
- * pieces of template supplied in the arguments.
- *
- * Results:
- * An object (refcount 0) containing the name of the newly-created
- * directory, or NULL on failure.
- *
- * Side effects:
- * Accesses the native filesystem. Makes a directory.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Obj *
-TclpCreateTemporaryDirectory(
- Tcl_Obj *dirObj,
- Tcl_Obj *basenameObj)
-{
- Tcl_DString base, name; /* Contains WCHARs */
- int baseLen;
- DWORD error;
- WCHAR tempBuf[MAX_PATH + 1];
- DWORD len = GetTempPathW(MAX_PATH, tempBuf);
-
- /*
- * Build the path in writable memory from the user-supplied pieces and
- * some defaults. First, the parent temporary directory.
- */
-
- if (dirObj) {
- TclGetString(dirObj);
- if (dirObj->length < 1) {
- goto useSystemTemp;
- }
- Tcl_DStringInit(&base);
- Tcl_UtfToWCharDString(TclGetString(dirObj), TCL_INDEX_NONE, &base);
- if (dirObj->bytes[dirObj->length - 1] != '\\') {
- Tcl_UtfToWCharDString("\\", TCL_INDEX_NONE, &base);
- }
- } else {
- useSystemTemp:
- Tcl_DStringInit(&base);
- Tcl_DStringAppend(&base, (char *) tempBuf, len * sizeof(WCHAR));
- }
-
- /*
- * Next, the base of the directory name.
- */
-
-#define DEFAULT_TEMP_DIR_PREFIX "tcl"
-#define SUFFIX_LENGTH 8
-
- if (basenameObj) {
- Tcl_UtfToWCharDString(TclGetString(basenameObj), TCL_INDEX_NONE, &base);
- } else {
- Tcl_UtfToWCharDString(DEFAULT_TEMP_DIR_PREFIX, TCL_INDEX_NONE, &base);
- }
- Tcl_UtfToWCharDString("_", TCL_INDEX_NONE, &base);
-
- /*
- * Now we keep on trying random suffixes until we get one that works
- * (i.e., that doesn't trigger the ERROR_ALREADY_EXISTS error). Note that
- * SUFFIX_LENGTH is longer than on Unix because we expect to be not on a
- * case-sensitive filesystem.
- */
-
- baseLen = Tcl_DStringLength(&base);
- do {
- char tempbuf[SUFFIX_LENGTH + 1];
- int i;
- static const char randChars[] =
- "QWERTYUIOPASDFGHJKLZXCVBNM1234567890";
- static const int numRandChars = sizeof(randChars) - 1;
-
- /*
- * Put a random suffix on the end.
- */
-
- error = ERROR_SUCCESS;
- tempbuf[SUFFIX_LENGTH] = '\0';
- for (i = 0 ; i < SUFFIX_LENGTH; i++) {
- tempbuf[i] = randChars[(int) (rand() % numRandChars)];
- }
- Tcl_DStringSetLength(&base, baseLen);
- Tcl_UtfToWCharDString(tempbuf, TCL_INDEX_NONE, &base);
- } while (!CreateDirectoryW((LPCWSTR) Tcl_DStringValue(&base), NULL)
- && (error = GetLastError()) == ERROR_ALREADY_EXISTS);
-
- /*
- * Check for other errors. The big ones are ERROR_PATH_NOT_FOUND and
- * ERROR_ACCESS_DENIED.
- */
-
- if (error != ERROR_SUCCESS) {
- Tcl_WinConvertError(error);
- Tcl_DStringFree(&base);
- return NULL;
- }
-
- /*
- * We actually made the directory, so we're done! Report what we made back
- * as a (clean) Tcl_Obj.
- */
-
- Tcl_DStringInit(&name);
- Tcl_WCharToUtfDString((LPCWSTR) Tcl_DStringValue(&base), TCL_INDEX_NONE, &name);
- Tcl_DStringFree(&base);
- return Tcl_DStringToObj(&name);
-}
-
-/*
* Local Variables:
* mode: c
* c-basic-offset: 4
generated by cgit v0.12 at 2025-12-20 16:47:27 (GMT)