diff options
| -rw-r--r-- | ChangeLog | 8 | ||||
| -rw-r--r-- | tests/winMsgbox.test | 299 | ||||
| -rw-r--r-- | win/tkWinDialog.c | 49 | ||||
| -rw-r--r-- | win/tkWinTest.c | 137 |
4 files changed, 459 insertions, 34 deletions
@@ -1,3 +1,11 @@ +2007-08-01 Pat Thoyts <patthoyts@users.sourceforge.net> + + * win/tkWinDialog.c: Fix bug #1692927 (buffer length problems) + * win/tkWinTest.c: Added 'testfindwindow' and 'testgetwindowinfo' + and extended 'testwinevent' for WM_COMMAND support to enable testing + native messagebox dialogs. + * tests/winMsgbox.test: New Windows native messagebox tests. + 2007-07-25 Daniel Steffen <das@users.sourceforge.net> * macosx/tkMacOSXDialog.c (NavServicesGetFile): reset interp result on diff --git a/tests/winMsgbox.test b/tests/winMsgbox.test new file mode 100644 index 0000000..c34873d --- /dev/null +++ b/tests/winMsgbox.test @@ -0,0 +1,299 @@ +# This file is a Tcl script to test the Windows specific message box +# +# Copyright (c) 2007 Pat Thoyts <patthoyts@users.sourceforge.net> +# +# RCS: @(#) $Id: winMsgbox.test,v 1.1 2007/08/01 09:02:54 patthoyts Exp $ + +package require tcltest 2.1 +eval tcltest::configure $argv +tcltest::loadTestedCommands + +testConstraint getwindowinfo [expr {[llength [info command ::testgetwindowinfo]] > 0}] + +if {[testConstraint testwinevent]} { + catch {testwinevent debug 1} +} + +proc Click {hwnd button} { + testwinevent $hwnd $button WM_COMMAND +} + +proc GetWindowInfo {title button} { + global windowInfo + set windowInfo {} + set hwnd [testfindwindow $title "#32770"] + set windowInfo [testgetwindowinfo $hwnd] + array set a $windowInfo + set childinfo {} ; set childtext "" + foreach child $a(children) { + lappend childinfo $child [set info [testgetwindowinfo $child]] + array set ca $info + if {$ca(class) eq "Static"} { + append childtext $ca(text) + } + } + set a(children) $childinfo + set a(childtext) $childtext + set windowInfo [array get a] + testwinevent $hwnd $button WM_COMMAND +} + +# ------------------------------------------------------------------------- + +test winMsgbox-1.0 {tk_messageBox ok} -constraints {win getwindowinfo} -setup { + wm iconify . +} -body { + global windowInfo + set title "winMsgbox-1.0 [pid]" + after 100 [list GetWindowInfo $title 2] + tk_messageBox -icon info -type ok -title $title -message Message +} -cleanup { + wm deiconify . +} -result {ok} + +test winMsgbox-1.1 {tk_messageBox okcancel} -constraints {win getwindowinfo} -setup { + wm iconify . +} -body { + global windowInfo + set title "winMsgbox-1.1 [pid]" + after 100 [list GetWindowInfo $title 1] + tk_messageBox -icon info -type okcancel -title $title -message Message +} -cleanup { + wm deiconify . +} -result {ok} + +test winMsgbox-1.2 {tk_messageBox okcancel} -constraints {win getwindowinfo} -setup { + wm iconify . +} -body { + global windowInfo + set title "winMsgbox-1.2 [pid]" + after 100 [list GetWindowInfo $title 2] + tk_messageBox -icon info -type okcancel -title $title -message Message +} -cleanup { + wm deiconify . +} -result {cancel} + +test winMsgbox-1.3 {tk_messageBox yesno} -constraints {win getwindowinfo} -setup { + wm iconify . +} -body { + global windowInfo + set title "winMsgbox-1.3 [pid]" + after 100 [list GetWindowInfo $title 6] + tk_messageBox -icon info -type yesno -title $title -message Message +} -cleanup { + wm deiconify . +} -result {yes} + +test winMsgbox-1.4 {tk_messageBox yesno} -constraints {win getwindowinfo} -setup { + wm iconify . +} -body { + global windowInfo + set title "winMsgbox-1.4 [pid]" + after 100 [list GetWindowInfo $title 7] + tk_messageBox -icon info -type yesno -title $title -message Message +} -cleanup { + wm deiconify . +} -result {no} + +test winMsgbox-1.5 {tk_messageBox abortretryignore} -constraints {win getwindowinfo} -setup { + wm iconify . +} -body { + global windowInfo + set title "winMsgbox-1.5 [pid]" + after 100 [list GetWindowInfo $title 3] + tk_messageBox -icon info -type abortretryignore -title $title -message Message +} -cleanup { + wm deiconify . +} -result {abort} + +test winMsgbox-1.6 {tk_messageBox abortretryignore} -constraints {win getwindowinfo} -setup { + wm iconify . +} -body { + global windowInfo + set title "winMsgbox-1.6 [pid]" + after 100 [list GetWindowInfo $title 4] + tk_messageBox -icon info -type abortretryignore -title $title -message Message +} -cleanup { + wm deiconify . +} -result {retry} + +test winMsgbox-1.7 {tk_messageBox abortretryignore} -constraints {win getwindowinfo} -setup { + wm iconify . +} -body { + global windowInfo + set title "winMsgbox-1.7 [pid]" + after 100 [list GetWindowInfo $title 5] + tk_messageBox -icon info -type abortretryignore -title $title -message Message +} -cleanup { + wm deiconify . +} -result {ignore} + +test winMsgbox-1.8 {tk_messageBox retrycancel} -constraints {win getwindowinfo} -setup { + wm iconify . +} -body { + global windowInfo + set title "winMsgbox-1.8 [pid]" + after 100 [list GetWindowInfo $title 4] + tk_messageBox -icon info -type retrycancel -title $title -message Message +} -cleanup { + wm deiconify . +} -result {retry} + +test winMsgbox-1.9 {tk_messageBox retrycancel} -constraints {win getwindowinfo} -setup { + wm iconify . +} -body { + global windowInfo + set title "winMsgbox-1.9 [pid]" + after 100 [list GetWindowInfo $title 2] + tk_messageBox -icon info -type retrycancel -title $title -message Message +} -cleanup { + wm deiconify . +} -result {cancel} + +test winMsgbox-1.10 {tk_messageBox yesnocancel} -constraints {win getwindowinfo} -setup { + wm iconify . +} -body { + global windowInfo + set title "winMsgbox-1.10 [pid]" + after 100 [list GetWindowInfo $title 6] + tk_messageBox -icon info -type yesnocancel -title $title -message Message +} -cleanup { + wm deiconify . +} -result {yes} + +test winMsgbox-1.11 {tk_messageBox yesnocancel} -constraints {win getwindowinfo} -setup { + wm iconify . +} -body { + global windowInfo + set title "winMsgbox-1.11 [pid]" + after 100 [list GetWindowInfo $title 7] + tk_messageBox -icon info -type yesnocancel -title $title -message Message +} -cleanup { + wm deiconify . +} -result {no} + +test winMsgbox-1.12 {tk_messageBox yesnocancel} -constraints {win getwindowinfo} -setup { + wm iconify . +} -body { + global windowInfo + set title "winMsgbox-1.12 [pid]" + after 100 [list GetWindowInfo $title 2] + tk_messageBox -icon info -type yesnocancel -title $title -message Message +} -cleanup { + wm deiconify . +} -result {cancel} + +# ------------------------------------------------------------------------- + +test winMsgbox-2.0 {tk_messageBox message} -constraints {win getwindowinfo} -setup { + wm iconify . + unset -nocomplain info +} -body { + global windowInfo + set title "winMsgbox-2.0 [pid]" + set message "message" + after 100 [list GetWindowInfo $title 2] + set r [tk_messageBox -type ok -title $title -message $message] + array set info $windowInfo + lappend r $info(childtext) +} -cleanup { + wm deiconify . +} -result [list ok "message"] + +test winMsgbox-2.1 {tk_messageBox message (long)} -constraints { + win getwindowinfo +} -setup { + wm iconify . + unset -nocomplain info +} -body { + global windowInfo + set title "winMsgbox-2.1 [pid]" + set message [string repeat Ab 80] + after 100 [list GetWindowInfo $title 2] + set r [tk_messageBox -type ok -title $title -message $message] + array set info $windowInfo + lappend r $info(childtext) +} -cleanup { + wm deiconify . +} -result [list ok [string repeat Ab 80]] + +test winMsgbox-2.2 {tk_messageBox message (unicode)} -constraints { + win getwindowinfo +} -setup { + wm iconify . + unset -nocomplain info +} -body { + global windowInfo + set title "winMsgbox-2.2 [pid]" + set message "\u041f\u043e\u0438\u0441\u043a\u0020\u0441\u0442\u0440\u0430\u043d\u0438\u0446" + after 100 [list GetWindowInfo $title 2] + set r [tk_messageBox -type ok -title $title -message $message] + array set info $windowInfo + lappend r $info(childtext) +} -cleanup { + wm deiconify . +} -result [list ok "\u041f\u043e\u0438\u0441\u043a\u0020\u0441\u0442\u0440\u0430\u043d\u0438\u0446"] + +test winMsgbox-2.3 {tk_messageBox message (empty)} -constraints { + win getwindowinfo +} -setup { + wm iconify . + unset -nocomplain info +} -body { + global windowInfo + set title "winMsgbox-2.3 [pid]" + after 100 [list GetWindowInfo $title 2] + set r [tk_messageBox -type ok -title $title] + array set info $windowInfo + lappend r $info(childtext) +} -cleanup { + wm deiconify . +} -result [list ok ""] + +test winMsgbox-3.0 {tk_messageBox detail (sourceforge bug #1692927)} -constraints { + win getwindowinfo +} -setup { + wm iconify . + unset -nocomplain info +} -body { + global windowInfo + set title "winMsgbox-3.0 [pid]" + after 100 [list GetWindowInfo $title 2] + set r [tk_messageBox -type ok -title $title \ + -message Hello -detail "Pleased to meet you"] + array set info $windowInfo + lappend r $info(childtext) +} -cleanup { + wm deiconify . +} -result [list ok "Hello\n\nPleased to meet you"] + +test winMsgbox-3.1 {tk_messageBox detail (unicode)} -constraints { + win getwindowinfo +} -setup { + wm iconify . + unset -nocomplain info +} -body { + global windowInfo + set title "winMsgbox-3.1 [pid]" + set message "\u041f\u043e\u0438\u0441\u043a" + set detail "\u0441\u0442\u0440\u0430\u043d\u0438\u0446" + after 100 [list GetWindowInfo $title 2] + set r [tk_messageBox -type ok -title $title -message $message -detail $detail] + array set info $windowInfo + lappend r $info(childtext) +} -cleanup { + wm deiconify . +} -result [list ok "\u041f\u043e\u0438\u0441\u043a\n\n\u0441\u0442\u0440\u0430\u043d\u0438\u0446"] + +# ------------------------------------------------------------------------- + +if {[testConstraint testwinevent]} { + catch {testwinevent debug 0} +} +cleanupTests +return + +# Local variables: +# mode: tcl +# indent-tabs-mode: nil +# End:
\ No newline at end of file diff --git a/win/tkWinDialog.c b/win/tkWinDialog.c index 1da6aae..9cab235 100644 --- a/win/tkWinDialog.c +++ b/win/tkWinDialog.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkWinDialog.c,v 1.44 2007/01/11 15:35:40 dkf Exp $ + * RCS: @(#) $Id: tkWinDialog.c,v 1.45 2007/08/01 09:02:54 patthoyts Exp $ * */ @@ -2007,11 +2007,10 @@ Tk_MessageBoxObjCmd( { Tk_Window tkwin, parent; HWND hWnd; - char *message, *title, *detail; + Tcl_Obj *messageObj, *titleObj, *detailObj, *tmpObj; int defaultBtn, icon, type; int i, oldMode, winCode; UINT flags; - Tcl_DString messageString, titleString; Tcl_Encoding unicodeEncoding = TkWinGetUnicodeEncoding(); static CONST char *optionStrings[] = { "-default", "-detail", "-icon", "-message", @@ -2027,11 +2026,11 @@ Tk_MessageBoxObjCmd( tkwin = (Tk_Window) clientData; defaultBtn = -1; - detail = NULL; + detailObj = NULL; icon = MB_ICONINFORMATION; - message = NULL; + messageObj = NULL; parent = tkwin; - title = NULL; + titleObj = NULL; type = MB_OK; for (i = 1; i < objc; i += 2) { @@ -2053,7 +2052,6 @@ Tk_MessageBoxObjCmd( return TCL_ERROR; } - string = Tcl_GetString(valuePtr); switch ((enum options) index) { case MSG_DEFAULT: defaultBtn = TkFindStateNumObj(interp, optionPtr, buttonMap, @@ -2064,7 +2062,7 @@ Tk_MessageBoxObjCmd( break; case MSG_DETAIL: - detail = string; + detailObj = valuePtr; break; case MSG_ICON: @@ -2075,18 +2073,18 @@ Tk_MessageBoxObjCmd( break; case MSG_MESSAGE: - message = string; + messageObj = valuePtr; break; case MSG_PARENT: - parent = Tk_NameToWindow(interp, string, tkwin); + parent = Tk_NameToWindow(interp, Tcl_GetString(valuePtr), tkwin); if (parent == NULL) { return TCL_ERROR; } break; case MSG_TITLE: - title = string; + titleObj = valuePtr; break; case MSG_TYPE: @@ -2130,24 +2128,12 @@ Tk_MessageBoxObjCmd( flags |= icon | type | MB_SYSTEMMODAL; - Tcl_UtfToExternalDString(unicodeEncoding, message, -1, &messageString); - if (detail != NULL) { - Tcl_DString detailString; - - if (message != NULL) { - Tcl_UtfToExternalDString(unicodeEncoding, "\n\n", -1, - &detailString); - Tcl_DStringAppend(&messageString, Tcl_DStringValue(&detailString), - Tcl_DStringLength(&detailString)); - Tcl_DStringFree(&detailString); - } - Tcl_UtfToExternalDString(unicodeEncoding, detail, -1, - &detailString); - Tcl_DStringAppend(&messageString, Tcl_DStringValue(&detailString), - Tcl_DStringLength(&detailString)); - Tcl_DStringFree(&detailString); + tmpObj = messageObj ? Tcl_DuplicateObj(messageObj) : Tcl_NewUnicodeObj(NULL, 0); + Tcl_IncrRefCount(tmpObj); + if (detailObj) { + Tcl_AppendUnicodeToObj(tmpObj, L"\n\n", 2); + Tcl_AppendObjToObj(tmpObj, detailObj); } - Tcl_UtfToExternalDString(unicodeEncoding, title, -1, &titleString); oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); @@ -2164,8 +2150,8 @@ Tk_MessageBoxObjCmd( tsdPtr->hBigIcon = TkWinGetIcon(parent, ICON_BIG); tsdPtr->hMsgBoxHook = SetWindowsHookEx(WH_CBT, MsgBoxCBTProc, NULL, GetCurrentThreadId()); - winCode = MessageBoxW(hWnd, (WCHAR *) Tcl_DStringValue(&messageString), - (WCHAR *) Tcl_DStringValue(&titleString), flags); + winCode = MessageBoxW(hWnd, Tcl_GetUnicode(tmpObj), + titleObj ? Tcl_GetUnicode(titleObj) : NULL, flags); UnhookWindowsHookEx(tsdPtr->hMsgBoxHook); (void) Tcl_SetServiceMode(oldMode); @@ -2177,8 +2163,7 @@ Tk_MessageBoxObjCmd( EnableWindow(hWnd, 1); - Tcl_DStringFree(&messageString); - Tcl_DStringFree(&titleString); + Tcl_DecrRefCount(tmpObj); Tcl_SetResult(interp, TkFindStateString(buttonMap, winCode), TCL_STATIC); return TCL_OK; diff --git a/win/tkWinTest.c b/win/tkWinTest.c index d73f159..da9b24b 100644 --- a/win/tkWinTest.c +++ b/win/tkWinTest.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkWinTest.c,v 1.12 2007/01/18 23:56:44 nijtmans Exp $ + * RCS: @(#) $Id: tkWinTest.c,v 1.13 2007/08/01 09:02:54 patthoyts Exp $ */ #include "tkWinInt.h" @@ -27,6 +27,12 @@ static int TestclipboardObjCmd(ClientData clientData, Tcl_Obj *CONST objv[]); static int TestwineventCmd(ClientData clientData, Tcl_Interp *interp, int argc, CONST char **argv); +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[]); MODULE_SCOPE int TkplatformtestInit(Tcl_Interp *interp); @@ -59,6 +65,10 @@ TkplatformtestInit( (ClientData) Tk_MainWindow(interp), NULL); Tcl_CreateCommand(interp, "testwinevent", TestwineventCmd, (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); return TCL_OK; } @@ -232,6 +242,7 @@ TestwineventCmd( CONST char **argv) /* Argument strings. */ { HWND hwnd = 0; + HWND child = 0; int id; char *rest; UINT message; @@ -243,6 +254,7 @@ TestwineventCmd( {WM_CHAR, "WM_CHAR"}, {WM_GETTEXT, "WM_GETTEXT"}, {WM_SETTEXT, "WM_SETTEXT"}, + {WM_COMMAND, "WM_COMMAND"}, {-1, NULL} }; @@ -282,7 +294,6 @@ TestwineventCmd( id = strtol(argv[2], &rest, 0); if (rest == argv[2]) { - HWND child; char buf[256]; child = GetWindow(hwnd, GW_CHILD); @@ -331,6 +342,16 @@ TestwineventCmd( Tcl_DStringFree(&ds); break; } + case WM_COMMAND: { + char buf[TCL_INTEGER_SPACE]; + if (argc < 5) { + wParam = MAKEWPARAM(id, 0); + lParam = (LPARAM)child; + } + sprintf(buf, "%d", SendMessage(hwnd, message, wParam, lParam)); + Tcl_SetResult(interp, buf, TCL_VOLATILE); + break; + } default: { char buf[TCL_INTEGER_SPACE]; @@ -344,6 +365,118 @@ 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 + * 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. */ +{ + TkWindow *winPtr = (TkWindow *) clientData; + 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((long)hwnd)); + } + return r; + +} + +static BOOL CALLBACK +EnumChildrenProc(HWND hwnd, LPARAM lParam) +{ + Tcl_Obj *listObj = (Tcl_Obj *)lParam; + Tcl_ListObjAppendElement(NULL, listObj, Tcl_NewLongObj((long)hwnd)); + return TRUE; +} + +static int +TestgetwindowinfoObjCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST objv[]) +{ + HWND hwnd = NULL; + 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], (long *)&hwnd) != TCL_OK) + return TCL_ERROR; + + if (tkWinProcs->useWide) { + cch = GetClassNameW(hwnd, (LPWSTR)buf, sizeof(buf)/sizeof(WCHAR)); + classObj = Tcl_NewUnicodeObj((LPWSTR)buf, cch); + } else { + cch = GetClassNameA(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(hwnd, GWL_ID))); + + cch = tkWinProcs->getWindowText(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); + + childrenObj = Tcl_NewListObj(0, NULL); + EnumChildWindows(hwnd, EnumChildrenProc, (LPARAM)childrenObj); + Tcl_ListObjAppendElement(interp, resObj, Tcl_NewStringObj("children", -1)); + Tcl_ListObjAppendElement(interp, resObj, childrenObj); + + Tcl_SetObjResult(interp, resObj); + return TCL_OK; +} + +/* * Local Variables: * mode: c * c-basic-offset: 4 |