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