diff options
Diffstat (limited to 'win/tkWinTest.c')
| -rw-r--r-- | win/tkWinTest.c | 247 |
1 files changed, 195 insertions, 52 deletions
diff --git a/win/tkWinTest.c b/win/tkWinTest.c index ed862ed..2498864 100644 --- a/win/tkWinTest.c +++ b/win/tkWinTest.c @@ -25,7 +25,16 @@ static int TestclipboardObjCmd(ClientData clientData, Tcl_Obj *const objv[]); static int TestwineventCmd(ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); -int TkplatformtestInit(Tcl_Interp *interp); +static int TestfindwindowObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +static int TestgetwindowinfoObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + 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); /* *---------------------------------------------------------------------- @@ -53,9 +62,15 @@ TkplatformtestInit( */ Tcl_CreateObjCommand(interp, "testclipboard", TestclipboardObjCmd, - (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL); + (ClientData) Tk_MainWindow(interp), NULL); Tcl_CreateCommand(interp, "testwinevent", TestwineventCmd, - (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL); + (ClientData) Tk_MainWindow(interp), NULL); + Tcl_CreateObjCommand(interp, "testfindwindow", TestfindwindowObjCmd, + (ClientData) Tk_MainWindow(interp), NULL); + Tcl_CreateObjCommand(interp, "testgetwindowinfo", TestgetwindowinfoObjCmd, + (ClientData) Tk_MainWindow(interp), NULL); + Tcl_CreateObjCommand(interp, "testwinlocale", TestwinlocaleObjCmd, + (ClientData) Tk_MainWindow(interp), NULL); return TCL_OK; } @@ -82,7 +97,7 @@ AppendSystemError( DWORD error) /* Result code from error. */ { int length; - WCHAR *wMsgPtr; + WCHAR *wMsgPtr, **wMsgPtrPtr = &wMsgPtr; const char *msg; char id[TCL_INTEGER_SPACE], msgBuf[24 + TCL_INTEGER_SPACE]; Tcl_DString ds; @@ -93,7 +108,7 @@ AppendSystemError( } length = FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error, - MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (WCHAR *) &wMsgPtr, + MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (WCHAR *) wMsgPtrPtr, 0, NULL); if (length == 0) { char *msgPtr; @@ -143,7 +158,7 @@ AppendSystemError( } sprintf(id, "%ld", error); - Tcl_SetErrorCode(interp, "WINDOWS", id, msg, (char *) NULL); + Tcl_SetErrorCode(interp, "WINDOWS", id, msg, NULL); Tcl_AppendToObj(resultPtr, msg, length); Tcl_SetObjResult(interp, resultPtr); @@ -181,7 +196,7 @@ TestclipboardObjCmd( int code = TCL_OK; if (objc != 1) { - Tcl_WrongNumArgs(interp, 1, objv, (char *) NULL); + Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } if (OpenClipboard(NULL)) { @@ -194,16 +209,16 @@ TestclipboardObjCmd( handle = GetClipboardData(CF_TEXT); if (handle != NULL) { data = GlobalLock(handle); - Tcl_AppendResult(interp, data, (char *) NULL); + Tcl_AppendResult(interp, data, NULL); GlobalUnlock(handle); } else { - Tcl_AppendResult(interp, "null clipboard handle", (char *) NULL); + Tcl_AppendResult(interp, "null clipboard handle", NULL); code = TCL_ERROR; } CloseClipboard(); return code; } else { - Tcl_AppendResult(interp, "couldn't open clipboard: ", (char *) NULL); + Tcl_AppendResult(interp, "couldn't open clipboard: ", NULL); AppendSystemError(interp, GetLastError()); return TCL_ERROR; } @@ -265,7 +280,7 @@ TestwineventCmd( return TCL_ERROR; } - hwnd = (HWND) strtol(argv[1], &rest, 0); + hwnd = INT2PTR(strtol(argv[1], &rest, 0)); if (rest == argv[1]) { hwnd = FindWindow(NULL, argv[1]); if (hwnd == NULL) { @@ -295,9 +310,6 @@ TestwineventCmd( } } message = TkFindStateNum(NULL, NULL, messageMap, argv[3]); - if (message < 0) { - message = strtol(argv[3], NULL, 0); - } wParam = 0; lParam = 0; @@ -309,49 +321,180 @@ TestwineventCmd( } switch (message) { - case WM_GETTEXT: { - Tcl_DString ds; - char buf[256]; - - GetDlgItemText(hwnd, id, buf, 256); - Tcl_ExternalToUtfDString(NULL, buf, -1, &ds); - Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL); - Tcl_DStringFree(&ds); - break; - } - case WM_SETTEXT: { - Tcl_DString ds; - BOOL result; - - Tcl_UtfToExternalDString(NULL, argv[4], -1, &ds); - result = SetDlgItemText(hwnd, id, Tcl_DStringValue(&ds)); - Tcl_DStringFree(&ds); - if (result == 0) { - Tcl_SetResult(interp, "failed to send text to dialog: ", TCL_STATIC); - AppendSystemError(interp, GetLastError()); + case WM_GETTEXT: { + Tcl_DString ds; + char buf[256]; + + GetDlgItemText(hwnd, id, buf, 256); + Tcl_ExternalToUtfDString(NULL, buf, -1, &ds); + Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL); + Tcl_DStringFree(&ds); + break; + } + case WM_SETTEXT: { + Tcl_DString ds; + BOOL result; + + Tcl_UtfToExternalDString(NULL, argv[4], -1, &ds); + result = SetDlgItemText(hwnd, id, Tcl_DStringValue(&ds)); + Tcl_DStringFree(&ds); + if (result == 0) { + Tcl_SetResult(interp, "failed to send text to dialog: ", TCL_STATIC); + AppendSystemError(interp, GetLastError()); return TCL_ERROR; - } - break; } - case WM_COMMAND: { - char buf[TCL_INTEGER_SPACE]; - if (argc < 5) { - wParam = MAKEWPARAM(id, 0); - lParam = (LPARAM)child; - } - sprintf(buf, "%d", (int) SendMessageA(hwnd, message, wParam, lParam)); - Tcl_SetResult(interp, buf, TCL_VOLATILE); - break; + break; + } + case WM_COMMAND: { + char buf[TCL_INTEGER_SPACE]; + if (argc < 5) { + wParam = MAKEWPARAM(id, 0); + lParam = (LPARAM)child; } - default: { - char buf[TCL_INTEGER_SPACE]; + sprintf(buf, "%d", (int) SendMessage(hwnd, message, wParam, lParam)); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + break; + } + default: { + char buf[TCL_INTEGER_SPACE]; - sprintf(buf, "%d", - (int) SendDlgItemMessage(hwnd, id, message, wParam, lParam)); - Tcl_SetResult(interp, buf, TCL_VOLATILE); - break; - } + sprintf(buf, "%d", + (int) SendDlgItemMessage(hwnd, id, message, wParam, lParam)); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + break; + } + } + return TCL_OK; +} + +/* + * 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 + * raises an error if the window is not found. + * eg: testfindwindow Console TkTopLevel + * Can find the console window if it is visible. + * eg: testfindwindow "TkTest #10201" "#32770" + * Can find a messagebox window with this title. + */ + +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 char *title = NULL, *class = NULL; + HWND hwnd = NULL; + int r = TCL_OK; + + 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); + + 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))); + } + return r; +} + +static BOOL CALLBACK +EnumChildrenProc( + HWND hwnd, + LPARAM lParam) +{ + Tcl_Obj *listObj = (Tcl_Obj *) lParam; + + Tcl_ListObjAppendElement(NULL, listObj, Tcl_NewLongObj(PTR2INT(hwnd))); + return TRUE; +} + +static int +TestgetwindowinfoObjCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + long hwnd; + Tcl_Obj *resObj = NULL, *classObj = NULL, *textObj = NULL; + Tcl_Obj *childrenObj = NULL; + char buf[512]; + int cch, cchBuf = tkWinProcs->useWide ? 256 : 512; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "hwnd"); + return TCL_ERROR; + } + + 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); + } + 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_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))))); + + 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_SetObjResult(interp, resObj); + return TCL_OK; +} + +static int +TestwinlocaleObjCmd( + ClientData clientData, /* Main window for application. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument values. */ +{ + if (objc != 1) { + Tcl_WrongNumArgs(interp, 1, objv, NULL); + return TCL_ERROR; } + Tcl_SetObjResult(interp, Tcl_NewIntObj((int)GetSystemDefaultLCID())); return TCL_OK; } |