Fix bug #1692927 (buffer length problems). Added 'testfindwindow' and 'testgetwindowinfo'

and extended 'testwinevent' for WM_COMMAND support to enable testing native messagebox
dialogs and added a new test file to use these functions.

2 files changed, 152 insertions, 34 deletions

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