1# This file is a Tcl script to test the Windows specific message box
2#
3# Copyright (c) 2007 Pat Thoyts <patthoyts@users.sourceforge.net>
4#
5# RCS: @(#) $Id$
6
7package require tcltest 2.1
8eval tcltest::configure $argv
9tcltest::loadTestedCommands
10
11testConstraint getwindowinfo [expr {[llength [info command ::testgetwindowinfo]] > 0}]
12
13if {[testConstraint testwinevent]} {
14    catch {testwinevent debug 1}
15}
16
17proc Click {hwnd button} {
18    testwinevent $hwnd $button WM_COMMAND
19}
20
21proc GetWindowInfo {title button} {
22    global windowInfo
23    set windowInfo {}
24    set hwnd [testfindwindow $title "#32770"]
25    set windowInfo [testgetwindowinfo $hwnd]
26    array set a $windowInfo
27    set childinfo {} ; set childtext ""
28    foreach child $a(children) {
29        lappend childinfo $child [set info [testgetwindowinfo $child]]
30        array set ca $info
31        if {$ca(class) eq "Static"} {
32            append childtext $ca(text)
33        }
34    }
35    set a(children) $childinfo
36    set a(childtext) $childtext
37    set windowInfo [array get a]
38    testwinevent $hwnd $button WM_COMMAND
39}
40
41# -------------------------------------------------------------------------
42
43test winMsgbox-1.0 {tk_messageBox ok} -constraints {win getwindowinfo} -setup {
44    wm iconify .
45} -body {
46    global windowInfo
47    set title "winMsgbox-1.0 [pid]"
48    after 100 [list GetWindowInfo $title 2]
49    tk_messageBox -icon info -type ok -title $title -message Message
50} -cleanup {
51    wm deiconify .
52} -result {ok}
53
54test winMsgbox-1.1 {tk_messageBox okcancel} -constraints {win getwindowinfo} -setup {
55    wm iconify .
56} -body {
57    global windowInfo
58    set title "winMsgbox-1.1 [pid]"
59    after 100 [list GetWindowInfo $title 1]
60    tk_messageBox -icon info -type okcancel -title $title -message Message
61} -cleanup {
62    wm deiconify .
63} -result {ok}
64
65test winMsgbox-1.2 {tk_messageBox okcancel} -constraints {win getwindowinfo} -setup {
66    wm iconify .
67} -body {
68    global windowInfo
69    set title "winMsgbox-1.2 [pid]"
70    after 100 [list GetWindowInfo $title 2]
71    tk_messageBox -icon info -type okcancel -title $title -message Message
72} -cleanup {
73    wm deiconify .
74} -result {cancel}
75
76test winMsgbox-1.3 {tk_messageBox yesno} -constraints {win getwindowinfo} -setup {
77    wm iconify .
78} -body {
79    global windowInfo
80    set title "winMsgbox-1.3 [pid]"
81    after 100 [list GetWindowInfo $title 6]
82    tk_messageBox -icon info -type yesno -title $title -message Message
83} -cleanup {
84    wm deiconify .
85} -result {yes}
86
87test winMsgbox-1.4 {tk_messageBox yesno} -constraints {win getwindowinfo} -setup {
88    wm iconify .
89} -body {
90    global windowInfo
91    set title "winMsgbox-1.4 [pid]"
92    after 100 [list GetWindowInfo $title 7]
93    tk_messageBox -icon info -type yesno -title $title -message Message
94} -cleanup {
95    wm deiconify .
96} -result {no}
97
98test winMsgbox-1.5 {tk_messageBox abortretryignore} -constraints {win getwindowinfo} -setup {
99    wm iconify .
100} -body {
101    global windowInfo
102    set title "winMsgbox-1.5 [pid]"
103    after 100 [list GetWindowInfo $title 3]
104    tk_messageBox -icon info -type abortretryignore -title $title -message Message
105} -cleanup {
106    wm deiconify .
107} -result {abort}
108
109test winMsgbox-1.6 {tk_messageBox abortretryignore} -constraints {win getwindowinfo} -setup {
110    wm iconify .
111} -body {
112    global windowInfo
113    set title "winMsgbox-1.6 [pid]"
114    after 100 [list GetWindowInfo $title 4]
115    tk_messageBox -icon info -type abortretryignore -title $title -message Message
116} -cleanup {
117    wm deiconify .
118} -result {retry}
119
120test winMsgbox-1.7 {tk_messageBox abortretryignore} -constraints {win getwindowinfo} -setup {
121    wm iconify .
122} -body {
123    global windowInfo
124    set title "winMsgbox-1.7 [pid]"
125    after 100 [list GetWindowInfo $title 5]
126    tk_messageBox -icon info -type abortretryignore -title $title -message Message
127} -cleanup {
128    wm deiconify .
129} -result {ignore}
130
131test winMsgbox-1.8 {tk_messageBox retrycancel} -constraints {win getwindowinfo} -setup {
132    wm iconify .
133} -body {
134    global windowInfo
135    set title "winMsgbox-1.8 [pid]"
136    after 100 [list GetWindowInfo $title 4]
137    tk_messageBox -icon info -type retrycancel -title $title -message Message
138} -cleanup {
139    wm deiconify .
140} -result {retry}
141
142test winMsgbox-1.9 {tk_messageBox retrycancel} -constraints {win getwindowinfo} -setup {
143    wm iconify .
144} -body {
145    global windowInfo
146    set title "winMsgbox-1.9 [pid]"
147    after 100 [list GetWindowInfo $title 2]
148    tk_messageBox -icon info -type retrycancel -title $title -message Message
149} -cleanup {
150    wm deiconify .
151} -result {cancel}
152
153test winMsgbox-1.10 {tk_messageBox yesnocancel} -constraints {win getwindowinfo} -setup {
154    wm iconify .
155} -body {
156    global windowInfo
157    set title "winMsgbox-1.10 [pid]"
158    after 100 [list GetWindowInfo $title 6]
159    tk_messageBox -icon info -type yesnocancel -title $title -message Message
160} -cleanup {
161    wm deiconify .
162} -result {yes}
163
164test winMsgbox-1.11 {tk_messageBox yesnocancel} -constraints {win getwindowinfo} -setup {
165    wm iconify .
166} -body {
167    global windowInfo
168    set title "winMsgbox-1.11 [pid]"
169    after 100 [list GetWindowInfo $title 7]
170    tk_messageBox -icon info -type yesnocancel -title $title -message Message
171} -cleanup {
172    wm deiconify .
173} -result {no}
174
175test winMsgbox-1.12 {tk_messageBox yesnocancel} -constraints {win getwindowinfo} -setup {
176    wm iconify .
177} -body {
178    global windowInfo
179    set title "winMsgbox-1.12 [pid]"
180    after 100 [list GetWindowInfo $title 2]
181    tk_messageBox -icon info -type yesnocancel -title $title -message Message
182} -cleanup {
183    wm deiconify .
184} -result {cancel}
185
186# -------------------------------------------------------------------------
187
188test winMsgbox-2.0 {tk_messageBox message} -constraints {win getwindowinfo} -setup {
189    wm iconify .
190    unset -nocomplain info
191} -body {
192    global windowInfo
193    set title "winMsgbox-2.0 [pid]"
194    set message "message"
195    after 100 [list GetWindowInfo $title 2]
196    set r [tk_messageBox -type ok -title $title -message $message]
197    array set info $windowInfo
198    lappend r $info(childtext)
199} -cleanup {
200    wm deiconify .
201} -result [list ok "message"]
202
203test winMsgbox-2.1 {tk_messageBox message (long)} -constraints {
204    win getwindowinfo
205} -setup {
206    wm iconify .
207    unset -nocomplain info
208} -body {
209    global windowInfo
210    set title "winMsgbox-2.1 [pid]"
211    set message [string repeat Ab 80]
212    after 100 [list GetWindowInfo $title 2]
213    set r [tk_messageBox -type ok -title $title -message $message]
214    array set info $windowInfo
215    lappend r $info(childtext)
216} -cleanup {
217    wm deiconify .
218} -result [list ok [string repeat Ab 80]]
219
220test winMsgbox-2.2 {tk_messageBox message (unicode)} -constraints {
221    win getwindowinfo
222} -setup {
223    wm iconify .
224    unset -nocomplain info
225} -body {
226    global windowInfo
227    set title "winMsgbox-2.2 [pid]"
228    set message "\u041f\u043e\u0438\u0441\u043a\u0020\u0441\u0442\u0440\u0430\u043d\u0438\u0446"
229    after 100 [list GetWindowInfo $title 2]
230    set r [tk_messageBox -type ok -title $title -message $message]
231    array set info $windowInfo
232    lappend r $info(childtext)
233} -cleanup {
234    wm deiconify .
235} -result [list ok "\u041f\u043e\u0438\u0441\u043a\u0020\u0441\u0442\u0440\u0430\u043d\u0438\u0446"]
236
237test winMsgbox-2.3 {tk_messageBox message (empty)} -constraints {
238    win getwindowinfo
239} -setup {
240    wm iconify .
241    unset -nocomplain info
242} -body {
243    global windowInfo
244    set title "winMsgbox-2.3 [pid]"
245    after 100 [list GetWindowInfo $title 2]
246    set r [tk_messageBox -type ok -title $title]
247    array set info $windowInfo
248    lappend r $info(childtext)
249} -cleanup {
250    wm deiconify .
251} -result [list ok ""]
252
253test winMsgbox-3.0 {tk_messageBox detail (sourceforge bug #1692927)} -constraints {
254    win getwindowinfo
255} -setup {
256    wm iconify .
257    unset -nocomplain info
258} -body {
259    global windowInfo
260    set title "winMsgbox-3.0 [pid]"
261    after 100 [list GetWindowInfo $title 2]
262    set r [tk_messageBox -type ok -title $title \
263               -message Hello -detail "Pleased to meet you"]
264    array set info $windowInfo
265    lappend r $info(childtext)
266} -cleanup {
267    wm deiconify .
268} -result [list ok "Hello\n\nPleased to meet you"]
269
270test winMsgbox-3.1 {tk_messageBox detail (unicode)} -constraints {
271    win getwindowinfo
272} -setup {
273    wm iconify .
274    unset -nocomplain info
275} -body {
276    global windowInfo
277    set title "winMsgbox-3.1 [pid]"
278    set message "\u041f\u043e\u0438\u0441\u043a"
279    set detail "\u0441\u0442\u0440\u0430\u043d\u0438\u0446"
280    after 100 [list GetWindowInfo $title 2]
281    set r [tk_messageBox -type ok -title $title -message $message -detail $detail]
282    array set info $windowInfo
283    lappend r $info(childtext)
284} -cleanup {
285    wm deiconify .
286} -result [list ok "\u041f\u043e\u0438\u0441\u043a\n\n\u0441\u0442\u0440\u0430\u043d\u0438\u0446"]
287
288# -------------------------------------------------------------------------
289
290if {[testConstraint testwinevent]} {
291    catch {testwinevent debug 0}
292}
293cleanupTests
294return
295
296# Local variables:
297# mode: tcl
298# indent-tabs-mode: nil
299# End: