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);
if ((TclWinGetPlatformId() == VER_PLATFORM_WIN32s)
&& ((Tcl_DStringLength(&srcString) >= MAX_PATH - 1) ||
(Tcl_DStringLength(&dstString) >= MAX_PATH - 1))) {
/*
* On Win32s, really long file names cause the MoveFile() call
* to lock up, endlessly throwing an access violation and
* retrying the operation.
*/
errno = ENAMETOOLONG;
result = TCL_ERROR;
} else {
result = DoRenameFile(nativeSrc, &dstString);
}
Tcl_DStringFree(&srcString);
Tcl_DStringFree(&dstString);
return result;
}
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;
}
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;
}
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;
}
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
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;
}
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
TestfindwindowObjCmd(
ClientData clientData, /* Main window for application. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument values. */
{
const TCHAR *title = NULL, *class = NULL;
Tcl_DString titleString, classString;
HWND hwnd = NULL;
int r = TCL_OK;
Tcl_DStringInit(&classString);
Tcl_DStringInit(&titleString);
if (objc < 2 || objc > 3) {
Tcl_WrongNumArgs(interp, 1, objv, "title ?class?");
return TCL_ERROR;
}
title = Tcl_WinUtfToTChar(Tcl_GetString(objv[1]), -1, &titleString);
if (objc == 3) {
class = Tcl_WinUtfToTChar(Tcl_GetString(objv[2]), -1, &classString);
}
hwnd = FindWindow(class, title);
if (hwnd == NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj("failed to find window: ", -1));
AppendSystemError(interp, GetLastError());
r = TCL_ERROR;
} else {
Tcl_SetObjResult(interp, Tcl_NewLongObj(PTR2INT(hwnd)));
}
Tcl_DStringFree(&titleString);
Tcl_DStringFree(&classString);
return r;
}
TWAPI_EXTERN WCHAR *ObjToWinChars(Tcl_Obj *objP)
{
WinChars *rep;
Tcl_DString ds;
int nbytes, len;
char *utf8;
if (objP->typePtr == &gWinCharsType)
return WinCharsGet(objP)->chars;
utf8 = ObjToStringN(objP, &nbytes);
Tcl_WinUtfToTChar(utf8, nbytes, &ds);
len = Tcl_DStringLength(&ds) / sizeof(WCHAR);
rep = WinCharsNew((WCHAR *) Tcl_DStringValue(&ds), len);
Tcl_DStringFree(&ds);
/* Convert the passed object's internal rep */
if (objP->typePtr && objP->typePtr->freeIntRepProc)
objP->typePtr->freeIntRepProc(objP);
WinCharsSet(objP, rep);
return rep->chars;
}
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;
}
int
TclpDlopen(
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Obj *pathPtr, /* Name of the file containing the desired
* code (UTF-8). */
Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded
* file which will be passed back to
* (*unloadProcPtr)() to unload the file. */
Tcl_FSUnloadFileProc **unloadProcPtr)
/* Filled with address of Tcl_FSUnloadFileProc
* function which should be used for this
* file. */
{
HINSTANCE handle;
const TCHAR *nativeName;
/*
* First try the full path the user gave us. This is particularly
* important if the cwd is inside a vfs, and we are trying to load using a
* relative path.
*/
nativeName = Tcl_FSGetNativePath(pathPtr);
handle = (*tclWinProcs->loadLibraryProc)(nativeName);
if (handle == NULL) {
/*
* Let the OS loader examine the binary search path for whatever
* string the user gave us which hopefully refers to a file on the
* binary path.
*/
Tcl_DString ds;
char *fileName = Tcl_GetString(pathPtr);
nativeName = Tcl_WinUtfToTChar(fileName, -1, &ds);
handle = (*tclWinProcs->loadLibraryProc)(nativeName);
Tcl_DStringFree(&ds);
}
*loadHandle = (Tcl_LoadHandle) handle;
if (handle == NULL) {
DWORD lastError = GetLastError();
#if 0
/*
* It would be ideal if the FormatMessage stuff worked better, but
* unfortunately it doesn't seem to want to...
*/
LPTSTR lpMsgBuf;
char *buf;
int size;
size = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM |
FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, lastError, 0,
(LPTSTR) &lpMsgBuf, 0, NULL);
buf = (char *) ckalloc((unsigned) TCL_INTEGER_SPACE + size + 1);
sprintf(buf, "%d %s", lastError, (char *)lpMsgBuf);
#endif
Tcl_AppendResult(interp, "couldn't load library \"",
Tcl_GetString(pathPtr), "\": ", NULL);
/*
* Check for possible DLL errors. This doesn't work quite right,
* because Windows seems to only return ERROR_MOD_NOT_FOUND for just
* about any problem, but it's better than nothing. It'd be even
* better if there was a way to get what DLLs
*/
switch (lastError) {
case ERROR_MOD_NOT_FOUND:
case ERROR_DLL_NOT_FOUND:
Tcl_AppendResult(interp, "this library or a dependent library"
" could not be found in library path", NULL);
break;
case ERROR_PROC_NOT_FOUND:
Tcl_AppendResult(interp, "A function specified in the import"
" table could not be resolved by the system. Windows"
" is not telling which one, I'm sorry.", NULL);
break;
case ERROR_INVALID_DLL:
Tcl_AppendResult(interp, "this library or a dependent library"
" is damaged", NULL);
break;
case ERROR_DLL_INIT_FAILED:
Tcl_AppendResult(interp, "the library initialization"
" routine failed", NULL);
break;
default:
TclWinConvertError(lastError);
Tcl_AppendResult(interp, Tcl_PosixError(interp), NULL);
}
return TCL_ERROR;
} else {
*unloadProcPtr = &TclpUnloadFile;
}
return TCL_OK;
}
static int
TestfindwindowObjCmd(
ClientData clientData, /* Main window for application. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument values. */
{
const TCHAR *title = NULL, *class = NULL;
Tcl_DString titleString, classString;
HWND hwnd = NULL;
int r = TCL_OK;
DWORD myPid;
Tcl_DStringInit(&classString);
Tcl_DStringInit(&titleString);
if (objc < 2 || objc > 3) {
Tcl_WrongNumArgs(interp, 1, objv, "title ?class?");
return TCL_ERROR;
}
title = Tcl_WinUtfToTChar(Tcl_GetString(objv[1]), -1, &titleString);
if (objc == 3) {
class = Tcl_WinUtfToTChar(Tcl_GetString(objv[2]), -1, &classString);
}
if (title[0] == 0)
title = NULL;
#if 0
hwnd = FindWindow(class, title);
#else
/* We want find a window the belongs to us and not some other process */
hwnd = NULL;
myPid = GetCurrentProcessId();
while (1) {
DWORD pid, tid;
hwnd = FindWindowEx(NULL, hwnd, class, title);
if (hwnd == NULL)
break;
tid = GetWindowThreadProcessId(hwnd, &pid);
if (tid == 0) {
/* Window has gone */
hwnd = NULL;
break;
}
if (pid == myPid)
break; /* Found it */
}
#endif
if (hwnd == NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj("failed to find window: ", -1));
AppendSystemError(interp, GetLastError());
r = TCL_ERROR;
} else {
Tcl_SetObjResult(interp, Tcl_NewLongObj(PTR2INT(hwnd)));
}
Tcl_DStringFree(&titleString);
Tcl_DStringFree(&classString);
return r;
}
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;
}
