1# This file tests is a Tcl script to test the procedures in the file 2# tkWinWm.c. It is organized in the standard fashion for Tcl tests. 3# 4# This file contains a collection of tests for one or more of the Tcl 5# built-in commands. Sourcing this file into Tcl runs the tests and 6# generates output for errors. No output means no errors were found. 7# 8# Copyright (c) 1996 by Sun Microsystems, Inc. 9# Copyright (c) 1998-1999 by Scriptics Corporation. 10# All rights reserved. 11# 12# RCS: @(#) $Id$ 13 14package require tcltest 2.1 15eval tcltest::configure $argv 16tcltest::loadTestedCommands 17 18# Measure the height of a single menu line 19 20toplevel .t 21frame .t.f -width 100 -height 50 22pack .t.f 23menu .t.m 24.t.m add command -label "thisisreallylong" 25.t configure -menu .t.m 26wm geometry .t -0-0 27update 28set menuheight [winfo y .t] 29.t.m add command -label "thisisreallylong" 30wm geometry .t -0-0 31update 32set menuheight [expr {$menuheight - [winfo y .t]}] 33destroy .t 34 35test winWm-1.1 {TkWmMapWindow} win { 36 toplevel .t 37 wm override .t 1 38 wm geometry .t +0+0 39 update 40 set result [list [winfo rootx .t] [winfo rooty .t]] 41 destroy .t 42 set result 43} {0 0} 44test winWm-1.2 {TkWmMapWindow} win { 45 toplevel .t 46 wm transient .t . 47 update 48 wm iconify . 49 update 50 wm deiconify . 51 update 52 catch {wm iconify .t} msg 53 destroy .t 54 set msg 55} {can't iconify ".t": it is a transient} 56test winWm-1.3 {TkWmMapWindow} win { 57 toplevel .t 58 update 59 toplevel .t2 60 update 61 set result [expr {[winfo x .t] != [winfo x .t2]}] 62 destroy .t .t2 63 set result 64} 1 65test winWm-1.4 {TkWmMapWindow} win { 66 toplevel .t 67 wm geometry .t +10+10 68 update 69 toplevel .t2 70 wm geometry .t2 +40+10 71 update 72 set result [list [winfo x .t] [winfo x .t2]] 73 destroy .t .t2 74 set result 75} {10 40} 76test winWm-1.5 {TkWmMapWindow} win { 77 toplevel .t 78 wm iconify .t 79 update 80 set result [wm state .t] 81 destroy .t 82 set result 83} iconic 84 85test winWm-2.1 {TkpWmSetState} win { 86 toplevel .t 87 wm geometry .t 150x50+10+10 88 update 89 set result [wm state .t] 90 wm iconify .t 91 update 92 lappend result [wm state .t] 93 wm deiconify .t 94 update 95 lappend result [wm state .t] 96 destroy .t 97 set result 98} {normal iconic normal} 99test winWm-2.2 {TkpWmSetState} win { 100 toplevel .t 101 wm geometry .t 150x50+10+10 102 update 103 set result [wm state .t] 104 wm withdraw .t 105 update 106 lappend result [wm state .t] 107 wm iconify .t 108 update 109 lappend result [wm state .t] 110 wm deiconify .t 111 update 112 lappend result [wm state .t] 113 destroy .t 114 set result 115} {normal withdrawn iconic normal} 116test winWm-2.3 {TkpWmSetState} win { 117 toplevel .t 118 wm geometry .t 150x50+10+10 119 update 120 set result [wm state .t] 121 wm state .t withdrawn 122 update 123 lappend result [wm state .t] 124 wm state .t iconic 125 update 126 lappend result [wm state .t] 127 wm state .t normal 128 update 129 lappend result [wm state .t] 130 destroy .t 131 set result 132} {normal withdrawn iconic normal} 133test winWm-2.4 {TkpWmSetState} win { 134 set result {} 135 toplevel .t 136 wm geometry .t 150x50+10+10 137 update 138 lappend result [list [wm state .t] [wm geometry .t]] 139 wm iconify .t 140 update 141 lappend result [list [wm state .t] [wm geometry .t]] 142 wm geometry .t 200x50+10+10 143 update 144 lappend result [list [wm state .t] [wm geometry .t]] 145 wm deiconify .t 146 update 147 lappend result [list [wm state .t] [wm geometry .t]] 148 destroy .t 149 set result 150} {{normal 150x50+10+10} {iconic 150x50+10+10} {iconic 150x50+10+10} {normal 200x50+10+10}} 151 152test winWm-3.1 {ConfigureTopLevel: window geometry propagation} win { 153 toplevel .t 154 wm geometry .t +0+0 155 button .t.b 156 pack .t.b 157 update 158 set x [winfo x .t.b] 159 destroy .t 160 toplevel .t 161 wm geometry .t +0+0 162 button .t.b 163 update 164 pack .t.b 165 update 166 set x [expr {$x == [winfo x .t.b]}] 167 destroy .t 168 set x 169} 1 170 171test winWm-4.1 {ConfigureTopLevel: menu resizing} win { 172 set result {} 173 toplevel .t 174 frame .t.f -width 150 -height 50 -background red 175 pack .t.f 176 wm geometry .t -0-0 177 update 178 set y [winfo y .t] 179 menu .t.m 180 .t.m add command -label foo 181 .t configure -menu .t.m 182 update 183 set result [expr {$y - [winfo y .t]}] 184 destroy .t 185 set result 186} [expr {$menuheight + 1}] 187 188# This test works on 8.0p2 but has not worked on anything since 8.2. 189# It would be very strange to have a windows application increase the size 190# of the clientarea when a menu wraps so I believe this test to be wrong. 191# Original result was {50 50 50} new result may depend on the default menu 192# font 193test winWm-5.1 {UpdateGeometryInfo: menu resizing} win { 194 set result {} 195 toplevel .t 196 frame .t.f -width 150 -height 50 -background red 197 pack .t.f 198 update 199 set result [winfo height .t] 200 menu .t.m 201 .t.m add command -label foo 202 .t configure -menu .t.m 203 update 204 lappend result [winfo height .t] 205 .t.m add command -label "thisisreallylong" 206 .t.m add command -label "thisisreallylong" 207 update 208 lappend result [winfo height .t] 209 destroy .t 210 211 set result 212} {50 50 31} 213test winWm-5.2 {UpdateGeometryInfo: menu resizing} win { 214 set result {} 215 toplevel .t 216 frame .t.f -width 150 -height 50 -background red 217 pack .t.f 218 wm geometry .t -0-0 219 update 220 set y [winfo rooty .t] 221 lappend result [winfo height .t] 222 menu .t.m 223 .t configure -menu .t.m 224 .t.m add command -label foo 225 .t.m add command -label "thisisreallylong" 226 .t.m add command -label "thisisreallylong" 227 update 228 lappend result [winfo height .t] 229 lappend result [expr {$y - [winfo rooty .t]}] 230 destroy .t 231 set result 232} {50 50 0} 233 234test winWm-6.1 {wm attributes} win { 235 destroy .t 236 toplevel .t 237 wm attributes .t 238} {-alpha 1.0 -transparentcolor {} -disabled 0 -fullscreen 0 -toolwindow 0 -topmost 0} 239test winWm-6.2 {wm attributes} win { 240 destroy .t 241 toplevel .t 242 wm attributes .t -disabled 243} {0} 244test winWm-6.3 {wm attributes} win { 245 # This isn't quite the correct error message yet, but it works. 246 destroy .t 247 toplevel .t 248 list [catch {wm attributes .t -foo} msg] $msg 249} {1 {wrong # args: should be "wm attributes window ?-alpha ?double?? ?-transparentcolor ?color?? ?-disabled ?bool?? ?-fullscreen ?bool?? ?-toolwindow ?bool?? ?-topmost ?bool??"}} 250 251test winWm-6.4 {wm attributes -alpha} win { 252 # Expect this to return all 1.0 {} on pre-2K/XP 253 destroy .t 254 toplevel .t 255 set res [wm attributes .t -alpha] 256 # we don't return on set yet 257 lappend res [wm attributes .t -alpha 0.5] 258 lappend res [wm attributes .t -alpha] 259 lappend res [wm attributes .t -alpha -100] 260 lappend res [wm attributes .t -alpha] 261 lappend res [wm attributes .t -alpha 100] 262 lappend res [wm attributes .t -alpha] 263 set res 264} {1.0 {} 0.5 {} 0.0 {} 1.0} 265 266test winWm-6.5 {wm attributes -alpha} win { 267 destroy .t 268 toplevel .t 269 list [catch {wm attributes .t -alpha foo} msg] $msg 270} {1 {expected floating-point number but got "foo"}} 271 272test winWm-6.6 {wm attributes -alpha} win { 273 # This test is just to show off -alpha 274 destroy .t 275 toplevel .t 276 wm attributes .t -alpha 0.2 277 pack [label .t.l -text "Alpha Toplevel" -font "Helvetica 18 bold"] 278 tk::PlaceWindow .t center 279 update 280 if {$::tcl_platform(osVersion) >= 5.0} { 281 for {set i 0.2} {$i < 0.99} {set i [expr {$i+0.02}]} { 282 wm attributes .t -alpha $i 283 update idle 284 after 20 285 } 286 for {set i 0.99} {$i > 0.2} {set i [expr {$i-0.02}]} { 287 wm attributes .t -alpha $i 288 update idle 289 after 20 290 } 291 } 292} {} 293 294test winWm-6.7 {wm attributes -transparentcolor} win { 295 # Expect this to return all "" on pre-2K/XP 296 destroy .t 297 toplevel .t 298 set res {} 299 lappend res [wm attributes .t -transparentcolor] 300 # we don't return on set yet 301 lappend res [wm attributes .t -trans black] 302 lappend res [wm attributes .t -trans] 303 lappend res [wm attributes .t -trans "#FFFFFF"] 304 lappend res [wm attributes .t -trans] 305 destroy .t 306 set res 307} [list {} {} black {} "#FFFFFF"] 308 309test winWm-6.8 {wm attributes -transparentcolor} win { 310 destroy .t 311 toplevel .t 312 list [catch {wm attributes .t -tr foo} msg] $msg 313} {1 {unknown color name "foo"}} 314 315test winWm-7.1 {deiconify on an unmapped toplevel\ 316 will raise the window and set the focus} win { 317 destroy .t 318 toplevel .t 319 lower .t 320 focus -force . 321 wm deiconify .t 322 update 323 list [wm stackorder .t isabove .] [focus] 324} {1 .t} 325 326test winWm-7.2 {deiconify on an already mapped toplevel\ 327 will raise the window and set the focus} win { 328 destroy .t 329 toplevel .t 330 lower .t 331 update 332 focus -force . 333 wm deiconify .t 334 update 335 list [wm stackorder .t isabove .] [focus] 336} {1 .t} 337 338test winWm-7.3 {UpdateWrapper must maintain Z order} win { 339 destroy .t 340 toplevel .t 341 lower .t 342 update 343 set res [wm stackorder .t isbelow .] 344 wm resizable .t 0 0 345 update 346 list $res [wm stackorder .t isbelow .] 347} {1 1} 348 349test winWm-7.4 {UpdateWrapper must maintain focus} win { 350 destroy .t 351 toplevel .t 352 focus -force .t 353 update 354 set res [focus] 355 wm resizable .t 0 0 356 update 357 list $res [focus] 358} {.t .t} 359 360test winWm-8.1 {Tk_WmCmd procedure, "iconphoto" option} win { 361 list [catch {wm iconph .} msg] $msg 362} {1 {wrong # args: should be "wm iconphoto window ?-default? image1 ?image2 ...?"}} 363test winWm-8.2 {Tk_WmCmd procedure, "iconphoto" option} win { 364 destroy .t 365 toplevel .t 366 image create photo blank16 -width 16 -height 16 367 image create photo blank32 -width 32 -height 32 368 # This should just make blank icons for the window 369 wm iconphoto .t blank16 blank32 370 image delete blank16 blank32 371} {} 372 373test winWm-9.0 "Bug #2799589 - delayed activation of destroyed window" -constraints win -setup { 374 proc winwm90click {w} { 375 if {![winfo ismapped $w]} { update } 376 event generate $w <Enter> 377 focus -force $w 378 event generate $w <ButtonPress-1> -x 5 -y 5 379 event generate $w <ButtonRelease-1> -x 5 -y 5 380 } 381 proc winwm90proc3 {} { 382 global winwm90done winwm90check 383 set w .sd 384 toplevel $w 385 pack [button $w.b -text "OK" -command {set winwm90check 1}] 386 bind $w.b <Map> {after idle {winwm90click %W}} 387 update idletasks 388 tkwait visibility $w 389 grab $w 390 tkwait variable winwm90check 391 grab release $w 392 destroy $w 393 after idle {set winwm90done ok} 394 } 395 proc winwm90proc2 {w} { winwm90proc3; destroy $w } 396 proc winwm90proc1 {w} { 397 toplevel $w 398 pack [button $w.b -text "Do dialog" -command [list winwm90proc2 $w]] 399 bind $w.b <Map> {bind %W <Map> {}; after idle {winwm90click %W}} 400 } 401 destroy .t 402 global winwm90done 403 set winwm90done wait 404 toplevel .t 405} -body { 406 pack [button .t.b -text "Show" -command {winwm90proc1 .tx}] 407 bind .t.b <Map> {bind %W <Map> {}; after idle {winwm90click %W}} 408 after 5000 {set winwm90done timeout} 409 vwait winwm90done 410 set winwm90done 411} -cleanup { 412 foreach cmd {proc1 proc2 proc3 click} { 413 rename winwm90$cmd {} 414 } 415 destroy .tx .t .sd 416} -result {ok} 417 418test winWm-9.1 "delayed activation of grabbed destroyed window" -constraints win -setup { 419 proc winwm91click {w} { 420 if {![winfo ismapped $w]} { update } 421 event generate $w <Enter> 422 focus -force $w 423 event generate $w <ButtonPress-1> -x 5 -y 5 424 event generate $w <ButtonRelease-1> -x 5 -y 5 425 } 426 proc winwm91proc3 {} { 427 global winwm91done winwm91check 428 set w .sd 429 toplevel $w 430 pack [button $w.b -text "OK" -command {set winwm91check 1}] 431 bind $w.b <Map> {after idle {winwm91click %W}} 432 update idletasks 433 tkwait visibility $w 434 grab $w 435 tkwait variable winwm91check 436 #skip the release: #grab release $w 437 destroy $w 438 after idle {set winwm91done ok} 439 } 440 proc winwm91proc2 {w} { winwm91proc3; destroy $w } 441 proc winwm91proc1 {w} { 442 toplevel $w 443 pack [button $w.b -text "Do dialog" -command [list winwm91proc2 $w]] 444 bind $w.b <Map> {bind %W <Map> {}; after idle {winwm91click %W}} 445 } 446 destroy .t 447 global winwm91done 448 set winwm91done wait 449 toplevel .t 450} -body { 451 pack [button .t.b -text "Show" -command {winwm91proc1 .tx}] 452 bind .t.b <Map> {bind %W <Map> {}; after idle {winwm91click %W}} 453 after 5000 {set winwm91done timeout} 454 vwait winwm91done 455 set winwm91done 456} -cleanup { 457 foreach cmd {proc1 proc2 proc3 click} { 458 rename winwm91$cmd {} 459 } 460 destroy .tx .t .sd 461} -result {ok} 462 463destroy .t 464 465# cleanup 466cleanupTests 467return 468 469# Local variables: 470# mode: tcl 471# End: 472