Tk Source Code

2012-11-13  Jan Nijtmans  <[email protected]>

	* win/tkWinTest.c: [Bug 3585396]: winDialog.test requires user
	* tests/winDialog.test: interaction. Renumber test-cases as in
	Tk 8.6, and convert various to tcltest-2 style.

2012-11-09  Don Porter  <[email protected]>

	*** 8.5.13 TAGGED FOR RELEASE ***

	* generic/tk.h:		Bump to 8.5.13 for release.
	* library/tk.tcl:
	* unix/configure.in:

    return [testwinevent $::tk_dialog $id WM_GETTEXT]
}

proc SetText {id text} {
    return [testwinevent $::tk_dialog $id WM_SETTEXT $text]
}

test winDialog-1.1 {Tk_ChooseColorObjCmd} -constraints {
    testwinevent
} -body {
    start {tk_chooseColor}
    then {
        Click cancel
    }
} -result {0}
test winDialog-1.2 {Tk_ChooseColorObjCmd} -constraints {
    testwinevent
} -body {
    start {set clr [tk_chooseColor -initialcolor "#ff9933"]}
    then {
        set x [Click cancel]
    }
    list $x $clr
} -result {0 {}}
test winDialog-1.3 {Tk_ChooseColorObjCmd} -constraints {
    testwinevent
} -body {
    start {set clr [tk_chooseColor -initialcolor "#ff9933"]}
    then {
        set x [Click ok]
    }
    list $x $clr
} -result [list 0 "#ff9933"]
test winDialog-1.4 {Tk_ChooseColorObjCmd: -title} -constraints {
    testwinevent
} -setup {
    catch {unset a x}
} -body {
    set x {}
    start {set clr [tk_chooseColor -initialcolor "#ff9933" -title "Hello"]}
    then {
        if {[catch {
            array set a [testgetwindowinfo $::tk_dialog]
            if {[info exists a(text)]} {lappend x $a(text)}
        } err]} { lappend x $err }
        lappend x [Click ok]
    }
    lappend x $clr
} -result [list Hello 0 "#ff9933"]
test winDialog-1.5 {Tk_ChooseColorObjCmd: -title} -constraints {
    testwinevent
} -setup {
    catch {unset a x}
} -body {
    set x {}
    start {
        set clr [tk_chooseColor -initialcolor "#ff9933" \
                     -title "\u041f\u0440\u0438\u0432\u0435\u0442"]
    }
    then {
        if {[catch {
            array set a [testgetwindowinfo $::tk_dialog]
            if {[info exists a(text)]} {lappend x $a(text)}
        } err]} { lappend x $err }
        lappend x [Click ok]
    }
    lappend x $clr
} -result [list "\u041f\u0440\u0438\u0432\u0435\u0442" 0 "#ff9933"]
test winDialog-1.6 {Tk_ChooseColorObjCmd: -parent} -constraints {
    testwinevent
} -setup {
    catch {unset a x}
} -body {
    start {set clr [tk_chooseColor -initialcolor "#ff9933" -parent .]}
    set x {}
    then {
        if {[catch {
            array set a [testgetwindowinfo $::tk_dialog]
            if {[info exists a(parent)]} {
                append x [expr {$a(parent) == [wm frame .]}]
            }
        } err]} {lappend x $err}
        Click ok
    }
    list $x $clr
} -result [list 1 "#ff9933"]
test winDialog-1.7 {Tk_ChooseColorObjCmd: -parent} -constraints {
    testwinevent
} -body {
    tk_chooseColor -initialcolor "#ff9933" -parent .xyzzy12
} -returnCodes error -match glob -result {bad window path name*}




test winDialog-3.1 {Tk_GetOpenFileObjCmd} -constraints {
    nt testwinevent english
} -body {
    start {tk_getOpenFile}
    then {
	set x [GetText cancel]
	Click cancel
    }
    return $x
} -result {Cancel}


test winDialog-4.1 {Tk_GetSaveFileObjCmd} -constraints {
    nt testwinevent english
} -body {
    start {tk_getSaveFile}
    then {
	set x [GetText cancel]
	Click cancel
    }
    return $x
} -result {Cancel}

test winDialog-5.1 {GetFileName: no arguments} -constraints {
    nt testwinevent
} -body {
    start {tk_getOpenFile -title Open}
    then {
	Click cancel
    }
} -result {0}
test winDialog-5.2 {GetFileName: one argument} -constraints {
    nt
} -body {
    tk_getOpenFile -foo
} -returnCodes error -result {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -multiple, -parent, -title, or -typevariable}
test winDialog-5.3 {GetFileName: many arguments} -constraints {
    nt testwinevent
} -body {
    start {tk_getOpenFile -initialdir c:/ -parent . -title test -initialfile foo}
    then {
	Click cancel
    }
} -result {0}
test winDialog-5.4 {GetFileName: Tcl_GetIndexFromObj() != TCL_OK} -constraints {
    nt
} -body {
    tk_getOpenFile -foo bar -abc
} -returnCodes error -result {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -multiple, -parent, -title, or -typevariable}
test winDialog-5.5 {GetFileName: Tcl_GetIndexFromObj() == TCL_OK} -constraints {
    nt testwinevent
} -body {
    start {tk_getOpenFile -title bar}
    then {
	Click cancel
    }
} -result {0}
test winDialog-5.6 {GetFileName: valid option, but missing value} -constraints {
    nt
} -body {
    tk_getOpenFile -initialdir bar -title
} -returnCodes error -result {value for "-title" missing}
test winDialog-5.7 {GetFileName: extension begins with .} -constraints {
    nt testwinevent
} -body {
#    if (string[0] == '.') {
#	string++;
#    }

    start {set x [tk_getSaveFile -defaultextension .foo -title Save]}
    set msg {}
    then {
	if {[catch {SetText 0x47C bar} msg]} {
	    Click cancel
	} else {
	    Click ok
	}
    }
    return [string totitle $x]$msg
} -cleanup {
    unset msg
} -result [string totitle [file join [pwd] bar.foo]]
test winDialog-5.8 {GetFileName: extension doesn't begin with .} -constraints {
    nt testwinevent
} -body {
    start {set x [tk_getSaveFile -defaultextension foo -title Save]}
    set msg {}
    then {
	if {[catch {SetText 0x47C bar} msg]} {
	    Click cancel
	} else {
	    Click ok
	}
    }
    return [string totitle $x]$msg
} -cleanup {
    unset msg
} -result [string totitle [file join [pwd] bar.foo]]
test winDialog-5.9 {GetFileName: file types} -constraints {
    nt testwinevent
} -body {
#	case FILE_TYPES:

    start {tk_getSaveFile -filetypes {{"foo files" .foo FOOF}} -title Foo}
    then {
	set x [GetText 0x470]
	Click cancel
    }
    return $x
} -result {foo files (*.foo)}
test winDialog-5.10 {GetFileName: file types: MakeFilter() fails} -constraints {
    nt
} -body {
#	if (MakeFilter(interp, string, &utfFilterString) != TCL_OK)

    tk_getSaveFile -filetypes {{"foo" .foo FOO}}
} -returnCodes error -result {bad Macintosh file type "FOO"}
if {[info exists ::env(TEMP)]} {
test winDialog-5.11 {GetFileName: initial directory} -constraints {
    nt testwinevent
} -body {
#	case FILE_INITDIR:

    start {set x [tk_getSaveFile \
                      -initialdir [file normalize $::env(TEMP)] \
                      -initialfile "12x 455" -title Foo]}
    then {
	Click ok
    }
    return $x
} -result [file join [file normalize $::env(TEMP)] "12x 455"]
}
test winDialog-5.12 {GetFileName: initial directory: Tcl_TranslateFilename()} -constraints {
    nt
} -body {
#	if (Tcl_TranslateFileName(interp, string, &ds) == NULL)

    tk_getOpenFile -initialdir ~12x/455
} -returnCodes error -result {user "12x" doesn't exist}
test winDialog-5.13 {GetFileName: initial file} -constraints {
    nt testwinevent
} -body {
#	case FILE_INITFILE:

    start {set x [tk_getSaveFile -initialfile "12x 456" -title Foo]}
    then {
	Click ok
    }
    string totitle $x
} -result [string totitle [file join [pwd] "12x 456"]]
test winDialog-5.14 {GetFileName: initial file: Tcl_TranslateFileName()} -constraints {
    nt
} -body {
#	if (Tcl_TranslateFileName(interp, string, &ds) == NULL)
    tk_getOpenFile -initialfile ~12x/455
} -returnCodes error -result {user "12x" doesn't exist}
test winDialog-5.15 {GetFileName: initial file: long name} -constraints {
    nt testwinevent
} -body {
    start {
	set dialogresult [catch {
	    tk_getSaveFile -initialfile [string repeat a 1024] -title Long
	} x]
    }
    then {
	Click ok
    }
    list $dialogresult [string match "invalid filename *" $x]
} -result {1 1}
test winDialog-5.16 {GetFileName: parent} -constraints {
    nt
} -body {
#	case FILE_PARENT:

    toplevel .t
    set x 0
    start {tk_getOpenFile -parent .t -title Parent; set x 1}
    then {
	destroy .t
    }
    return $x
} -result {1}
test winDialog-5.17 {GetFileName: title} -constraints {
    nt testwinevent
} -body {
#	case FILE_TITLE:

    start {tk_getOpenFile -title Narf}
    then {
	Click cancel
    }
} -result {0}
test winDialog-5.18 {GetFileName: no filter specified} -constraints {
    nt testwinevent
} -body {
#    if (ofn.lpstrFilter == NULL)

    start {tk_getOpenFile -title Filter}
    then {
	set x [GetText 0x470]
	Click cancel
    }
    return $x
} -result {All Files (*.*)}
test winDialog-5.19 {GetFileName: parent HWND doesn't yet exist} -constraints {
    nt
} -setup {
    destroy .t
} -body {
#    if (Tk_WindowId(parent) == None)

    toplevel .t
    start {tk_getOpenFile -parent .t -title Open}
    then {
	destroy .t
    }
} -result {}
test winDialog-5.20 {GetFileName: parent HWND already exists} -constraints {
    nt
} -setup {
    destroy .t
} -body {
    toplevel .t
    update
    start {tk_getOpenFile -parent .t -title Open}
    then {
	destroy .t
    }
} -result {}
test winDialog-5.21 {GetFileName: call GetOpenFileName} -constraints {
    nt testwinevent english
} -body {
#	winCode = GetOpenFileName(&ofn);

    start {tk_getOpenFile -title Open}
    then {
	set x [GetText ok]
	Click cancel
    }
    return $x
} -result {&Open}
test winDialog-5.22 {GetFileName: call GetSaveFileName} -constraints {
    nt testwinevent english
} -body {
#	winCode = GetSaveFileName(&ofn);

    start {tk_getSaveFile -title Save}
    then {
	set x [GetText ok]
	Click cancel
    }
    return $x
} -result {&Save}
if {[info exists ::env(TEMP)]} {
test winDialog-5.23 {GetFileName: convert \ to /} -constraints {
    nt testwinevent
} -body {
    set msg {}
    start {set x [tk_getSaveFile -title Back]}
    then {
	if {[catch {SetText 0x47C [file nativename \
		[file join [file normalize $::env(TEMP)] "12x 457"]]} msg]} {
	    Click cancel
	} else {
	    Click ok
	}
    }
    return $x$msg
} -cleanup {
    unset msg
} -result [file join [file normalize $::env(TEMP)] "12x 457"]
}
test winDialog-5.24 {GetFileName: file types: MakeFilter() succeeds} -constraints {
    nt
} -body {
    # MacOS type that is correct, but has embedded nulls.

    start {set x [catch {tk_getSaveFile -filetypes {{"foo" .foo {\0\0\0\0}}}}]}
    then {
	Click cancel
    }
    return $x
} -result {0}
test winDialog-5.25 {GetFileName: file types: MakeFilter() succeeds} -constraints {
    nt
} -body {
    # MacOS type that is correct, but has embedded high-bit chars.

    start {set x [catch {tk_getSaveFile -filetypes {{"foo" .foo {\u2022\u2022\u2022\u2022}}}}]}
    then {
	Click cancel
    }


    return $x

} -result {0}




## The Tk_ChooseDirectoryObjCmd hang on the static build of Windows
## because somehow the GetOpenFileName ends up a noop in the static
## build.
##
test winDialog-9.1 {Tk_ChooseDirectoryObjCmd: no arguments} -constraints {
    nt testwinevent
} -body {
    start {tk_chooseDirectory}
    then {
	Click cancel
    }
} -result {0}
test winDialog-9.2 {Tk_ChooseDirectoryObjCmd: one argument} -constraints {
    nt
} -body {
    tk_chooseDirectory -foo
} -returnCodes error -result {bad option "-foo": must be -initialdir, -mustexist, -parent, or -title}
test winDialog-9.3 {Tk_ChooseDirectoryObjCmd: many arguments} -constraints {
    nt testwinevent
} -body {
    start {
	tk_chooseDirectory -initialdir c:/ -mustexist 1 -parent . -title test
    }
    then {
	Click cancel
    }
} -result {0}
test winDialog-9.4 {Tk_ChooseDirectoryObjCmd: Tcl_GetIndexFromObj() != TCL_OK} -constraints {
    nt
} -body {
    tk_chooseDirectory -foo bar -abc
} -returnCodes error -result {bad option "-foo": must be -initialdir, -mustexist, -parent, or -title}
test winDialog-9.5 {Tk_ChooseDirectoryObjCmd: Tcl_GetIndexFromObj() == TCL_OK} -constraints {
    nt testwinevent
} -body {
    start {tk_chooseDirectory -title bar}
    then {
	Click cancel
    }
} -result {0}
test winDialog-9.6 {Tk_ChooseDirectoryObjCmd: valid option, but missing value} -constraints {

    nt
} -body {
    tk_chooseDirectory -initialdir bar -title
} -returnCodes error -result {value for "-title" missing}
test winDialog-9.7 {Tk_ChooseDirectoryObjCmd: -initialdir} -constraints {
    nt testwinevent
} -body {
#	case DIR_INITIAL:

    start {set x [tk_chooseDirectory -initialdir c:/ -title Foo]}
    then {
	Click ok
    }
    string tolower [set x]
} -result {c:/}
test winDialog-9.8 {Tk_ChooseDirectoryObjCmd: initial directory: Tcl_TranslateFilename()} -constraints {
    nt
} -body {
#	if (Tcl_TranslateFileName(interp, string,
#		&utfDirString) == NULL)

    tk_chooseDirectory -initialdir ~12x/455
} -returnCodes error -result {user "12x" doesn't exist}

if {[testConstraint testwinevent]} {
    catch {testwinevent debug 0}
}

# cleanup
cleanupTests
return

# Local variables:
# mode: tcl
# End:

/*
 * Forward declarations of functions defined later in this file:
 */

static int		TestclipboardObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    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[]);
static int		TestwinlocaleObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TkplatformtestInit(Tcl_Interp *interp);


/*
 *----------------------------------------------------------------------
 *
 * TkplatformtestInit --
 *
 *	Defines commands that test platform specific functionality for Windows
 *	platforms.

static void
AppendSystemError(
    Tcl_Interp *interp,		/* Current interpreter. */
    DWORD error)		/* Result code from error. */
{
    int length;
    WCHAR *wMsgPtr, **wMsgPtrPtr = &wMsgPtr;
    const char *msg;
    char id[TCL_INTEGER_SPACE], msgBuf[24 + TCL_INTEGER_SPACE];
    Tcl_DString ds;
    Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);

    if (Tcl_IsShared(resultPtr)) {
	resultPtr = Tcl_DuplicateObj(resultPtr);
    }
    length = FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM
	    | FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error,
	    MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (WCHAR *) wMsgPtrPtr,
	    0, NULL);
    if (length == 0) {
	char *msgPtr;

	length = FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM
		| FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error,
		MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (char *) &msgPtr,
		0, NULL);
	if (length > 0) {
	    wMsgPtr = (WCHAR *) LocalAlloc(LPTR, (length + 1) * sizeof(WCHAR));
	    MultiByteToWideChar(CP_ACP, 0, msgPtr, length + 1, wMsgPtr,
		    length + 1);
	    LocalFree(msgPtr);
	}
    }
    if (length == 0) {
	if (error == ERROR_CALL_NOT_IMPLEMENTED) {
	    strcpy(msgBuf, "function not supported under Win32s");
	} else {
	    sprintf(msgBuf, "unknown error: %ld", error);

	}
	msg = msgBuf;
    } else {
	Tcl_Encoding encoding;
	char *msgPtr;

	encoding = Tcl_GetEncoding(NULL, "unicode");
	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 (msgPtr[length-1] == '\n') {
	    --length;
	}
	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);
    }
}

/*

 */

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. */
{
    HGLOBAL handle;
    char *data;
    int code = TCL_OK;

    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);

 */

static int
TestwineventCmd(
    ClientData clientData,	/* Main window for application. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    HWND hwnd = 0;
    HWND child = 0;
    int id;
    char *rest;
    UINT message;
    WPARAM wParam;

	return TCL_OK;
    }

    if (argc < 4) {
	return TCL_ERROR;
    }

    hwnd = INT2PTR(strtol(argv[1], &rest, 0));
    if (rest == argv[1]) {
	hwnd = FindWindow(NULL, argv[1]);
	if (hwnd == NULL) {
	    Tcl_SetResult(interp, "no such window", TCL_STATIC);
	    return TCL_ERROR;
	}
    }

	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;

    }
    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?");

	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. */