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: