diff options
Diffstat (limited to 'win/tkWinTest.c')
| -rw-r--r-- | win/tkWinTest.c | 205 |
1 files changed, 108 insertions, 97 deletions
diff --git a/win/tkWinTest.c b/win/tkWinTest.c index d361ad7..d7d4d0f 100644 --- a/win/tkWinTest.c +++ b/win/tkWinTest.c @@ -12,6 +12,10 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ +#undef USE_TCL_STUBS +#define USE_TCL_STUBS +#undef USE_TK_STUBS +#define USE_TK_STUBS #include "tkWinInt.h" HWND tkWinCurrentDialog; @@ -22,21 +26,20 @@ HWND tkWinCurrentDialog; static int TestclipboardObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); static int TestwineventCmd(ClientData clientData, - Tcl_Interp *interp, int argc, CONST char **argv); + Tcl_Interp *interp, int argc, const char **argv); static int TestfindwindowObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); static int TestgetwindowinfoObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); static int TestwinlocaleObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int TkplatformtestInit(Tcl_Interp *interp); +static Tk_GetSelProc SetSelectionResult; - /* *---------------------------------------------------------------------- * @@ -99,12 +102,16 @@ AppendSystemError( { int length; WCHAR *wMsgPtr, **wMsgPtrPtr = &wMsgPtr; - char *msg; + const char *msg; char id[TCL_INTEGER_SPACE], msgBuf[24 + TCL_INTEGER_SPACE]; Tcl_DString ds; Tcl_Obj *resultPtr = Tcl_GetObjResult(interp); - length = FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM + if (Tcl_IsShared(resultPtr)) { + resultPtr = Tcl_DuplicateObj(resultPtr); + } + length = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM + | FORMAT_MESSAGE_IGNORE_INSERTS | FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error, MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (WCHAR *) wMsgPtrPtr, 0, NULL); @@ -112,6 +119,7 @@ AppendSystemError( char *msgPtr; length = FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM + | FORMAT_MESSAGE_IGNORE_INSERTS | FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error, MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (char *) &msgPtr, 0, NULL); @@ -124,36 +132,41 @@ AppendSystemError( } if (length == 0) { if (error == ERROR_CALL_NOT_IMPLEMENTED) { - msg = "function not supported under Win32s"; + strcpy(msgBuf, "function not supported under Win32s"); } else { sprintf(msgBuf, "unknown error: %ld", error); - msg = msgBuf; } + msg = msgBuf; } else { Tcl_Encoding encoding; + char *msgPtr; encoding = Tcl_GetEncoding(NULL, "unicode"); - msg = Tcl_ExternalToUtfDString(encoding, (char *) wMsgPtr, -1, &ds); + Tcl_ExternalToUtfDString(encoding, (char *) wMsgPtr, -1, &ds); Tcl_FreeEncoding(encoding); LocalFree(wMsgPtr); + msgPtr = Tcl_DStringValue(&ds); length = Tcl_DStringLength(&ds); /* * Trim the trailing CR/LF from the system message. */ - if (msg[length-1] == '\n') { - msg[--length] = 0; + if (msgPtr[length-1] == '\n') { + --length; } - if (msg[length-1] == '\r') { - msg[--length] = 0; + if (msgPtr[length-1] == '\r') { + --length; } + msgPtr[length] = 0; + msg = msgPtr; } sprintf(id, "%ld", error); Tcl_SetErrorCode(interp, "WINDOWS", id, msg, NULL); Tcl_AppendToObj(resultPtr, msg, length); + Tcl_SetObjResult(interp, resultPtr); if (length != 0) { Tcl_DStringFree(&ds); @@ -178,44 +191,30 @@ AppendSystemError( */ static int +SetSelectionResult( + ClientData dummy, + Tcl_Interp *interp, + const char *selection) +{ + Tcl_AppendResult(interp, selection, NULL); + return TCL_OK; +} + +static int TestclipboardObjCmd( ClientData clientData, /* Main window for application. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument values. */ + Tcl_Obj *const objv[]) /* Argument values. */ { - HGLOBAL handle; - char *data; - int code = TCL_OK; + Tk_Window tkwin = (Tk_Window) clientData; if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } - if (OpenClipboard(NULL)) { - /* - * We could consider using CF_UNICODETEXT on NT, but then we would - * have to convert it from External. Instead we'll just take this and - * do "bytestring" at the Tcl level for Unicode inclusive text - */ - - handle = GetClipboardData(CF_TEXT); - if (handle != NULL) { - data = GlobalLock(handle); - Tcl_AppendResult(interp, data, NULL); - GlobalUnlock(handle); - } else { - Tcl_AppendResult(interp, "null clipboard handle", NULL); - code = TCL_ERROR; - } - CloseClipboard(); - return code; - } else { - Tcl_AppendResult(interp, "couldn't open clipboard: ", NULL); - AppendSystemError(interp, GetLastError()); - return TCL_ERROR; - } - return TCL_OK; + return TkSelGetSelection(interp, tkwin, Tk_InternAtom(tkwin, "CLIPBOARD"), + XA_STRING, SetSelectionResult, NULL); } /* @@ -240,7 +239,7 @@ TestwineventCmd( ClientData clientData, /* Main window for application. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ - CONST char **argv) /* Argument strings. */ + const char **argv) /* Argument strings. */ { HWND hwnd = 0; HWND child = 0; @@ -273,9 +272,19 @@ TestwineventCmd( return TCL_ERROR; } - hwnd = (HWND) INT2PTR(strtol(argv[1], &rest, 0)); +#if 0 + TkpScanWindowId(interp, argv[1], &id); + if ( +#ifdef _WIN64 + (sscanf(string, "0x%p", &number) != 1) && +#endif /* _WIN64 */ + Tcl_GetInt(interp, string, (int *)&number) != TCL_OK) { + return TCL_ERROR; + } +#endif + hwnd = INT2PTR(strtol(argv[1], &rest, 0)); if (rest == argv[1]) { - hwnd = FindWindow(NULL, argv[1]); + hwnd = FindWindowA(NULL, argv[1]); if (hwnd == NULL) { Tcl_SetResult(interp, "no such window", TCL_STATIC); return TCL_ERROR; @@ -289,7 +298,7 @@ TestwineventCmd( child = GetWindow(hwnd, GW_CHILD); while (child != NULL) { - SendMessage(child, WM_GETTEXT, (WPARAM) sizeof(buf), (LPARAM) buf); + SendMessageA(child, WM_GETTEXT, (WPARAM) sizeof(buf), (LPARAM) buf); if (strcasecmp(buf, argv[2]) == 0) { id = GetDlgCtrlID(child); break; @@ -318,7 +327,7 @@ TestwineventCmd( Tcl_DString ds; char buf[256]; - GetDlgItemText(hwnd, id, buf, 256); + GetDlgItemTextA(hwnd, id, buf, 256); Tcl_ExternalToUtfDString(NULL, buf, -1, &ds); Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL); Tcl_DStringFree(&ds); @@ -328,7 +337,7 @@ TestwineventCmd( Tcl_DString ds; Tcl_UtfToExternalDString(NULL, argv[4], -1, &ds); - SetDlgItemText(hwnd, id, Tcl_DStringValue(&ds)); + SetDlgItemTextA(hwnd, id, Tcl_DStringValue(&ds)); Tcl_DStringFree(&ds); break; } @@ -338,7 +347,7 @@ TestwineventCmd( wParam = MAKEWPARAM(id, 0); lParam = (LPARAM)child; } - sprintf(buf, "%d", (int) SendMessage(hwnd, message, wParam, lParam)); + sprintf(buf, "%d", (int) SendMessageA(hwnd, message, wParam, lParam)); Tcl_SetResult(interp, buf, TCL_VOLATILE); break; } @@ -346,7 +355,7 @@ TestwineventCmd( char buf[TCL_INTEGER_SPACE]; sprintf(buf, "%d", - (int) SendDlgItemMessage(hwnd, id, message, wParam, lParam)); + (int) SendDlgItemMessageA(hwnd, id, message, wParam, lParam)); Tcl_SetResult(interp, buf, TCL_VOLATILE); break; } @@ -357,7 +366,7 @@ TestwineventCmd( /* * testfindwindow title ?class? * Find a Windows window using the FindWindow API call. This takes the window - * title and optionally the window class and if found returns the HWND and + * title and optionally the window class and if found returns the HWND and * raises an error if the window is not found. * eg: testfindwindow Console TkTopLevel * Can find the console window if it is visible. @@ -370,20 +379,27 @@ TestfindwindowObjCmd( ClientData clientData, /* Main window for application. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument values. */ + Tcl_Obj *const objv[]) /* Argument values. */ { - const char *title = NULL, *class = NULL; + 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_GetString(objv[1]); - if (objc == 3) - class = Tcl_GetString(objv[2]); - hwnd = FindWindowA(class, title); + + 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)); @@ -392,14 +408,20 @@ TestfindwindowObjCmd( } else { Tcl_SetObjResult(interp, Tcl_NewLongObj(PTR2INT(hwnd))); } + + Tcl_DStringFree(&titleString); + Tcl_DStringFree(&classString); return r; - + } static BOOL CALLBACK -EnumChildrenProc(HWND hwnd, LPARAM lParam) +EnumChildrenProc( + HWND hwnd, + LPARAM lParam) { - Tcl_Obj *listObj = (Tcl_Obj *)lParam; + Tcl_Obj *listObj = (Tcl_Obj *) lParam; + Tcl_ListObjAppendElement(NULL, listObj, Tcl_NewLongObj(PTR2INT(hwnd))); return TRUE; } @@ -409,13 +431,13 @@ TestgetwindowinfoObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]) + Tcl_Obj *const objv[]) { long hwnd; - Tcl_Obj *resObj = NULL, *classObj = NULL, *textObj = NULL; + Tcl_Obj *dictObj = NULL, *classObj = NULL, *textObj = NULL; Tcl_Obj *childrenObj = NULL; - char buf[512]; - int cch, cchBuf = tkWinProcs->useWide ? 256 : 512; + TCHAR buf[512]; + int cch, cchBuf = 256; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "hwnd"); @@ -424,49 +446,38 @@ TestgetwindowinfoObjCmd( if (Tcl_GetLongFromObj(interp, objv[1], &hwnd) != TCL_OK) return TCL_ERROR; - - if (tkWinProcs->useWide) { - cch = GetClassNameW(INT2PTR(hwnd), (LPWSTR)buf, sizeof(buf)/sizeof(WCHAR)); - classObj = Tcl_NewUnicodeObj((LPWSTR)buf, cch); - } else { - cch = GetClassNameA(INT2PTR(hwnd), (LPSTR)buf, sizeof(buf)); - classObj = Tcl_NewStringObj((LPSTR)buf, cch); - } + + cch = GetClassName(INT2PTR(hwnd), buf, cchBuf); if (cch == 0) { Tcl_SetResult(interp, "failed to get class name: ", TCL_STATIC); AppendSystemError(interp, GetLastError()); return TCL_ERROR; - } - - resObj = Tcl_NewListObj(0, NULL); - Tcl_ListObjAppendElement(interp, resObj, Tcl_NewStringObj("class", -1)); - Tcl_ListObjAppendElement(interp, resObj, classObj); - - Tcl_ListObjAppendElement(interp, resObj, Tcl_NewStringObj("id", -1)); - Tcl_ListObjAppendElement(interp, resObj, - Tcl_NewLongObj(GetWindowLong(INT2PTR(hwnd), GWL_ID))); - - cch = tkWinProcs->getWindowText(INT2PTR(hwnd), (LPTSTR)buf, cchBuf); - if (tkWinProcs->useWide) { - textObj = Tcl_NewUnicodeObj((LPCWSTR)buf, cch); } else { - textObj = Tcl_NewStringObj((LPCSTR)buf, cch); + Tcl_DString ds; + Tcl_WinTCharToUtf(buf, -1, &ds); + classObj = Tcl_NewStringObj(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)); + Tcl_DStringFree(&ds); } - Tcl_ListObjAppendElement(interp, resObj, Tcl_NewStringObj("text", -1)); - Tcl_ListObjAppendElement(interp, resObj, textObj); - Tcl_ListObjAppendElement(interp, resObj, Tcl_NewStringObj("parent", -1)); - Tcl_ListObjAppendElement(interp, resObj, - Tcl_NewLongObj(PTR2INT(GetParent(INT2PTR(hwnd))))); + dictObj = Tcl_NewDictObj(); + Tcl_DictObjPut(interp, dictObj, Tcl_NewStringObj("class", 5), classObj); + Tcl_DictObjPut(interp, dictObj, Tcl_NewStringObj("id", 2), + Tcl_NewLongObj(GetWindowLongA(INT2PTR(hwnd), GWL_ID))); + + cch = GetWindowText(INT2PTR(hwnd), (LPTSTR)buf, cchBuf); + textObj = Tcl_NewUnicodeObj((LPCWSTR)buf, cch); + + Tcl_DictObjPut(interp, dictObj, Tcl_NewStringObj("text", 4), textObj); + Tcl_DictObjPut(interp, dictObj, Tcl_NewStringObj("parent", 6), + Tcl_NewLongObj(PTR2INT(GetParent((INT2PTR(hwnd)))))); childrenObj = Tcl_NewListObj(0, NULL); EnumChildWindows(INT2PTR(hwnd), EnumChildrenProc, (LPARAM)childrenObj); - Tcl_ListObjAppendElement(interp, resObj, Tcl_NewStringObj("children", -1)); - Tcl_ListObjAppendElement(interp, resObj, childrenObj); + Tcl_DictObjPut(interp, dictObj, Tcl_NewStringObj("children", -1), childrenObj); - Tcl_SetObjResult(interp, resObj); + Tcl_SetObjResult(interp, dictObj); return TCL_OK; -} +} static int TestwinlocaleObjCmd( @@ -479,7 +490,7 @@ TestwinlocaleObjCmd( Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } - Tcl_SetObjResult(interp, Tcl_NewIntObj((int)GetSystemDefaultLCID())); + Tcl_SetObjResult(interp, Tcl_NewIntObj((int)GetThreadLocale())); return TCL_OK; } |