From e6b3b1777638434f20719699fb170d21545c38a7 Mon Sep 17 00:00:00 2001
From: patthoyts <patthoyts@users.sourceforge.net>
Date: Wed, 1 Aug 2007 09:02:54 +0000
Subject: 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.
---
ChangeLog | 8 ++
tests/winMsgbox.test | 299 +++++++++++++++++++++++++++++++++++++++++++++++++++
win/tkWinDialog.c | 49 +++------
win/tkWinTest.c | 137 ++++++++++++++++++++++-
4 files changed, 459 insertions(+), 34 deletions(-)
create mode 100644 tests/winMsgbox.test
diff --git a/ChangeLog b/ChangeLog
index bd285f1..e11f4d1 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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
--
cgit v0.12