1# This file is a Tcl script to test out Tk's interactions with 2# the window manager, including the "wm" command. It is organized 3# in the standard fashion for Tcl tests. 4# 5# Copyright (c) 1992-1994 The Regents of the University of California. 6# Copyright (c) 1994-1997 Sun Microsystems, Inc. 7# Copyright (c) 1998-1999 by Scriptics Corporation. 8# All rights reserved. 9# 10# RCS: @(#) $Id$ 11 12package require tcltest 2.2 13eval tcltest::configure $argv 14tcltest::loadTestedCommands 15 16namespace import -force ::tk::test:loadTkCommand 17 18proc sleep ms { 19 global x 20 after $ms {set x 1} 21 vwait x 22} 23 24# Procedure to set up a collection of top-level windows 25 26proc makeToplevels {} { 27 deleteWindows 28 foreach i {.raise1 .raise2 .raise3} { 29 toplevel $i 30 wm geom $i 150x100+0+0 31 update 32 } 33} 34 35set i 1 36foreach geom {+20+80 +80+20 +0+0} { 37 destroy .t 38 test unixWm-1.$i {initial window position} unix { 39 toplevel .t -width 200 -height 150 40 wm geom .t $geom 41 update 42 wm geom .t 43 } 200x150$geom 44 incr i 45} 46 47# The tests below are tricky because window managers don't all move 48# windows correctly. Try one motion and compute the window manager's 49# error, then factor this error into the actual tests. In other words, 50# this just makes sure that things are consistent between moves. 51 52set i 1 53destroy .t 54toplevel .t -width 100 -height 150 55wm geom .t +200+200 56update 57wm geom .t +150+150 58update 59scan [wm geom .t] %dx%d+%d+%d width height x y 60set xerr [expr 150-$x] 61set yerr [expr 150-$y] 62foreach geom {+20+80 +80+20 +0+0 -0-0 +0-0 -0+0 -10-5 -10+5 +10-5} { 63 test unixWm-2.$i {moving window while mapped} unix { 64 wm geom .t $geom 65 update 66 scan [wm geom .t] %dx%d%1s%d%1s%d width height xsign x ysign y 67 format "%s%d%s%d" $xsign [eval expr $x$xsign$xerr] $ysign \ 68 [eval expr $y$ysign$yerr] 69 } $geom 70 incr i 71} 72 73set i 1 74foreach geom {+20+80 +80+20 +0+0 -0-0 +0-0 -0+0 -10-5 -10+5 +10-5} { 75 test unixWm-3.$i {moving window while iconified} unix { 76 wm iconify .t 77 sleep 200 78 wm geom .t $geom 79 update 80 wm deiconify .t 81 scan [wm geom .t] %dx%d%1s%d%1s%d width height xsign x ysign y 82 format "%s%d%s%d" $xsign [eval expr $x$xsign$xerr] $ysign \ 83 [eval expr $y$ysign$yerr] 84 } $geom 85 incr i 86} 87 88set i 1 89foreach geom {+20+80 +100+40 +0+0} { 90 test unixWm-4.$i {moving window while withdrawn} unix { 91 wm withdraw .t 92 sleep 200 93 wm geom .t $geom 94 update 95 wm deiconify .t 96 wm geom .t 97 } 100x150$geom 98 incr i 99} 100 101test unixWm-5.1 {compounded state changes} {unix nonPortable} { 102 destroy .t 103 toplevel .t -width 200 -height 100 104 wm geometry .t +100+100 105 update 106 wm withdraw .t 107 wm deiconify .t 108 list [winfo ismapped .t] [wm state .t] 109} {1 normal} 110test unixWm-5.2 {compounded state changes} {unix nonPortable} { 111 destroy .t 112 toplevel .t -width 200 -height 100 113 wm geometry .t +100+100 114 update 115 wm withdraw .t 116 wm deiconify .t 117 wm withdraw .t 118 list [winfo ismapped .t] [wm state .t] 119} {0 withdrawn} 120test unixWm-5.3 {compounded state changes} {unix nonPortable} { 121 destroy .t 122 toplevel .t -width 200 -height 100 123 wm geometry .t +100+100 124 update 125 wm iconify .t 126 wm deiconify .t 127 wm iconify .t 128 wm deiconify .t 129 list [winfo ismapped .t] [wm state .t] 130} {1 normal} 131test unixWm-5.4 {compounded state changes} {unix nonPortable} { 132 destroy .t 133 toplevel .t -width 200 -height 100 134 wm geometry .t +100+100 135 update 136 wm iconify .t 137 wm deiconify .t 138 wm iconify .t 139 list [winfo ismapped .t] [wm state .t] 140} {0 iconic} 141test unixWm-5.5 {compounded state changes} {unix nonPortable} { 142 destroy .t 143 toplevel .t -width 200 -height 100 144 wm geometry .t +100+100 145 update 146 wm iconify .t 147 wm withdraw .t 148 list [winfo ismapped .t] [wm state .t] 149} {0 withdrawn} 150test unixWm-5.6 {compounded state changes} {unix nonPortable} { 151 destroy .t 152 toplevel .t -width 200 -height 100 153 wm geometry .t +100+100 154 update 155 wm iconify .t 156 wm withdraw .t 157 wm deiconify .t 158 list [winfo ismapped .t] [wm state .t] 159} {1 normal} 160test unixWm-5.7 {compounded state changes} {unix nonPortable} { 161 destroy .t 162 toplevel .t -width 200 -height 100 163 wm geometry .t +100+100 164 update 165 wm withdraw .t 166 wm iconify .t 167 list [winfo ismapped .t] [wm state .t] 168} {0 iconic} 169 170destroy .t 171toplevel .t -width 200 -height 100 172wm geom .t +10+10 173wm minsize .t 1 1 174update 175test unixWm-6.1 {size changes} unix { 176 .t config -width 180 -height 150 177 update 178 wm geom .t 179} 180x150+10+10 180test unixWm-6.2 {size changes} unix { 181 wm geom .t 250x60 182 .t config -width 170 -height 140 183 update 184 wm geom .t 185} 250x60+10+10 186test unixWm-6.3 {size changes} unix { 187 wm geom .t 250x60 188 .t config -width 170 -height 140 189 wm geom .t {} 190 update 191 wm geom .t 192} 170x140+10+10 193test unixWm-6.4 {size changes} {unix nonPortable userInteraction} { 194 wm minsize .t 1 1 195 update 196 puts stdout "Please resize window \"t\" with the mouse (but don't move it!)," 197 puts -nonewline stdout "then hit return: " 198 flush stdout 199 gets stdin 200 update 201 set width [winfo width .t] 202 set height [winfo height .t] 203 .t config -width 230 -height 110 204 update 205 incr width -[winfo width .t] 206 incr height -[winfo height .t] 207 wm geom .t {} 208 update 209 set w2 [winfo width .t] 210 set h2 [winfo height .t] 211 .t config -width 114 -height 261 212 update 213 list $width $height $w2 $h2 [wm geom .t] 214} {0 0 230 110 114x261+10+10} 215 216# I don't know why the wait below is needed, but without it the test 217# fails under twm. 218sleep 200 219 220test unixWm-6.5 {window initially iconic} {unix nonPortable} { 221 destroy .t 222 toplevel .t -width 100 -height 30 223 wm geometry .t +0+0 224 wm title .t 2 225 wm iconify .t 226 update idletasks 227 wm withdraw .t 228 wm deiconify .t 229 list [winfo ismapped .t] [wm state .t] 230} {1 normal} 231 232destroy .m 233toplevel .m 234wm overrideredirect .m 1 235foreach i {{Test label} Another {Yet another} {Last label}} j {1 2 3} { 236 label .m.$j -text $i 237} 238wm geometry .m +[expr 100 - [winfo vrootx .]]+[expr 200 - [winfo vrooty .]] 239update 240test unixWm-7.1 {override_redirect and Tk_MoveTopLevelWindow} unix { 241 list [winfo ismapped .m] [wm state .m] [winfo x .m] [winfo y .m] 242} {1 normal 100 200} 243wm geometry .m +[expr 150 - [winfo vrootx .]]+[expr 210 - [winfo vrooty .]] 244update 245test unixWm-7.2 {override_redirect and Tk_MoveTopLevelWindow} unix { 246 list [winfo ismapped .m] [wm state .m] [winfo x .m] [winfo y .m] 247} {1 normal 150 210} 248wm withdraw .m 249test unixWm-7.3 {override_redirect and Tk_MoveTopLevelWindow} unix { 250 list [winfo ismapped .m] 251} 0 252destroy .m 253destroy .t 254 255test unixWm-8.1 {icon windows} unix { 256 destroy .t 257 destroy .icon 258 toplevel .t -width 100 -height 30 259 wm geometry .t +0+0 260 toplevel .icon -width 50 -height 50 -bg red 261 wm iconwindow .t .icon 262 list [catch {wm withdraw .icon} msg] $msg 263} {1 {can't withdraw .icon: it is an icon for .t}} 264test unixWm-8.2 {icon windows} unix { 265 destroy .t 266 toplevel .t -width 100 -height 30 267 list [catch {wm iconwindow} msg] $msg 268} {1 {wrong # args: should be "wm option window ?arg ...?"}} 269test unixWm-8.3 {icon windows} unix { 270 destroy .t 271 toplevel .t -width 100 -height 30 272 list [catch {wm iconwindow .t b c} msg] $msg 273} {1 {wrong # args: should be "wm iconwindow window ?pathName?"}} 274test unixWm-8.4 {icon windows} unix { 275 destroy .t 276 destroy .icon 277 toplevel .t -width 100 -height 30 278 wm geom .t +0+0 279 set result [wm iconwindow .t] 280 toplevel .icon -width 50 -height 50 -bg red 281 wm iconwindow .t .icon 282 lappend result [wm iconwindow .t] [wm state .icon] 283 wm iconwindow .t {} 284 lappend result [wm iconwindow .t] [wm state .icon] 285 update 286 lappend result [winfo ismapped .t] [winfo ismapped .icon] 287 wm iconify .t 288 update 289 lappend result [winfo ismapped .t] [winfo ismapped .icon] 290} {.icon icon {} withdrawn 1 0 0 0} 291test unixWm-8.5 {icon windows} unix { 292 destroy .t 293 toplevel .t -width 100 -height 30 294 list [catch {wm iconwindow .t .gorp} msg] $msg 295} {1 {bad window path name ".gorp"}} 296test unixWm-8.6 {icon windows} unix { 297 destroy .t 298 toplevel .t -width 100 -height 30 299 frame .t.icon -width 50 -height 50 -bg red 300 list [catch {wm iconwindow .t .t.icon} msg] $msg 301} {1 {can't use .t.icon as icon window: not at top level}} 302test unixWm-8.7 {icon windows} unix { 303 destroy .t 304 destroy .icon 305 toplevel .t -width 100 -height 30 306 wm geom .t +0+0 307 toplevel .icon -width 50 -height 50 -bg red 308 toplevel .icon2 -width 50 -height 50 -bg green 309 wm iconwindow .t .icon 310 set result "[wm iconwindow .t] [wm state .icon] [wm state .icon2]" 311 wm iconwindow .t .icon2 312 lappend result [wm iconwindow .t] [wm state .icon] [wm state .icon2] 313} {.icon icon normal .icon2 withdrawn icon} 314destroy .icon2 315test unixWm-8.8 {icon windows} unix { 316 destroy .t 317 destroy .icon 318 toplevel .icon -width 50 -height 50 -bg red 319 wm geom .icon +0+0 320 update 321 set result [winfo ismapped .icon] 322 toplevel .t -width 100 -height 30 323 wm geom .t +0+0 324 tkwait visibility .t ;# Needed to keep tvtwm happy. 325 wm iconwindow .t .icon 326 sleep 500 327 lappend result [winfo ismapped .t] [winfo ismapped .icon] 328} {1 1 0} 329test unixWm-8.9 {icon windows} {unix nonPortable} { 330 # This test is non-portable because some window managers will 331 # destroy an icon window when it's associated window is destroyed. 332 333 destroy .t 334 destroy .icon 335 toplevel .t -width 100 -height 30 336 toplevel .icon -width 50 -height 50 -bg red 337 wm geom .t +0+0 338 wm iconwindow .t .icon 339 update 340 set result "[wm state .icon] [winfo ismapped .t] [winfo ismapped .icon]" 341 destroy .t 342 wm geom .icon +0+0 343 update 344 lappend result [winfo ismapped .icon] [wm state .icon] 345 wm deiconify .icon 346 update 347 lappend result [winfo ismapped .icon] [wm state .icon] 348} {icon 1 0 0 withdrawn 1 normal} 349 350test unixWm-8.10.1 {test for memory leaks} unix { 351 wm title .t "This is a long long long long long long title" 352 wm title .t "This is a long long long long long long title" 353 wm title .t "This is a long long long long long long title" 354 wm title .t "This is a long long long long long long title" 355 wm title .t "This is a long long long long long long title" 356 wm title .t "This is a long long long long long long title" 357 wm title .t "This is a long long long long long long title" 358 wm title .t "This is a long long long long long long title" 359 set x 1 360} 1 361test unixWm-8.10.2 {test for memory leaks} unix { 362 wm group .t . 363 wm group .t . 364 wm group .t . 365 wm group .t . 366 wm group .t . 367 wm group .t . 368 wm group .t . 369 wm group .t . 370 wm group .t . 371 wm group .t . 372 set x 1 373} 1 374 375test unixWm-9.1 {TkWmMapWindow procedure, client property} {unix testwrapper} { 376 destroy .t 377 toplevel .t -width 100 -height 50 378 wm geom .t +0+0 379 wm client .t Test_String 380 update 381 testprop [testwrapper .t] WM_CLIENT_MACHINE 382} {Test_String} 383test unixWm-9.2 {TkWmMapWindow procedure, command property} {unix testwrapper} { 384 destroy .t 385 toplevel .t -width 100 -height 50 386 wm geom .t +0+0 387 wm command .t "test command" 388 update 389 testprop [testwrapper .t] WM_COMMAND 390} {test 391command 392} 393test unixWm-9.3 {TkWmMapWindow procedure, iconic windows} unix { 394 destroy .t 395 toplevel .t -width 100 -height 300 -bg blue 396 wm geom .t +0+0 397 wm iconify .t 398 sleep 500 399 winfo ismapped .t 400} {0} 401test unixWm-9.4 {TkWmMapWindow procedure, icon windows} unix { 402 destroy .t 403 sleep 500 404 toplevel .t -width 100 -height 50 -bg blue 405 wm iconwindow . .t 406 update 407 set result [winfo ismapped .t] 408} {0} 409test unixWm-9.5 {TkWmMapWindow procedure, normal windows} unix { 410 destroy .t 411 toplevel .t -width 200 -height 20 412 wm geom .t +0+0 413 update 414 winfo ismapped .t 415} {1} 416 417test unixWm-10.1 {TkWmDeadWindow procedure, canceling UpdateGeometry idle handler} unix { 418 destroy .t 419 toplevel .t -width 100 -height 50 420 wm geom .t +0+0 421 update 422 .t configure -width 200 -height 100 423 destroy .t 424} {} 425test unixWm-10.2 {TkWmDeadWindow procedure, destroying menubar} {unix testmenubar} { 426 destroy .t 427 destroy .f 428 toplevel .t -width 300 -height 200 -bd 2 -relief raised 429 wm geom .t +0+0 430 update 431 frame .f -width 400 -height 30 -bd 2 -relief raised -bg green 432 bind .f <Destroy> {lappend result destroyed} 433 testmenubar window .t .f 434 update 435 set result {} 436 destroy .t 437 lappend result [winfo exists .f] 438} {destroyed 0} 439 440test unixWm-11.1 {Tk_WmCmd procedure, miscellaneous errors} unix { 441 list [catch {wm} msg] $msg 442} {1 {wrong # args: should be "wm option window ?arg ...?"}} 443test unixWm-11.2 {Tk_WmCmd procedure, miscellaneous errors} unix { 444 list [catch {wm aspect} msg] $msg 445} {1 {wrong # args: should be "wm option window ?arg ...?"}} 446test unixWm-11.3 {Tk_WmCmd procedure, miscellaneous errors} unix { 447 list [catch {wm iconify bogus} msg] $msg 448} {1 {bad window path name "bogus"}} 449test unixWm-11.4 {Tk_WmCmd procedure, miscellaneous errors} unix { 450 destroy .b 451 button .b -text hello 452 list [catch {wm geometry .b} msg] $msg 453} {1 {window ".b" isn't a top-level window}} 454 455destroy .t 456destroy .icon 457 458toplevel .t -width 100 -height 50 459wm geom .t +0+0 460update 461 462test unixWm-12.1 {Tk_WmCmd procedure, "aspect" option} unix { 463 list [catch {wm aspect .t 12} msg] $msg 464} {1 {wrong # args: should be "wm aspect window ?minNumer minDenom maxNumer maxDenom?"}} 465test unixWm-12.2 {Tk_WmCmd procedure, "aspect" option} unix { 466 list [catch {wm aspect .t 12 13 14 15 16} msg] $msg 467} {1 {wrong # args: should be "wm aspect window ?minNumer minDenom maxNumer maxDenom?"}} 468test unixWm-12.3 {Tk_WmCmd procedure, "aspect" option} unix { 469 set result {} 470 lappend result [wm aspect .t] 471 wm aspect .t 3 4 10 2 472 lappend result [wm aspect .t] 473 wm aspect .t {} {} {} {} 474 lappend result [wm aspect .t] 475} {{} {3 4 10 2} {}} 476test unixWm-12.4 {Tk_WmCmd procedure, "aspect" option} unix { 477 list [catch {wm aspect .t bad 14 15 16} msg] $msg 478} {1 {expected integer but got "bad"}} 479test unixWm-12.5 {Tk_WmCmd procedure, "aspect" option} unix { 480 list [catch {wm aspect .t 13 foo 15 16} msg] $msg 481} {1 {expected integer but got "foo"}} 482test unixWm-12.6 {Tk_WmCmd procedure, "aspect" option} unix { 483 list [catch {wm aspect .t 13 14 bar 16} msg] $msg 484} {1 {expected integer but got "bar"}} 485test unixWm-12.7 {Tk_WmCmd procedure, "aspect" option} unix { 486 list [catch {wm aspect .t 13 14 15 baz} msg] $msg 487} {1 {expected integer but got "baz"}} 488test unixWm-12.8 {Tk_WmCmd procedure, "aspect" option} unix { 489 list [catch {wm aspect .t 0 14 15 16} msg] $msg 490} {1 {aspect number can't be <= 0}} 491test unixWm-12.9 {Tk_WmCmd procedure, "aspect" option} unix { 492 list [catch {wm aspect .t 13 0 15 16} msg] $msg 493} {1 {aspect number can't be <= 0}} 494test unixWm-12.10 {Tk_WmCmd procedure, "aspect" option} unix { 495 list [catch {wm aspect .t 13 14 0 16} msg] $msg 496} {1 {aspect number can't be <= 0}} 497test unixWm-12.11 {Tk_WmCmd procedure, "aspect" option} unix { 498 list [catch {wm aspect .t 13 14 15 0} msg] $msg 499} {1 {aspect number can't be <= 0}} 500 501test unixWm-13.1 {Tk_WmCmd procedure, "client" option} unix { 502 list [catch {wm client .t x y} msg] $msg 503} {1 {wrong # args: should be "wm client window ?name?"}} 504test unixWm-13.2 {Tk_WmCmd procedure, "client" option} {unix testwrapper} { 505 set result {} 506 lappend result [wm client .t] 507 wm client .t Test_String 508 lappend result [testprop [testwrapper .t] WM_CLIENT_MACHINE] 509 wm client .t New 510 lappend result [wm client .t] 511 wm client .t {} 512 lappend result [wm client .t] [testprop [testwrapper .t] WM_CLIENT_MACHINE] 513} {{} Test_String New {} {}} 514test unixWm-13.3 {Tk_WmCmd procedure, "client" option, unmapped window} unix { 515 destroy .t2 516 toplevel .t2 517 wm client .t2 Test_String 518 wm client .t2 {} 519 wm client .t2 Test_String 520 destroy .t2 521} {} 522 523test unixWm-14.1 {Tk_WmCmd procedure, "colormapwindows" option} unix { 524 list [catch {wm colormapwindows .t 12 13} msg] $msg 525} {1 {wrong # args: should be "wm colormapwindows window ?windowList?"}} 526test unixWm-14.2 {Tk_WmCmd procedure, "colormapwindows" option} unix { 527 destroy .t2 528 toplevel .t2 -width 200 -height 200 -colormap new 529 wm geom .t2 +0+0 530 frame .t2.a -width 100 -height 30 531 frame .t2.b -width 100 -height 30 -colormap new 532 pack .t2.a .t2.b -side top 533 update 534 set x [wm colormapwindows .t2] 535 frame .t2.c -width 100 -height 30 -colormap new 536 pack .t2.c -side top 537 update 538 list $x [wm colormapwindows .t2] 539} {{.t2.b .t2} {.t2.b .t2.c .t2}} 540test unixWm-14.3 {Tk_WmCmd procedure, "colormapwindows" option} unix { 541 list [catch {wm col . "a \{"} msg] $msg 542} {1 {unmatched open brace in list}} 543test unixWm-14.4 {Tk_WmCmd procedure, "colormapwindows" option} unix { 544 list [catch {wm colormapwindows . foo} msg] $msg 545} {1 {bad window path name "foo"}} 546test unixWm-14.5 {Tk_WmCmd procedure, "colormapwindows" option} unix { 547 destroy .t2 548 toplevel .t2 -width 200 -height 200 -colormap new 549 wm geom .t2 +0+0 550 frame .t2.a -width 100 -height 30 551 frame .t2.b -width 100 -height 30 552 frame .t2.c -width 100 -height 30 553 pack .t2.a .t2.b .t2.c -side top 554 wm colormapwindows .t2 {.t2.c .t2 .t2.a} 555 wm colormapwindows .t2 556} {.t2.c .t2 .t2.a} 557test unixWm-14.6 {Tk_WmCmd procedure, "colormapwindows" option} unix { 558 destroy .t2 559 toplevel .t2 -width 200 -height 200 560 wm geom .t2 +0+0 561 frame .t2.a -width 100 -height 30 562 frame .t2.b -width 100 -height 30 563 frame .t2.c -width 100 -height 30 564 pack .t2.a .t2.b .t2.c -side top 565 wm colormapwindows .t2 {.t2.b .t2.a} 566 wm colormapwindows .t2 567} {.t2.b .t2.a} 568test unixWm-14.7 {Tk_WmCmd procedure, "colormapwindows" option} unix { 569 destroy .t2 570 toplevel .t2 -width 200 -height 200 -colormap new 571 wm geom .t2 +0+0 572 set x [wm colormapwindows .t2] 573 wm colormapwindows .t2 {} 574 list $x [wm colormapwindows .t2] 575} {{} {}} 576destroy .t2 577 578test unixWm-15.1 {Tk_WmCmd procedure, "command" option} unix { 579 list [catch {wm command .t 12 13} msg] $msg 580} {1 {wrong # args: should be "wm command window ?value?"}} 581test unixWm-15.2 {Tk_WmCmd procedure, "command" option} unix { 582 list [catch {wm command .t 12 13} msg] $msg 583} {1 {wrong # args: should be "wm command window ?value?"}} 584test unixWm-15.3 {Tk_WmCmd procedure, "command" option} {unix testwrapper} { 585 set result {} 586 lappend result [wm command .t] 587 wm command .t "test command" 588 lappend result [testprop [testwrapper .t] WM_COMMAND] 589 wm command .t "new command" 590 lappend result [wm command .t] 591 wm command .t {} 592 lappend result [wm command .t] [testprop [testwrapper .t] WM_COMMAND] 593} {{} {test 594command 595} {new command} {} {}} 596test unixWm-15.4 {Tk_WmCmd procedure, "command" option, window not mapped} unix { 597 destroy .t2 598 toplevel .t2 599 wm geom .t2 +0+0 600 wm command .t2 "test command" 601 wm command .t2 "new command" 602 wm command .t2 {} 603 destroy .t2 604} {} 605test unixWm-15.5 {Tk_WmCmd procedure, "command" option} unix { 606 list [catch {wm command .t "a \{b"} msg] $msg 607} {1 {unmatched open brace in list}} 608 609test unixWm-16.1 {Tk_WmCmd procedure, "deiconify" option} unix { 610 list [catch {wm deiconify .t 12} msg] $msg 611} {1 {wrong # args: should be "wm deiconify window"}} 612test unixWm-16.2 {Tk_WmCmd procedure, "deiconify" option} unix { 613 destroy .icon 614 toplevel .icon -width 50 -height 50 -bg red 615 wm iconwindow .t .icon 616 set result [list [catch {wm deiconify .icon} msg] $msg] 617 destroy .icon 618 set result 619} {1 {can't deiconify .icon: it is an icon for .t}} 620test unixWm-16.3 {Tk_WmCmd procedure, "deiconify" option} unix { 621 wm iconify .t 622 set result {} 623 lappend result [winfo ismapped .t] [wm state .t] 624 wm deiconify .t 625 lappend result [winfo ismapped .t] [wm state .t] 626} {0 iconic 1 normal} 627 628test unixWm-17.1 {Tk_WmCmd procedure, "focusmodel" option} unix { 629 list [catch {wm focusmodel .t 12 13} msg] $msg 630} {1 {wrong # args: should be "wm focusmodel window ?active|passive?"}} 631test unixWm-17.2 {Tk_WmCmd procedure, "focusmodel" option} unix { 632 list [catch {wm focusmodel .t bogus} msg] $msg 633} {1 {bad argument "bogus": must be active or passive}} 634test unixWm-17.3 {Tk_WmCmd procedure, "focusmodel" option} unix { 635 set result {} 636 lappend result [wm focusmodel .t] 637 wm focusmodel .t active 638 lappend result [wm focusmodel .t] 639 wm focusmodel .t passive 640 lappend result [wm focusmodel .t] 641 set result 642} {passive active passive} 643 644test unixWm-18.1 {Tk_WmCmd procedure, "frame" option} unix { 645 list [catch {wm frame .t 12} msg] $msg 646} {1 {wrong # args: should be "wm frame window"}} 647test unixWm-18.2 {Tk_WmCmd procedure, "frame" option} {unix nonPortable} { 648 expr [wm frame .t] == [winfo id .t] 649} {0} 650test unixWm-18.3 {Tk_WmCmd procedure, "frame" option} {unix nonPortable} { 651 destroy .t2 652 toplevel .t2 653 wm geom .t2 +0+0 654 wm overrideredirect .t2 1 655 update 656 set result [expr [wm frame .t2] == [winfo id .t2]] 657 destroy .t2 658 set result 659} {1} 660 661test unixWm-19.1 {Tk_WmCmd procedure, "geometry" option} unix { 662 list [catch {wm geometry .t 12 13} msg] $msg 663} {1 {wrong # args: should be "wm geometry window ?newGeometry?"}} 664test unixWm-19.2 {Tk_WmCmd procedure, "geometry" option} {unix nonPortable} { 665 wm geometry .t -1+5 666 update 667 wm geometry .t 668} {100x50-1+5} 669test unixWm-19.3 {Tk_WmCmd procedure, "geometry" option} {unix nonPortable} { 670 wm geometry .t +10-4 671 update 672 wm geometry .t 673} {100x50+10-4} 674test unixWm-19.4 {Tk_WmCmd procedure, "geometry" option} {unix nonPortable} { 675 destroy .t2 676 toplevel .t2 677 wm geom .t2 -5+10 678 listbox .t2.l -width 30 -height 12 -setgrid 1 679 pack .t2.l 680 update 681 set result [wm geometry .t2] 682 destroy .t2 683 set result 684} {30x12-5+10} 685test unixWm-19.5 {Tk_WmCmd procedure, "geometry" option} {unix nonPortable} { 686 wm geometry .t 150x300+5+6 687 update 688 set result {} 689 lappend result [wm geometry .t] 690 wm geometry .t {} 691 update 692 lappend result [wm geometry .t] 693} {150x300+5+6 100x50+5+6} 694test unixWm-19.6 {Tk_WmCmd procedure, "geometry" option} unix { 695 list [catch {wm geometry .t qrs} msg] $msg 696} {1 {bad geometry specifier "qrs"}} 697 698test unixWm-20.1 {Tk_WmCmd procedure, "grid" option} unix { 699 list [catch {wm grid .t 12 13} msg] $msg 700} {1 {wrong # args: should be "wm grid window ?baseWidth baseHeight widthInc heightInc?"}} 701test unixWm-20.2 {Tk_WmCmd procedure, "grid" option} unix { 702 list [catch {wm grid .t 12 13 14 15 16} msg] $msg 703} {1 {wrong # args: should be "wm grid window ?baseWidth baseHeight widthInc heightInc?"}} 704test unixWm-20.3 {Tk_WmCmd procedure, "grid" option} unix { 705 set result {} 706 lappend result [wm grid .t] 707 wm grid .t 5 6 20 10 708 lappend result [wm grid .t] 709 wm grid .t {} {} {} {} 710 lappend result [wm grid .t] 711} {{} {5 6 20 10} {}} 712test unixWm-20.4 {Tk_WmCmd procedure, "grid" option} unix { 713 list [catch {wm grid .t bad 10 11 12} msg] $msg 714} {1 {expected integer but got "bad"}} 715test unixWm-20.5 {Tk_WmCmd procedure, "grid" option} unix { 716 list [catch {wm grid .t -1 11 12 13} msg] $msg 717} {1 {baseWidth can't be < 0}} 718test unixWm-20.6 {Tk_WmCmd procedure, "grid" option} unix { 719 list [catch {wm grid .t 10 foo 12 13} msg] $msg 720} {1 {expected integer but got "foo"}} 721test unixWm-20.7 {Tk_WmCmd procedure, "grid" option} unix { 722 list [catch {wm grid .t 10 -11 12 13} msg] $msg 723} {1 {baseHeight can't be < 0}} 724test unixWm-20.8 {Tk_WmCmd procedure, "grid" option} unix { 725 list [catch {wm grid .t 10 11 bar 13} msg] $msg 726} {1 {expected integer but got "bar"}} 727test unixWm-20.9 {Tk_WmCmd procedure, "grid" option} unix { 728 list [catch {wm grid .t 10 11 -2 13} msg] $msg 729} {1 {widthInc can't be <= 0}} 730test unixWm-20.10 {Tk_WmCmd procedure, "grid" option} unix { 731 list [catch {wm grid .t 10 11 12 bogus} msg] $msg 732} {1 {expected integer but got "bogus"}} 733test unixWm-20.11 {Tk_WmCmd procedure, "grid" option} unix { 734 list [catch {wm grid .t 10 11 12 -1} msg] $msg 735} {1 {heightInc can't be <= 0}} 736 737destroy .t 738destroy .icon 739toplevel .t -width 100 -height 50 740wm geom .t +0+0 741update 742 743test unixWm-21.1 {Tk_WmCmd procedure, "group" option} unix { 744 list [catch {wm group .t 12 13} msg] $msg 745} {1 {wrong # args: should be "wm group window ?pathName?"}} 746test unixWm-21.2 {Tk_WmCmd procedure, "group" option} unix { 747 list [catch {wm group .t bogus} msg] $msg 748} {1 {bad window path name "bogus"}} 749test unixWm-21.3 {Tk_WmCmd procedure, "group" option} {unix testwrapper} { 750 set result {} 751 lappend result [wm group .t] 752 wm group .t . 753 set bit [format 0x%x [expr 0x40 & [lindex [testprop [testwrapper .t] \ 754 WM_HINTS] 0]]] 755 lappend result [wm group .t] $bit 756 wm group .t {} 757 set bit [format 0x%x [expr 0x40 & [lindex [testprop [testwrapper .t] \ 758 WM_HINTS] 0]]] 759 lappend result [wm group .t] $bit 760} {{} . 0x40 {} 0x0} 761test unixWm-21.4 {Tk_WmCmd procedure, "group" option, make window exist} {unix testwrapper} { 762 destroy .t2 763 toplevel .t2 764 wm geom .t2 +0+0 765 wm group .t .t2 766 set hints [testprop [testwrapper .t] WM_HINTS] 767 set result [expr [testwrapper .t2] - [lindex $hints 8]] 768 destroy .t2 769 set result 770} {0} 771test unixWm-21.5 {Tk_WmCmd procedure, "group" option, create leader wrapper} {unix testwrapper} { 772 destroy .t2 773 destroy .t3 774 toplevel .t2 -width 120 -height 300 775 wm geometry .t2 +0+0 776 toplevel .t3 -width 120 -height 300 777 wm geometry .t2 +0+0 778 set result [list [testwrapper .t2]] 779 wm group .t3 .t2 780 lappend result [expr {[testwrapper .t2] == ""}] 781 destroy .t2 .t3 782 set result 783} {{} 0} 784 785test unixWm-22.1 {Tk_WmCmd procedure, "iconbitmap" option} unix { 786 list [catch {wm iconbitmap .t 12 13} msg] $msg 787} {1 {wrong # args: should be "wm iconbitmap window ?bitmap?"}} 788test unixWm-22.2 {Tk_WmCmd procedure, "iconbitmap" option} {unix testwrapper} { 789 set result {} 790 lappend result [wm iconbitmap .t] 791 wm iconbitmap .t questhead 792 set bit [format 0x%x [expr 0x4 & [lindex [testprop [testwrapper .t] \ 793 WM_HINTS] 0]]] 794 lappend result [wm iconbitmap .t] $bit 795 wm iconbitmap .t {} 796 set bit [format 0x%x [expr 0x4 & [lindex [testprop [testwrapper .t] \ 797 WM_HINTS] 0]]] 798 lappend result [wm iconbitmap .t] $bit 799} {{} questhead 0x4 {} 0x0} 800test unixWm-22.3 {Tk_WmCmd procedure, "iconbitmap" option} unix { 801 list [catch {wm iconbitmap .t bad-bitmap} msg] $msg 802} {1 {bitmap "bad-bitmap" not defined}} 803 804test unixWm-23.1 {Tk_WmCmd procedure, "iconify" option} unix { 805 list [catch {wm iconify .t 12} msg] $msg 806} {1 {wrong # args: should be "wm iconify window"}} 807test unixWm-23.2 {Tk_WmCmd procedure, "iconify" option} unix { 808 destroy .t2 809 toplevel .t2 810 wm overrideredirect .t2 1 811 set result [list [catch {wm iconify .t2} msg] $msg] 812 destroy .t2 813 set result 814} {1 {can't iconify ".t2": override-redirect flag is set}} 815test unixWm-23.3 {Tk_WmCmd procedure, "iconify" option} unix { 816 destroy .t2 817 toplevel .t2 818 wm geom .t2 +0+0 819 wm transient .t2 .t 820 set result [list [catch {wm iconify .t2} msg] $msg] 821 destroy .t2 822 set result 823} {1 {can't iconify ".t2": it is a transient}} 824test unixWm-23.4 {Tk_WmCmd procedure, "iconify" option} unix { 825 destroy .t2 826 toplevel .t2 827 wm geom .t2 +0+0 828 wm iconwindow .t .t2 829 set result [list [catch {wm iconify .t2} msg] $msg] 830 destroy .t2 831 set result 832} {1 {can't iconify .t2: it is an icon for .t}} 833test unixWm-23.5 {Tk_WmCmd procedure, "iconify" option} unix { 834 destroy .t2 835 toplevel .t2 836 wm geom .t2 +0+0 837 update 838 wm iconify .t2 839 update 840 set result [winfo ismapped .t2] 841 destroy .t2 842 set result 843} {0} 844test unixWm-23.6 {Tk_WmCmd procedure, "iconify" option} unix { 845 destroy .t2 846 toplevel .t2 847 wm geom .t2 -0+0 848 update 849 set result [winfo ismapped .t2] 850 wm iconify .t2 851 update 852 lappend result [winfo ismapped .t2] 853 destroy .t2 854 set result 855} {1 0} 856 857test unixWm-24.1 {Tk_WmCmd procedure, "iconmask" option} unix { 858 list [catch {wm iconmask .t 12 13} msg] $msg 859} {1 {wrong # args: should be "wm iconmask window ?bitmap?"}} 860test unixWm-24.2 {Tk_WmCmd procedure, "iconmask" option} {unix testwrapper} { 861 set result {} 862 lappend result [wm iconmask .t] 863 wm iconmask .t questhead 864 set bit [format 0x%x [expr 0x20 & [lindex [testprop [testwrapper .t] \ 865 WM_HINTS] 0]]] 866 lappend result [wm iconmask .t] $bit 867 wm iconmask .t {} 868 set bit [format 0x%x [expr 0x20 & [lindex [testprop [testwrapper .t] \ 869 WM_HINTS] 0]]] 870 lappend result [wm iconmask .t] $bit 871} {{} questhead 0x20 {} 0x0} 872test unixWm-24.3 {Tk_WmCmd procedure, "iconmask" option} unix { 873 list [catch {wm iconmask .t bogus} msg] $msg 874} {1 {bitmap "bogus" not defined}} 875 876test unixWm-25.1 {Tk_WmCmd procedure, "iconname" option} unix { 877 list [catch {wm icon .t} msg] $msg 878} {1 {ambiguous option "icon": must be aspect, attributes, client, colormapwindows, command, deiconify, focusmodel, forget, frame, geometry, grid, group, iconbitmap, iconify, iconmask, iconname, iconphoto, iconposition, iconwindow, manage, maxsize, minsize, overrideredirect, positionfrom, protocol, resizable, sizefrom, stackorder, state, title, transient, or withdraw}} 879test unixWm-25.2 {Tk_WmCmd procedure, "iconname" option} unix { 880 list [catch {wm iconname .t 12 13} msg] $msg 881} {1 {wrong # args: should be "wm iconname window ?newName?"}} 882test unixWm-25.3 {Tk_WmCmd procedure, "iconname" option} {unix testwrapper} { 883 set result {} 884 lappend result [wm iconname .t] 885 wm iconname .t test_name 886 lappend result [wm iconname .t] [testprop [testwrapper .t] WM_ICON_NAME] 887 wm iconname .t {} 888 lappend result [wm iconname .t] [testprop [testwrapper .t] WM_ICON_NAME] 889} {{} test_name test_name {} {}} 890 891test unixWm-26.1 {Tk_WmCmd procedure, "iconposition" option} unix { 892 list [catch {wm iconposition .t 12} msg] $msg 893} {1 {wrong # args: should be "wm iconposition window ?x y?"}} 894test unixWm-26.2 {Tk_WmCmd procedure, "iconposition" option} unix { 895 list [catch {wm iconposition .t 12 13 14} msg] $msg 896} {1 {wrong # args: should be "wm iconposition window ?x y?"}} 897test unixWm-26.3 {Tk_WmCmd procedure, "iconposition" option} {unix testwrapper} { 898 set result {} 899 lappend result [wm iconposition .t] 900 wm iconposition .t 10 15 901 set prop [testprop [testwrapper .t] WM_HINTS] 902 lappend result [wm iconposition .t] [lindex $prop 5] [lindex $prop 6] 903 lappend result [format 0x%x [expr 0x10 & [lindex $prop 0]]] 904 wm iconposition .t {} {} 905 set bit [format 0x%x [expr 0x10 & [lindex [testprop [testwrapper .t] \ 906 WM_HINTS] 0]]] 907 lappend result [wm iconposition .t] $bit 908} {{} {10 15} 0xa 0xf 0x10 {} 0x0} 909test unixWm-26.4 {Tk_WmCmd procedure, "iconposition" option} unix { 910 list [catch {wm iconposition .t bad 13} msg] $msg 911} {1 {expected integer but got "bad"}} 912test unixWm-26.5 {Tk_WmCmd procedure, "iconposition" option} unix { 913 list [catch {wm iconposition .t 13 lousy} msg] $msg 914} {1 {expected integer but got "lousy"}} 915 916test unixWm-27.1 {Tk_WmCmd procedure, "iconwindow" option} unix { 917 list [catch {wm iconwindow .t 12 13} msg] $msg 918} {1 {wrong # args: should be "wm iconwindow window ?pathName?"}} 919test unixWm-27.2 {Tk_WmCmd procedure, "iconwindow" option} {unix testwrapper} { 920 destroy .icon 921 toplevel .icon -width 50 -height 50 -bg green 922 set result {} 923 lappend result [wm iconwindow .t] 924 wm iconwindow .t .icon 925 set prop [testprop [testwrapper .t] WM_HINTS] 926 lappend result [wm iconwindow .t] [wm state .icon] 927 lappend result [format 0x%x [expr 0x8 & [lindex $prop 0]]] 928 lappend result [expr [testwrapper .icon] == [lindex $prop 4]] 929 wm iconwindow .t {} 930 set bit [format 0x%x [expr 0x8 & [lindex [testprop [testwrapper .t] \ 931 WM_HINTS] 0]]] 932 lappend result [wm iconwindow .t] [wm state .icon] $bit 933 destroy .icon 934 set result 935} {{} .icon icon 0x8 1 {} withdrawn 0x0} 936test unixWm-27.3 {Tk_WmCmd procedure, "iconwindow" option} unix { 937 list [catch {wm iconwindow .t bogus} msg] $msg 938} {1 {bad window path name "bogus"}} 939test unixWm-27.4 {Tk_WmCmd procedure, "iconwindow" option} unix { 940 destroy .b 941 button .b -text Help 942 set result [list [catch {wm iconwindow .t .b} msg] $msg] 943 destroy .b 944 set result 945} {1 {can't use .b as icon window: not at top level}} 946test unixWm-27.5 {Tk_WmCmd procedure, "iconwindow" option} unix { 947 destroy .icon 948 toplevel .icon -width 50 -height 50 -bg green 949 destroy .t2 950 toplevel .t2 951 wm geom .t2 -0+0 952 wm iconwindow .t2 .icon 953 set result [list [catch {wm iconwindow .t .icon} msg] $msg] 954 destroy .t2 955 destroy .icon 956 set result 957} {1 {.icon is already an icon for .t2}} 958test unixWm-27.6 {Tk_WmCmd procedure, "iconwindow" option, changing icons} unix { 959 destroy .icon 960 destroy .icon2 961 toplevel .icon -width 50 -height 50 -bg green 962 toplevel .icon2 -width 50 -height 50 -bg red 963 set result {} 964 wm iconwindow .t .icon 965 lappend result [wm state .icon] [wm state .icon2] 966 wm iconwindow .t .icon2 967 lappend result [wm state .icon] [wm state .icon2] 968 destroy .icon .icon2 969 set result 970} {icon normal withdrawn icon} 971test unixWm-27.7 {Tk_WmCmd procedure, "iconwindow" option, withdrawing icon} unix { 972 destroy .icon 973 toplevel .icon -width 50 -height 50 -bg green 974 wm geometry .icon +0+0 975 update 976 set result {} 977 lappend result [wm state .icon] [winfo viewable .icon] 978 wm iconwindow .t .icon 979 lappend result [wm state .icon] [winfo viewable .icon] 980 destroy .icon 981 set result 982} {normal 1 icon 0} 983 984destroy .t 985destroy .icon 986toplevel .t -width 100 -height 50 987wm geom .t +0+0 988update 989 990test unixWm-28.1 {Tk_WmCmd procedure, "maxsize" option, setting the 991 maxsize should update WM_NORMAL_HINTS} {testwrapper} { 992 destroy .t 993 toplevel .t 994 wm maxsize .t 300 300 995 update 996 set hints [testprop [testwrapper .t] WM_NORMAL_HINTS] 997 format {%d %d} [lindex $hints 7] [lindex $hints 8] 998} {300 300} 999 1000test unixWm-28.2 {Tk_WmCmd procedure, "maxsize" option, setting the 1001 maxsize to a value smaller than the current size should 1002 set the maxsize in WM_NORMAL_HINTS} {testwrapper} { 1003 destroy .t 1004 toplevel .t 1005 wm geom .t 400x400 1006 wm maxsize .t 300 300 1007 update 1008 set hints [testprop [testwrapper .t] WM_NORMAL_HINTS] 1009 format {%d %d} [lindex $hints 7] [lindex $hints 8] 1010} {300 300} 1011 1012test unixWm-28.3 {Tk_WmCmd procedure, "maxsize" option, setting the 1013 maxsize to a value smaller than the current size should 1014 set the maxsize in WM_NORMAL_HINTS even if the 1015 interactive resizable flag is set to 0} {testwrapper} { 1016 destroy .t 1017 toplevel .t 1018 wm geom .t 400x400 1019 wm resizable .t 0 0 1020 wm maxsize .t 300 300 1021 update 1022 set hints [testprop [testwrapper .t] WM_NORMAL_HINTS] 1023 format {%d %d} [lindex $hints 7] [lindex $hints 8] 1024} {300 300} 1025 1026test unixWm-29.1 {Tk_WmCmd procedure, "minsize" option, setting the 1027 minsize should update WM_NORMAL_HINTS} {testwrapper} { 1028 destroy .t 1029 toplevel .t 1030 wm minsize .t 300 300 1031 update 1032 set hints [testprop [testwrapper .t] WM_NORMAL_HINTS] 1033 format {%d %d} [lindex $hints 5] [lindex $hints 6] 1034} {300 300} 1035 1036test unixWm-29.2 {Tk_WmCmd procedure, "minsize" option, setting the 1037 minsize to a value larger than the current size should 1038 set the maxsize in WM_NORMAL_HINTS} {testwrapper} { 1039 destroy .t 1040 toplevel .t 1041 wm geom .t 200x200 1042 wm minsize .t 300 300 1043 update 1044 set hints [testprop [testwrapper .t] WM_NORMAL_HINTS] 1045 format {%d %d} [lindex $hints 5] [lindex $hints 6] 1046} {300 300} 1047 1048test unixWm-29.3 {Tk_WmCmd procedure, "minsize" option, setting the 1049 minsize to a value larger than the current size should 1050 set the minsize in WM_NORMAL_HINTS even if the 1051 interactive resizable flag is set to 0} {testwrapper} { 1052 destroy .t 1053 toplevel .t 1054 wm geom .t 200x200 1055 wm resizable .t 0 0 1056 wm minsize .t 300 300 1057 update 1058 set hints [testprop [testwrapper .t] WM_NORMAL_HINTS] 1059 format {%d %d} [lindex $hints 5] [lindex $hints 6] 1060} {300 300} 1061 1062destroy .t .icon 1063toplevel .t -width 100 -height 50 1064wm geom .t +0+0 1065update 1066 1067test unixWm-30.1 {Tk_WmCmd procedure, "overrideredirect" option} unix { 1068 list [catch {wm overrideredirect .t 1 2} msg] $msg 1069} {1 {wrong # args: should be "wm overrideredirect window ?boolean?"}} 1070test unixWm-30.2 {Tk_WmCmd procedure, "overrideredirect" option} unix { 1071 list [catch {wm overrideredirect .t boo} msg] $msg 1072} {1 {expected boolean value but got "boo"}} 1073test unixWm-30.3 {Tk_WmCmd procedure, "overrideredirect" option} unix { 1074 set result {} 1075 lappend result [wm overrideredirect .t] 1076 wm overrideredirect .t true 1077 lappend result [wm overrideredirect .t] 1078 wm overrideredirect .t off 1079 lappend result [wm overrideredirect .t] 1080} {0 1 0} 1081 1082test unixWm-31.1 {Tk_WmCmd procedure, "positionfrom" option} unix { 1083 list [catch {wm positionfrom .t 1 2} msg] $msg 1084} {1 {wrong # args: should be "wm positionfrom window ?user/program?"}} 1085test unixWm-31.2 {Tk_WmCmd procedure, "positionfrom" option} {unix testwrapper} { 1086 set result {} 1087 lappend result [wm positionfrom .t] 1088 wm positionfrom .t program 1089 update 1090 set bit [format 0x%x [expr 0x5 & [lindex [testprop [testwrapper .t] \ 1091 WM_NORMAL_HINTS] 0]]] 1092 lappend result [wm positionfrom .t] $bit 1093 wm positionfrom .t user 1094 update 1095 set bit [format 0x%x [expr 0x5 & [lindex [testprop [testwrapper .t] \ 1096 WM_NORMAL_HINTS] 0]]] 1097 lappend result [wm positionfrom .t] $bit 1098} {user program 0x4 user 0x1} 1099test unixWm-31.3 {Tk_WmCmd procedure, "positionfrom" option} unix { 1100 list [catch {wm positionfrom .t none} msg] $msg 1101} {1 {bad argument "none": must be program or user}} 1102 1103test unixWm-32.1 {Tk_WmCmd procedure, "protocol" option} unix { 1104 list [catch {wm protocol .t 1 2 3} msg] $msg 1105} {1 {wrong # args: should be "wm protocol window ?name? ?command?"}} 1106test unixWm-32.2 {Tk_WmCmd procedure, "protocol" option} unix { 1107 wm protocol .t {foo a} {a b c} 1108 wm protocol .t bar {test script for bar} 1109 set result [wm protocol .t] 1110 wm protocol .t {foo a} {} 1111 wm protocol .t bar {} 1112 set result 1113} {bar {foo a}} 1114test unixWm-32.3 {Tk_WmCmd procedure, "protocol" option} {unix testwrapper} { 1115 set result {} 1116 lappend result [wm protocol .t] 1117 set x {} 1118 foreach i [testprop [testwrapper .t] WM_PROTOCOLS] { 1119 lappend x [winfo atomname $i] 1120 } 1121 lappend result $x 1122 wm protocol .t foo {test script} 1123 wm protocol .t bar {test script} 1124 set x {} 1125 foreach i [testprop [testwrapper .t] WM_PROTOCOLS] { 1126 lappend x [winfo atomname $i] 1127 } 1128 lappend result [wm protocol .t] $x 1129 wm protocol .t foo {} 1130 wm protocol .t bar {} 1131 set x {} 1132 foreach i [testprop [testwrapper .t] WM_PROTOCOLS] { 1133 lappend x [winfo atomname $i] 1134 } 1135 lappend result [wm protocol .t] $x 1136} {{} WM_DELETE_WINDOW {bar foo} {WM_DELETE_WINDOW bar foo} {} WM_DELETE_WINDOW} 1137test unixWm-32.4 {Tk_WmCmd procedure, "protocol" option} unix { 1138 set result {} 1139 wm protocol .t foo {a b c} 1140 wm protocol .t bar {test script for bar} 1141 lappend result [wm protocol .t foo] [wm protocol .t bar] 1142 wm protocol .t foo {} 1143 wm protocol .t bar {} 1144 lappend result [wm protocol .t foo] [wm protocol .t bar] 1145} {{a b c} {test script for bar} {} {}} 1146test unixWm-32.5 {Tk_WmCmd procedure, "protocol" option} unix { 1147 wm protocol .t foo {a b c} 1148 wm protocol .t foo {test script} 1149 set result [wm protocol .t foo] 1150 wm protocol .t foo {} 1151 set result 1152} {test script} 1153 1154test unixWm-33.1 {Tk_WmCmd procedure, "resizable" option} unix { 1155 list [catch {wm resizable . a} msg] $msg 1156} {1 {wrong # args: should be "wm resizable window ?width height?"}} 1157test unixWm-33.2 {Tk_WmCmd procedure, "resizable" option} unix { 1158 list [catch {wm resizable . a b c} msg] $msg 1159} {1 {wrong # args: should be "wm resizable window ?width height?"}} 1160test unixWm-33.3 {Tk_WmCmd procedure, "resizable" option} unix { 1161 list [catch {wm resizable .foo a b c} msg] $msg 1162} {1 {bad window path name ".foo"}} 1163test unixWm-33.4 {Tk_WmCmd procedure, "resizable" option} unix { 1164 list [catch {wm resizable . x 1} msg] $msg 1165} {1 {expected boolean value but got "x"}} 1166test unixWm-33.5 {Tk_WmCmd procedure, "resizable" option} unix { 1167 list [catch {wm resizable . 0 gorp} msg] $msg 1168} {1 {expected boolean value but got "gorp"}} 1169test unixWm-33.6 {Tk_WmCmd procedure, "resizable" option} unix { 1170 destroy .t2 1171 toplevel .t2 -width 200 -height 100 1172 wm geom .t2 +0+0 1173 set result "" 1174 lappend result [wm resizable .t2] 1175 wm resizable .t2 1 0 1176 lappend result [wm resizable .t2] 1177 wm resizable .t2 no off 1178 lappend result [wm resizable .t2] 1179 wm resizable .t2 false true 1180 lappend result [wm resizable .t2] 1181 destroy .t2 1182 set result 1183} {{1 1} {1 0} {0 0} {0 1}} 1184 1185test unixWm-34.1 {Tk_WmCmd procedure, "sizefrom" option} unix { 1186 list [catch {wm sizefrom .t 1 2} msg] $msg 1187} {1 {wrong # args: should be "wm sizefrom window ?user|program?"}} 1188test unixWm-34.2 {Tk_WmCmd procedure, "sizefrom" option} {unix testwrapper} { 1189 set result {} 1190 lappend result [wm sizefrom .t] 1191 wm sizefrom .t program 1192 update 1193 set bit [format 0x%x [expr 0xa & [lindex [testprop [testwrapper .t] \ 1194 WM_NORMAL_HINTS] 0]]] 1195 lappend result [wm sizefrom .t] $bit 1196 wm sizefrom .t user 1197 update 1198 set bit [format 0x%x [expr 0xa & [lindex [testprop [testwrapper .t] \ 1199 WM_NORMAL_HINTS] 0]]] 1200 lappend result [wm sizefrom .t] $bit 1201} {{} program 0x8 user 0x2} 1202test unixWm-34.3 {Tk_WmCmd procedure, "sizefrom" option} unix { 1203 list [catch {wm sizefrom .t none} msg] $msg 1204} {1 {bad argument "none": must be program or user}} 1205 1206test unixWm-35.1 {Tk_WmCmd procedure, "state" option} unix { 1207 list [catch {wm state .t 1} msg] $msg 1208} {1 {bad argument "1": must be normal, iconic, or withdrawn}} 1209test unixWm-35.2 {Tk_WmCmd procedure, "state" option} unix { 1210 list [catch {wm state .t iconic 1} msg] $msg 1211} {1 {wrong # args: should be "wm state window ?state?"}} 1212test unixWm-35.3 {Tk_WmCmd procedure, "state" option} unix { 1213 set result {} 1214 destroy .t2 1215 toplevel .t2 -width 120 -height 300 1216 wm geometry .t2 +0+0 1217 lappend result [wm state .t2] 1218 update 1219 lappend result [wm state .t2] 1220 wm withdraw .t2 1221 lappend result [wm state .t2] 1222 wm iconify .t2 1223 lappend result [wm state .t2] 1224 wm deiconify .t2 1225 lappend result [wm state .t2] 1226 destroy .t2 1227 set result 1228} {normal normal withdrawn iconic normal} 1229test unixWm-35.4 {Tk_WmCmd procedure, "state" option} unix { 1230 set result {} 1231 destroy .t2 1232 toplevel .t2 -width 120 -height 300 1233 wm geometry .t2 +0+0 1234 lappend result [wm state .t2] 1235 update 1236 lappend result [wm state .t2] 1237 wm state .t2 withdrawn 1238 lappend result [wm state .t2] 1239 wm state .t2 iconic 1240 lappend result [wm state .t2] 1241 wm state .t2 normal 1242 lappend result [wm state .t2] 1243 destroy .t2 1244 set result 1245} {normal normal withdrawn iconic normal} 1246 1247test unixWm-36.1 {Tk_WmCmd procedure, "title" option} unix { 1248 list [catch {wm title .t 1 2} msg] $msg 1249} {1 {wrong # args: should be "wm title window ?newTitle?"}} 1250test unixWm-36.2 {Tk_WmCmd procedure, "title" option} {unix testwrapper} { 1251 set result {} 1252 lappend result [wm title .t] [testprop [testwrapper .t] WM_NAME] 1253 wm title .t "Test window" 1254 set bit [format 0x%x [expr 0xa & [lindex [testprop [testwrapper .t] \ 1255 WM_NORMAL_HINTS] 0]]] 1256 lappend result [wm title .t] [testprop [testwrapper .t] WM_NAME] 1257} {t t {Test window} {Test window}} 1258 1259test unixWm-37.3 {Tk_WmCmd procedure, "transient" option} {unix testwrapper} { 1260 set result {} 1261 destroy .t2 1262 toplevel .t2 -width 120 -height 300 1263 wm geometry .t2 +0+0 1264 update 1265 lappend result [wm transient .t2] \ 1266 [testprop [testwrapper .t2] WM_TRANSIENT_FOR] 1267 wm transient .t2 .t 1268 set transient [testprop [testwrapper .t2] WM_TRANSIENT_FOR] 1269 lappend result [wm transient .t2] [expr [testwrapper .t] - $transient] 1270 wm transient .t2 {} 1271 lappend result [wm transient .t2] \ 1272 [testprop [testwrapper .t2] WM_TRANSIENT_FOR] 1273 destroy .t2 1274 set result 1275} {{} {} .t 0 {} {}} 1276test unixWm-37.4 {TkWmDeadWindow, destroy on master should clear transient} {unix testwrapper} { 1277 destroy .t2 1278 toplevel .t2 1279 destroy .t3 1280 toplevel .t3 1281 wm transient .t2 .t3 1282 update 1283 destroy .t3 1284 update 1285 list [wm transient .t2] [testprop [testwrapper .t2] WM_TRANSIENT_FOR] 1286} {{} {}} 1287test unixWm-37.5 {Tk_WmCmd procedure, "transient" option, create master wrapper} {unix testwrapper} { 1288 destroy .t2 1289 destroy .t3 1290 toplevel .t2 -width 120 -height 300 1291 wm geometry .t2 +0+0 1292 toplevel .t3 -width 120 -height 300 1293 wm geometry .t2 +0+0 1294 set result [list [testwrapper .t2]] 1295 wm transient .t3 .t2 1296 lappend result [expr {[testwrapper .t2] == ""}] 1297 destroy .t2 .t3 1298 set result 1299} {{} 0} 1300 1301test unixWm-38.1 {Tk_WmCmd procedure, "withdraw" option} unix { 1302 list [catch {wm withdraw .t 1} msg] $msg 1303} {1 {wrong # args: should be "wm withdraw window"}} 1304test unixWm-38.2 {Tk_WmCmd procedure, "withdraw" option} unix { 1305 destroy .t2 1306 toplevel .t2 -width 120 -height 300 1307 wm geometry .t2 +0+0 1308 wm iconwindow .t .t2 1309 set result [list [catch {wm withdraw .t2} msg] $msg] 1310 destroy .t2 1311 set result 1312} {1 {can't withdraw .t2: it is an icon for .t}} 1313test unixWm-38.3 {Tk_WmCmd procedure, "withdraw" option} unix { 1314 set result {} 1315 wm withdraw .t 1316 lappend result [wm state .t] [winfo ismapped .t] 1317 wm deiconify .t 1318 lappend result [wm state .t] [winfo ismapped .t] 1319} {withdrawn 0 normal 1} 1320 1321test unixWm-39.1 {Tk_WmCmd procedure, miscellaneous} unix { 1322 list [catch {wm unknown .t} msg] $msg 1323} {1 {bad option "unknown": must be aspect, attributes, client, colormapwindows, command, deiconify, focusmodel, forget, frame, geometry, grid, group, iconbitmap, iconify, iconmask, iconname, iconphoto, iconposition, iconwindow, manage, maxsize, minsize, overrideredirect, positionfrom, protocol, resizable, sizefrom, stackorder, state, title, transient, or withdraw}} 1324 1325destroy .t .icon 1326 1327test unixWm-40.1 {Tk_SetGrid procedure, set grid dimensions before turning on grid} {unix nonPortable} { 1328 destroy .t 1329 toplevel .t 1330 wm geometry .t 30x10+0+0 1331 listbox .t.l -height 20 -width 20 -setgrid 1 1332 pack .t.l -fill both -expand 1 1333 update 1334 wm geometry .t 1335} {30x10+0+0} 1336test unixWm-40.2 {Tk_SetGrid procedure, turning on grid when dimensions already set} unix { 1337 destroy .t 1338 toplevel .t 1339 wm geometry .t 200x100+0+0 1340 listbox .t.l -height 20 -width 20 1341 pack .t.l -fill both -expand 1 1342 update 1343 .t.l configure -setgrid 1 1344 update 1345 wm geometry .t 1346} {20x20+0+0} 1347 1348test unixWm-41.1 {ConfigureEvent procedure, internally generated size changes} unix { 1349 destroy .t 1350 toplevel .t -width 400 -height 150 1351 wm geometry .t +0+0 1352 tkwait visibility .t 1353 set result {} 1354 lappend result [winfo width .t] [winfo height .t] 1355 .t configure -width 200 -height 300 1356 sleep 500 1357 lappend result [winfo width .t] [winfo height .t] 1358} {400 150 200 300} 1359test unixWm-41.2 {ConfigureEvent procedure, menubars} {nonPortable testmenubar} { 1360 destroy .t 1361 toplevel .t -width 300 -height 200 -bd 2 -relief raised 1362 wm geom .t +0+0 1363 update 1364 set x [winfo rootx .t] 1365 set y [winfo rooty .t] 1366 frame .t.m -bd 2 -relief raised -height 20 1367 testmenubar window .t .t.m 1368 update 1369 set result {} 1370 bind .t <Configure> { 1371 if {"%W" == ".t"} { 1372 lappend result "%W: %wx%h" 1373 } 1374 } 1375 bind .t.m <Configure> {lappend result "%W: %wx%h"} 1376 wm geometry .t 200x300 1377 update 1378 lappend result [expr [winfo rootx .t.m] - $x] \ 1379 [expr [winfo rooty .t.m] - $y] \ 1380 [winfo width .t.m] [winfo height .t.m] \ 1381 [expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y] \ 1382 [winfo width .t] [winfo height .t] 1383} {{.t.m: 200x20} {.t: 200x300} 0 0 200 20 0 20 200 300} 1384test unixWm-41.3 {ConfigureEvent procedure, synthesized Configure events} unix { 1385 destroy .t 1386 toplevel .t -width 400 -height 150 1387 wm geometry .t +0+0 1388 tkwait visibility .t 1389 set result {no event} 1390 bind .t <Configure> {set result "configured: %w %h"} 1391 wm geometry .t +10+20 1392 update 1393 set result 1394} {configured: 400 150} 1395test unixWm-41.4 {ConfigureEvent procedure, synthesized Configure events} unix { 1396 destroy .t 1397 toplevel .t -width 400 -height 150 1398 wm geometry .t +0+0 1399 tkwait visibility .t 1400 set result {no event} 1401 bind .t <Configure> {set result "configured: %w %h"} 1402 wm geometry .t 130x200 1403 update 1404 set result 1405} {configured: 130 200} 1406 1407# No tests for ReparentEvent or ComputeReparentGeometry; I can't figure 1408# out how to exercise these procedures reliably. 1409 1410test unixWm-42.1 {WrapperEventProc procedure, map and unmap events} unix { 1411 destroy .t 1412 toplevel .t -width 400 -height 150 1413 wm geometry .t +0+0 1414 tkwait visibility .t 1415 set result {} 1416 bind .t <Map> {set x "mapped"} 1417 bind .t <Unmap> {set x "unmapped"} 1418 set x {no event} 1419 wm iconify .t 1420 lappend result $x [winfo ismapped .t] 1421 set x {no event} 1422 wm deiconify .t 1423 lappend result $x [winfo ismapped .t] 1424} {unmapped 0 mapped 1} 1425 1426test unixWm-43.1 {TopLevelReqProc procedure, embedded in same process} unix { 1427 destroy .t 1428 toplevel .t -width 200 -height 200 1429 wm geom .t +0+0 1430 frame .t.f -container 1 -bd 2 -relief raised 1431 place .t.f -x 20 -y 10 1432 tkwait visibility .t.f 1433 toplevel .t2 -use [winfo id .t.f] -width 30 -height 20 -bg blue 1434 tkwait visibility .t2 1435 set result {} 1436 .t2 configure -width 70 -height 120 1437 update 1438 lappend result [winfo reqwidth .t.f] [winfo reqheight .t.f] 1439 lappend result [winfo width .t2] [winfo height .t2] 1440 # destroy .t2 1441 set result 1442} {70 120 70 120} 1443test unixWm-43.2 {TopLevelReqProc procedure, resize causes window to move} \ 1444 {unix nonPortable} { 1445 destroy .t 1446 toplevel .t -width 200 -height 200 1447 wm geom .t +0+0 1448 update 1449 wm geom .t -0-0 1450 update 1451 set x [winfo x .t] 1452 set y [winfo y .t] 1453 .t configure -width 300 -height 150 1454 update 1455 list [expr [winfo x .t] - $x] [expr [winfo y .t] - $y] \ 1456 [winfo width .t] [winfo height .t] 1457} {-100 50 300 150} 1458 1459test unixWm-44.1 {UpdateGeometryInfo procedure, width/height computation} unix { 1460 destroy .t 1461 toplevel .t -width 100 -height 200 1462 wm geometry .t +30+40 1463 wm overrideredirect .t 1 1464 tkwait visibility .t 1465 .t configure -width 180 -height 20 1466 update 1467 list [winfo width .t] [winfo height .t] 1468} {180 20} 1469test unixWm-44.2 {UpdateGeometryInfo procedure, width/height computation} unix { 1470 destroy .t 1471 toplevel .t -width 80 -height 60 1472 wm grid .t 5 4 10 12 1473 wm geometry .t +30+40 1474 wm overrideredirect .t 1 1475 tkwait visibility .t 1476 wm geometry .t 10x2 1477 update 1478 list [winfo width .t] [winfo height .t] 1479} {130 36} 1480test unixWm-44.3 {UpdateGeometryInfo procedure, width/height computation} unix { 1481 destroy .t 1482 toplevel .t -width 80 -height 60 1483 wm grid .t 5 4 10 12 1484 wm geometry .t +30+40 1485 wm overrideredirect .t 1 1486 tkwait visibility .t 1487 wm geometry .t 1x10 1488 update 1489 list [winfo width .t] [winfo height .t] 1490} {40 132} 1491test unixWm-44.4 {UpdateGeometryInfo procedure, width/height computation} unix { 1492 destroy .t 1493 toplevel .t -width 100 -height 200 1494 wm geometry .t +30+40 1495 wm overrideredirect .t 1 1496 tkwait visibility .t 1497 wm geometry .t 300x150 1498 update 1499 list [winfo width .t] [winfo height .t] 1500} {300 150} 1501test unixWm-44.5 {UpdateGeometryInfo procedure, negative width} unix { 1502 destroy .t 1503 toplevel .t -width 80 -height 60 1504 wm grid .t 18 7 10 12 1505 wm geometry .t +30+40 1506 wm overrideredirect .t 1 1507 tkwait visibility .t 1508 wm geometry .t 5x8 1509 update 1510 list [winfo width .t] [winfo height .t] 1511} {1 72} 1512test unixWm-44.6 {UpdateGeometryInfo procedure, negative height} unix { 1513 destroy .t 1514 toplevel .t -width 80 -height 60 1515 wm grid .t 18 7 10 12 1516 wm geometry .t +30+40 1517 wm overrideredirect .t 1 1518 tkwait visibility .t 1519 wm geometry .t 20x1 1520 update 1521 list [winfo width .t] [winfo height .t] 1522} {100 1} 1523 1524destroy .t 1525toplevel .t -width 80 -height 60 1526test unixWm-44.7 {UpdateGeometryInfo procedure, computing position} unix { 1527 wm geometry .t +5-10 1528 wm overrideredirect .t 1 1529 tkwait visibility .t 1530 list [winfo x .t] [winfo y .t] 1531} [list 5 [expr [winfo screenheight .t] - 70]] 1532 1533destroy .t 1534toplevel .t -width 80 -height 60 1535test unixWm-44.8 {UpdateGeometryInfo procedure, computing position} unix { 1536 wm geometry .t -30+2 1537 wm overrideredirect .t 1 1538 tkwait visibility .t 1539 list [winfo x .t] [winfo y .t] 1540} [list [expr [winfo screenwidth .t] - 110] 2] 1541destroy .t 1542 1543test unixWm-44.9 {UpdateGeometryInfo procedure, updating fixed dimensions} {unix testwrapper} { 1544 destroy .t 1545 toplevel .t -width 80 -height 60 1546 wm resizable .t 0 0 1547 wm geometry .t +0+0 1548 tkwait visibility .t 1549 .t configure -width 180 -height 20 1550 update 1551 set property [testprop [testwrapper .t] WM_NORMAL_HINTS] 1552 list [expr [lindex $property 5]] [expr [lindex $property 6]] \ 1553 [expr [lindex $property 7]] [expr [lindex $property 8]] 1554} {180 20 180 20} 1555test unixWm-44.10 {UpdateGeometryInfo procedure, menubar changing} testmenubar { 1556 destroy .t 1557 toplevel .t -width 80 -height 60 1558 wm resizable .t 0 0 1559 wm geometry .t +0+0 1560 tkwait visibility .t 1561 .t configure -width 180 -height 50 1562 frame .t.m -bd 2 -relief raised -width 100 -height 50 1563 testmenubar window .t .t.m 1564 update 1565 .t configure -height 70 1566 .t.m configure -height 30 1567 list [update] [destroy .t] 1568} {{} {}} 1569 1570test unixWm-45.1 {UpdateSizeHints procedure, grid information} {unix testwrapper} { 1571 destroy .t 1572 toplevel .t -width 80 -height 60 1573 wm grid .t 6 10 10 5 1574 wm minsize .t 2 4 1575 wm maxsize .t 30 40 1576 wm geometry .t +0+0 1577 tkwait visibility .t 1578 set property [testprop [testwrapper .t] WM_NORMAL_HINTS] 1579 list [expr [lindex $property 5]] [expr [lindex $property 6]] \ 1580 [expr [lindex $property 7]] [expr [lindex $property 8]] \ 1581 [expr [lindex $property 9]] [expr [lindex $property 10]] 1582} {40 30 320 210 10 5} 1583test unixWm-45.2 {UpdateSizeHints procedure} {unix testwrapper} { 1584 destroy .t 1585 toplevel .t -width 80 -height 60 1586 wm minsize .t 30 40 1587 wm maxsize .t 200 500 1588 wm geometry .t +0+0 1589 tkwait visibility .t 1590 set property [testprop [testwrapper .t] WM_NORMAL_HINTS] 1591 list [expr [lindex $property 5]] [expr [lindex $property 6]] \ 1592 [expr [lindex $property 7]] [expr [lindex $property 8]] \ 1593 [expr [lindex $property 9]] [expr [lindex $property 10]] 1594} {30 40 200 500 1 1} 1595test unixWm-45.3 {UpdateSizeHints procedure, grid with menu} {testmenubar testwrapper} { 1596 destroy .t 1597 toplevel .t -width 80 -height 60 1598 frame .t.menu -height 23 -width 50 1599 testmenubar window .t .t.menu 1600 wm grid .t 6 10 10 5 1601 wm minsize .t 2 4 1602 wm maxsize .t 30 40 1603 wm geometry .t +0+0 1604 tkwait visibility .t 1605 set property [testprop [testwrapper .t] WM_NORMAL_HINTS] 1606 list [winfo height .t] \ 1607 [expr [lindex $property 5]] [expr [lindex $property 6]] \ 1608 [expr [lindex $property 7]] [expr [lindex $property 8]] \ 1609 [expr [lindex $property 9]] [expr [lindex $property 10]] 1610} {60 40 53 320 233 10 5} 1611test unixWm-45.4 {UpdateSizeHints procedure, not resizable with menu} {testmenubar testwrapper} { 1612 destroy .t 1613 toplevel .t -width 80 -height 60 1614 frame .t.menu -height 23 -width 50 1615 testmenubar window .t .t.menu 1616 wm resizable .t 0 0 1617 wm geometry .t +0+0 1618 tkwait visibility .t 1619 set property [testprop [testwrapper .t] WM_NORMAL_HINTS] 1620 list [winfo height .t] \ 1621 [expr [lindex $property 5]] [expr [lindex $property 6]] \ 1622 [expr [lindex $property 7]] [expr [lindex $property 8]] \ 1623 [expr [lindex $property 9]] [expr [lindex $property 10]] 1624} {60 80 83 80 83 1 1} 1625 1626# I don't know how to test WaitForConfigureNotify. 1627 1628test unixWm-46.1 {WaitForEvent procedure, use of modal timeout} unix { 1629 destroy .t 1630 toplevel .t -width 200 -height 200 1631 wm geom .t +0+0 1632 update 1633 wm iconify .t 1634 set x no 1635 after 0 {set x yes} 1636 wm deiconify .t 1637 set result $x 1638 update 1639 list $result $x 1640} {no yes} 1641 1642test unixWm-47.1 {WaitRestrictProc procedure} {unix nonPortable} { 1643 destroy .t 1644 toplevel .t -width 300 -height 200 1645 frame .t.f -bd 2 -relief raised 1646 place .t.f -x 20 -y 30 -width 100 -height 20 1647 wm geometry .t +0+0 1648 tkwait visibility .t 1649 set result {} 1650 bind .t.f <Configure> {lappend result {configure on .t.f}} 1651 bind .t <Map> {lappend result {map on .t}} 1652 bind .t <Unmap> {lappend result {unmap on .t}; bind .t <Unmap> {}} 1653 bind .t <Button> {lappend result {button %b on .t}} 1654 event generate .t.f <Configure> -when tail 1655 event generate .t <Configure> -when tail 1656 event generate .t <Button> -button 3 -when tail 1657 event generate .t <ButtonRelease> -button 3 -when tail 1658 event generate .t <Map> -when tail 1659 lappend result iconify 1660 wm iconify .t 1661 lappend result done 1662 update 1663 set result 1664} {iconify {unmap on .t} done {configure on .t.f} {button 3 on .t} {map on .t}} 1665 1666# I don't know how to test WaitTimeoutProc, WaitForMapNotify, or UpdateHints. 1667 1668destroy .t 1669toplevel .t -width 300 -height 200 1670wm geometry .t +0+0 1671tkwait visibility .t 1672 1673test unixWm-48.1 {ParseGeometry procedure} unix { 1674 wm geometry .t =100x120 1675 update 1676 list [winfo width .t] [winfo height .t] 1677} {100 120} 1678test unixWm-48.2 {ParseGeometry procedure} unix { 1679 list [catch {wm geometry .t =10zx120} msg] $msg 1680} {1 {bad geometry specifier "=10zx120"}} 1681test unixWm-48.3 {ParseGeometry procedure} unix { 1682 list [catch {wm geometry .t x120} msg] $msg 1683} {1 {bad geometry specifier "x120"}} 1684test unixWm-48.4 {ParseGeometry procedure} unix { 1685 list [catch {wm geometry .t =100x120a} msg] $msg 1686} {1 {bad geometry specifier "=100x120a"}} 1687test unixWm-48.5 {ParseGeometry procedure} unix { 1688 list [catch {wm geometry .t z} msg] $msg 1689} {1 {bad geometry specifier "z"}} 1690test unixWm-48.6 {ParseGeometry procedure} unix { 1691 list [catch {wm geometry .t +20&} msg] $msg 1692} {1 {bad geometry specifier "+20&"}} 1693test unixWm-48.7 {ParseGeometry procedure} unix { 1694 list [catch {wm geometry .t +-} msg] $msg 1695} {1 {bad geometry specifier "+-"}} 1696test unixWm-48.8 {ParseGeometry procedure} unix { 1697 list [catch {wm geometry .t +20a} msg] $msg 1698} {1 {bad geometry specifier "+20a"}} 1699test unixWm-48.9 {ParseGeometry procedure} unix { 1700 list [catch {wm geometry .t +20-} msg] $msg 1701} {1 {bad geometry specifier "+20-"}} 1702test unixWm-48.10 {ParseGeometry procedure} unix { 1703 list [catch {wm geometry .t +20+10z} msg] $msg 1704} {1 {bad geometry specifier "+20+10z"}} 1705test unixWm-48.11 {ParseGeometry procedure} unix { 1706 catch {wm geometry .t +-10+20} 1707} {0} 1708test unixWm-48.12 {ParseGeometry procedure} unix { 1709 catch {wm geometry .t +30+-10} 1710} {0} 1711test unixWm-48.13 {ParseGeometry procedure, resize causes window to move} unix { 1712 destroy .t 1713 toplevel .t -width 200 -height 200 1714 wm geom .t +0+0 1715 update 1716 wm geom .t -0-0 1717 update 1718 set x [winfo x .t] 1719 set y [winfo y .t] 1720 wm geometry .t 150x300 1721 update 1722 list [expr [winfo x .t] - $x] [expr [winfo y .t] - $y] \ 1723 [winfo width .t] [winfo height .t] 1724} {50 -100 150 300} 1725 1726test unixWm-49.1 {Tk_GetRootCoords procedure} unix { 1727 destroy .t 1728 toplevel .t -width 300 -height 200 1729 frame .t.f -width 150 -height 100 -bd 2 -relief raised 1730 place .t.f -x 150 -y 120 1731 frame .t.f.f -width 20 -height 20 -bd 2 -relief raised 1732 place .t.f.f -x 10 -y 20 1733 wm overrideredirect .t 1 1734 wm geometry .t +40+50 1735 tkwait visibility .t 1736 list [winfo rootx .t.f.f] [winfo rooty .t.f.f] 1737} {202 192} 1738test unixWm-49.2 {Tk_GetRootCoords procedure, menubars} {unix testmenubar} { 1739 destroy .t 1740 toplevel .t -width 300 -height 200 -bd 2 -relief raised 1741 wm geom .t +0+0 1742 update 1743 set x [winfo rootx .t] 1744 set y [winfo rooty .t] 1745 frame .t.m -bd 2 -relief raised -width 100 -height 30 1746 frame .t.m.f -width 20 -height 10 -bd 2 -relief raised 1747 place .t.m.f -x 50 -y 5 1748 frame .t.f -width 20 -height 30 -bd 2 -relief raised 1749 place .t.f -x 10 -y 30 1750 testmenubar window .t .t.m 1751 update 1752 list [expr [winfo rootx .t.m.f] - $x] [expr [winfo rooty .t.m.f] - $y] \ 1753 [expr [winfo rootx .t.f] - $x] [expr [winfo rooty .t.f] - $y] 1754} {52 7 12 62} 1755 1756deleteWindows 1757wm iconify . 1758test unixWm-50.1 {Tk_CoordsToWindow procedure, finding a toplevel, x-coords} unix { 1759 deleteWindows 1760 toplevel .t -width 300 -height 400 -bg green 1761 wm geom .t +40+0 1762 tkwait visibility .t 1763 toplevel .t2 -width 100 -height 80 -bg red 1764 wm geom .t2 +140+200 1765 tkwait visibility .t2 1766 raise .t2 1767 set x [winfo rootx .t] 1768 set y [winfo rooty .t] 1769 list [winfo containing [expr $x - 30] [expr $y + 250]] \ 1770 [winfo containing [expr $x - 1] [expr $y + 250]] \ 1771 [winfo containing $x [expr $y + 250]] \ 1772 [winfo containing [expr $x + 99] [expr $y + 250]] \ 1773 [winfo containing [expr $x + 100] [expr $y + 250]] \ 1774 [winfo containing [expr $x + 199] [expr $y + 250]] \ 1775 [winfo containing [expr $x + 200] [expr $y + 250]] \ 1776 [winfo containing [expr $x + 220] [expr $y + 250]] 1777} {{} {} .t {} .t2 .t2 {} .t} 1778test unixWm-50.2 {Tk_CoordsToWindow procedure, finding a toplevel, y-coords and overrideredirect} unix { 1779 deleteWindows 1780 toplevel .t -width 300 -height 400 -bg yellow 1781 wm geom .t +0+50 1782 tkwait visibility .t 1783 toplevel .t2 -width 100 -height 80 -bg blue 1784 wm overrideredirect .t2 1 1785 wm geom .t2 +100+200 1786 tkwait visibility .t2 1787 raise .t2 1788 set x [winfo rootx .t] 1789 set y [winfo rooty .t] 1790 set y2 [winfo rooty .t2] 1791 list [winfo containing [expr $x +150] 10] \ 1792 [winfo containing [expr $x +150] [expr $y - 1]] \ 1793 [winfo containing [expr $x +150] $y] \ 1794 [winfo containing [expr $x +150] [expr $y2 - 1]] \ 1795 [winfo containing [expr $x +150] $y2] \ 1796 [winfo containing [expr $x +150] [expr $y2 + 79]] \ 1797 [winfo containing [expr $x +150] [expr $y2 + 80]] \ 1798 [winfo containing [expr $x +150] [expr $y + 450]] 1799} {{} {} .t .t .t2 .t2 .t {}} 1800test unixWm-50.3 { 1801 Tk_CoordsToWindow procedure, finding a toplevel with embedding 1802} -constraints tempNotWin -setup { 1803 deleteWindows 1804 toplevel .t -width 300 -height 400 -bg blue 1805 wm geom .t +0+50 1806 frame .t.f -container 1 1807 place .t.f -x 150 -y 50 1808 tkwait visibility .t.f 1809 setupbg 1810} -body { 1811 dobg " 1812 wm withdraw . 1813 toplevel .x -width 100 -height 80 -use [winfo id .t.f] -bg yellow 1814 tkwait visibility .x" 1815 set result [dobg { 1816 set x [winfo rootx .x] 1817 set y [winfo rooty .x] 1818 list [winfo containing [expr $x - 1] [expr $y + 50]] \ 1819 [winfo containing $x [expr $y +50]] 1820 }] 1821 set x [winfo rootx .t] 1822 set y [winfo rooty .t] 1823 lappend result [winfo containing [expr $x + 200] [expr $y + 49]] \ 1824 [winfo containing [expr $x + 200] [expr $y +50]] 1825} -cleanup { 1826 cleanupbg 1827} -result {{} .x .t .t.f} 1828test unixWm-50.4 {Tk_CoordsToWindow procedure, window in other application} unix { 1829 destroy .t 1830 catch {interp delete slave} 1831 toplevel .t -width 200 -height 200 -bg green 1832 wm geometry .t +0+0 1833 tkwait visibility .t 1834 interp create slave 1835 load {} Tk slave 1836 slave eval {wm geometry . 200x200+0+0; tkwait visibility .} 1837 set result [list [winfo containing 100 100] \ 1838 [slave eval {winfo containing 100 100}]] 1839 interp delete slave 1840 set result 1841} {{} .} 1842test unixWm-50.5 {Tk_CoordsToWindow procedure, handling menubars} {unix testmenubar} { 1843 deleteWindows 1844 toplevel .t -width 300 -height 400 -bd 2 -relief raised 1845 frame .t.f -width 150 -height 120 -bg green 1846 place .t.f -x 10 -y 150 1847 wm geom .t +0+50 1848 frame .t.menu -width 100 -height 30 -bd 2 -relief raised 1849 frame .t.menu.f -width 40 -height 20 -bg purple 1850 place .t.menu.f -x 30 -y 10 1851 testmenubar window .t .t.menu 1852 tkwait visibility .t.menu 1853 update 1854 set x [winfo rootx .t] 1855 set y [winfo rooty .t] 1856 list [winfo containing $x [expr $y - 31]] \ 1857 [winfo containing $x [expr $y - 30]] \ 1858 [winfo containing [expr $x + 50] [expr $y - 19]] \ 1859 [winfo containing [expr $x + 50] [expr $y - 18]] \ 1860 [winfo containing [expr $x + 50] $y] \ 1861 [winfo containing [expr $x + 11] [expr $y + 152]] \ 1862 [winfo containing [expr $x + 12] [expr $y + 152]] 1863} {{} .t.menu .t.menu .t.menu.f .t .t .t.f} 1864test unixWm-50.6 {Tk_CoordsToWindow procedure, embedding within one app.} unix { 1865 deleteWindows 1866 toplevel .t -width 300 -height 400 -bg orange 1867 wm geom .t +0+50 1868 frame .t.f -container 1 1869 place .t.f -x 150 -y 50 1870 tkwait visibility .t.f 1871 toplevel .t2 -width 100 -height 80 -bg green -use [winfo id .t.f] 1872 tkwait visibility .t2 1873 update 1874 set x [winfo rootx .t] 1875 set y [winfo rooty .t] 1876 list [winfo containing [expr $x +149] [expr $y + 80]] \ 1877 [winfo containing [expr $x +150] [expr $y +80]] \ 1878 [winfo containing [expr $x +249] [expr $y +80]] \ 1879 [winfo containing [expr $x +250] [expr $y +80]] 1880} {.t .t2 .t2 .t} 1881test unixWm-50.7 {Tk_CoordsToWindow procedure, more basics} unix { 1882 destroy .t 1883 toplevel .t -width 300 -height 400 -bg green 1884 wm geom .t +0+0 1885 frame .t.f -width 100 -height 200 -bd 2 -relief raised 1886 place .t.f -x 100 -y 100 1887 frame .t.f.f -width 100 -height 200 -bd 2 -relief raised 1888 place .t.f.f -x 0 -y 100 1889 tkwait visibility .t.f.f 1890 set x [expr [winfo rootx .t] + 150] 1891 set y [winfo rooty .t] 1892 list [winfo containing $x [expr $y + 50]] \ 1893 [winfo containing $x [expr $y + 150]] \ 1894 [winfo containing $x [expr $y + 250]] \ 1895 [winfo containing $x [expr $y + 350]] \ 1896 [winfo containing $x [expr $y + 450]] 1897} {.t .t.f .t.f.f .t {}} 1898test unixWm-50.8 {Tk_CoordsToWindow procedure, more basics} unix { 1899 destroy .t 1900 toplevel .t -width 400 -height 300 -bg green 1901 wm geom .t +0+0 1902 frame .t.f -width 200 -height 100 -bd 2 -relief raised 1903 place .t.f -x 100 -y 100 1904 frame .t.f.f -width 200 -height 100 -bd 2 -relief raised 1905 place .t.f.f -x 100 -y 0 1906 update 1907 set x [winfo rooty .t] 1908 set y [expr [winfo rooty .t] + 150] 1909 list [winfo containing [expr $x + 50] $y] \ 1910 [winfo containing [expr $x + 150] $y] \ 1911 [winfo containing [expr $x + 250] $y] \ 1912 [winfo containing [expr $x + 350] $y] \ 1913 [winfo containing [expr $x + 450] $y] 1914} {.t .t.f .t.f.f .t {}} 1915test unixWm-50.9 {Tk_CoordsToWindow procedure, unmapped windows} unix { 1916 destroy .t 1917 destroy .t2 1918 sleep 500 ;# Give window manager time to catch up. 1919 toplevel .t -width 200 -height 200 -bg green 1920 wm geometry .t +0+0 1921 tkwait visibility .t 1922 toplevel .t2 -width 200 -height 200 -bg red 1923 wm geometry .t2 +0+0 1924 tkwait visibility .t2 1925 set result [list [winfo containing 100 100]] 1926 wm iconify .t2 1927 lappend result [winfo containing 100 100] 1928} {.t2 .t} 1929test unixWm-50.10 {Tk_CoordsToWindow procedure, unmapped windows} unix { 1930 destroy .t 1931 toplevel .t -width 200 -height 200 -bg green 1932 wm geometry .t +0+0 1933 frame .t.f -width 150 -height 150 -bd 2 -relief raised 1934 place .t.f -x 25 -y 25 1935 tkwait visibility .t.f 1936 set result [list [winfo containing 100 100]] 1937 place forget .t.f 1938 update 1939 lappend result [winfo containing 100 100] 1940} {.t.f .t} 1941deleteWindows 1942wm deiconify . 1943 1944# No tests for UpdateVRootGeometry, Tk_GetVRootGeometry, 1945# Tk_MoveToplevelWindow, UpdateWmProtocols, or TkWmProtocolEventProc. 1946 1947test unixWm-51.1 {TkWmRestackToplevel procedure, basic tests} {unix nonPortable} { 1948 makeToplevels 1949 update 1950 raise .raise1 1951 winfo containing [winfo rootx .raise1] [winfo rooty .raise1] 1952} .raise1 1953test unixWm-51.2 {TkWmRestackToplevel procedure, basic tests} {unix nonPortable} { 1954 makeToplevels 1955 update 1956 raise .raise2 1957 winfo containing [winfo rootx .raise1] [winfo rooty .raise1] 1958} .raise2 1959test unixWm-51.3 {TkWmRestackToplevel procedure, basic tests} {unix nonPortable} { 1960 makeToplevels 1961 update 1962 raise .raise3 1963 raise .raise2 1964 raise .raise1 .raise3 1965 set result [winfo containing [winfo rootx .raise1] \ 1966 [winfo rooty .raise1]] 1967 destroy .raise2 1968 sleep 500 1969 list $result [winfo containing [winfo rootx .raise1] \ 1970 [winfo rooty .raise1]] 1971} {.raise2 .raise1} 1972test unixWm-51.4 {TkWmRestackToplevel procedure, basic tests} {unix nonPortable} { 1973 makeToplevels 1974 raise .raise2 1975 raise .raise1 1976 lower .raise3 .raise1 1977 set result [winfo containing 100 100] 1978 destroy .raise1 1979 sleep 500 1980 lappend result [winfo containing 100 100] 1981} {.raise1 .raise3} 1982test unixWm-51.5 {TkWmRestackToplevel procedure, basic tests} {unix nonPortable} { 1983 makeToplevels 1984 update 1985 raise .raise2 1986 raise .raise1 1987 raise .raise3 1988 frame .raise1.f1 1989 frame .raise1.f1.f2 1990 lower .raise3 .raise1.f1.f2 1991 set result [winfo containing [winfo rootx .raise1] \ 1992 [winfo rooty .raise1]] 1993 destroy .raise1 1994 sleep 500 1995 list $result [winfo containing [winfo rootx .raise2] \ 1996 [winfo rooty .raise2]] 1997} {.raise1 .raise3} 1998deleteWindows 1999test unixWm-51.6 {TkWmRestackToplevel procedure, window to be stacked isn't mapped} unix { 2000 destroy .t 2001 toplevel .t -width 200 -height 200 -bg green 2002 wm geometry .t +0+0 2003 tkwait visibility .t 2004 destroy .t2 2005 toplevel .t2 -width 200 -height 200 -bg red 2006 wm geometry .t2 +0+0 2007 winfo containing 100 100 2008} {.t} 2009test unixWm-51.7 {TkWmRestackToplevel procedure, other window isn't mapped} unix { 2010 foreach w {.t .t2 .t3} { 2011 destroy $w 2012 toplevel $w -width 200 -height 200 -bg green 2013 wm geometry $w +0+0 2014 } 2015 raise .t .t2 2016 sleep 2000 2017 update 2018 set result [list [winfo containing 100 100]] 2019 lower .t3 2020 sleep 2000 2021 lappend result [winfo containing 100 100] 2022} {.t3 .t} 2023test unixWm-51.8 {TkWmRestackToplevel procedure, overrideredirect windows} unix { 2024 destroy .t 2025 toplevel .t -width 200 -height 200 -bg green 2026 wm overrideredirect .t 1 2027 wm geometry .t +0+0 2028 tkwait visibility .t 2029 destroy .t2 2030 toplevel .t2 -width 200 -height 200 -bg red 2031 wm overrideredirect .t2 1 2032 wm geometry .t2 +0+0 2033 tkwait visibility .t2 2034 2035 # Need to use vrootx and vrooty to make tests work correctly with 2036 # virtual root window measures managers: overrideredirect windows 2037 # come up at (0,0) in display coordinates, not virtual root 2038 # coordinates. 2039 2040 set x [expr 100-[winfo vrootx .]] 2041 set y [expr 100-[winfo vrooty .]] 2042 set result [list [winfo containing $x $y]] 2043 raise .t 2044 lappend result [winfo containing $x $y] 2045 raise .t2 2046 lappend result [winfo containing $x $y] 2047} {.t2 .t .t2} 2048test unixWm-51.9 {TkWmRestackToplevel procedure, other window overrideredirect} unix { 2049 foreach w {.t .t2 .t3} { 2050 destroy $w 2051 toplevel $w -width 200 -height 200 -bg green 2052 wm overrideredirect $w 1 2053 wm geometry $w +0+0 2054 tkwait visibility $w 2055 } 2056 lower .t3 .t2 2057 update 2058 2059 # Need to use vrootx and vrooty to make tests work correctly with 2060 # virtual root window measures managers: overrideredirect windows 2061 # come up at (0,0) in display coordinates, not virtual root 2062 # coordinates. 2063 2064 set x [expr 100-[winfo vrootx .]] 2065 set y [expr 100-[winfo vrooty .]] 2066 set result [list [winfo containing $x $y]] 2067 lower .t2 2068 lappend result [winfo containing $x $y] 2069} {.t2 .t3} 2070test unixWm-51.10 {TkWmRestackToplevel procedure, don't move window that's already in the right place} unix { 2071 makeToplevels 2072 raise .raise1 2073 set time [lindex [time {raise .raise1}] 0] 2074 expr {$time < 2000000} 2075} 1 2076test unixWm-51.11 {TkWmRestackToplevel procedure, don't move window that's already in the right place} unix { 2077 makeToplevels 2078 set time [lindex [time {lower .raise1}] 0] 2079 expr {$time < 2000000} 2080} 1 2081test unixWm-51.12 {TkWmRestackToplevel procedure, don't move window that's already in the right place} unix { 2082 makeToplevels 2083 set time [lindex [time {raise .raise3 .raise2}] 0] 2084 expr {$time < 2000000} 2085} 1 2086test unixWm-51.13 {TkWmRestackToplevel procedure, don't move window that's already in the right place} unix { 2087 makeToplevels 2088 set time [lindex [time {lower .raise1 .raise2}] 0] 2089 expr {$time < 2000000} 2090} 1 2091 2092test unixWm-52.1 {TkWmAddToColormapWindows procedure} unix { 2093 destroy .t 2094 toplevel .t -width 200 -height 200 -colormap new -relief raised -bd 2 2095 wm geom .t +0+0 2096 update 2097 wm colormap .t 2098} {} 2099test unixWm-52.2 {TkWmAddToColormapWindows procedure} unix { 2100 destroy .t 2101 toplevel .t -colormap new -relief raised -bd 2 2102 wm geom .t +0+0 2103 frame .t.f -width 100 -height 100 -colormap new -relief sunken -bd 2 2104 pack .t.f 2105 update 2106 wm colormap .t 2107} {.t.f .t} 2108test unixWm-52.3 {TkWmAddToColormapWindows procedure} unix { 2109 destroy .t 2110 toplevel .t -colormap new 2111 wm geom .t +0+0 2112 frame .t.f -width 100 -height 100 -colormap new -relief sunken -bd 2 2113 pack .t.f 2114 frame .t.f2 -width 100 -height 100 -colormap new -relief sunken -bd 2 2115 pack .t.f2 2116 update 2117 wm colormap .t 2118} {.t.f .t.f2 .t} 2119test unixWm-52.4 {TkWmAddToColormapWindows procedure} unix { 2120 destroy .t 2121 toplevel .t -colormap new 2122 wm geom .t +0+0 2123 frame .t.f -width 100 -height 100 -colormap new -relief sunken -bd 2 2124 pack .t.f 2125 update 2126 wm colormapwindows .t .t.f 2127 frame .t.f2 -width 100 -height 100 -colormap new -relief sunken -bd 2 2128 pack .t.f2 2129 update 2130 wm colormapwindows .t 2131} {.t.f} 2132 2133test unixWm-53.1 {TkWmRemoveFromColormapWindows procedure} unix { 2134 destroy .t 2135 toplevel .t -colormap new 2136 wm geom .t +0+0 2137 frame .t.f -width 100 -height 100 -colormap new -relief sunken -bd 2 2138 pack .t.f 2139 frame .t.f2 -width 100 -height 100 -colormap new -relief sunken -bd 2 2140 pack .t.f2 2141 update 2142 destroy .t.f2 2143 wm colormap .t 2144} {.t.f .t} 2145test unixWm-53.2 {TkWmRemoveFromColormapWindows procedure} unix { 2146 destroy .t 2147 toplevel .t -colormap new 2148 wm geom .t +0+0 2149 frame .t.f -width 100 -height 100 -colormap new -relief sunken -bd 2 2150 pack .t.f 2151 frame .t.f2 -width 100 -height 100 -colormap new -relief sunken -bd 2 2152 pack .t.f2 2153 update 2154 wm colormapwindows .t .t.f2 2155 destroy .t.f2 2156 wm colormap .t 2157} {} 2158 2159test unixWm-54.1 {TkpMakeMenuWindow procedure, setting save_under} {unix nonUnixUserInteraction} { 2160 destroy .t 2161 destroy .m 2162 toplevel .t -width 300 -height 200 -bd 2 -relief raised 2163 bind .t <Expose> {set x exposed} 2164 wm geom .t +0+0 2165 update 2166 menu .m 2167 .m add command -label First 2168 .m add command -label Second 2169 .m add command -label Third 2170 .m post 30 30 2171 update 2172 set x {no event} 2173 destroy .m 2174 set x 2175} {no event} 2176test unixWm-54.2 {TkpMakeMenuWindow procedure, setting override_redirect} {unix nonUnixUserInteraction} { 2177 destroy .m 2178 menu .m 2179 .m add command -label First 2180 .m add command -label Second 2181 .m add command -label Third 2182 .m post 30 30 2183 update 2184 set result [wm overrideredirect .m] 2185 destroy .m 2186 set result 2187} {1} 2188 2189# No tests for TkGetPointerCoords, CreateWrapper, or GetMaxSize. 2190 2191test unixWm-55.1 {TkUnixSetMenubar procedure} {unix testmenubar} { 2192 destroy .t 2193 toplevel .t -width 300 -height 200 -bd 2 -relief raised 2194 wm geom .t +0+0 2195 update 2196 frame .t.f -width 400 -height 30 -bd 2 -relief raised -bg green 2197 testmenubar window .t .t.f 2198 update 2199 list [winfo ismapped .t.f] [winfo geometry .t.f] \ 2200 [expr [winfo rootx .t] - [winfo rootx .t.f]] \ 2201 [expr [winfo rooty .t] - [winfo rooty .t.f]] 2202} {1 300x30+0+0 0 30} 2203test unixWm-55.2 {TkUnixSetMenubar procedure, removing menubar} {unix testmenubar} { 2204 destroy .t 2205 destroy .f 2206 toplevel .t -width 300 -height 200 -bd 2 -relief raised 2207 wm geom .t +0+0 2208 update 2209 set x [winfo rootx .t] 2210 set y [winfo rooty .t] 2211 frame .f -width 400 -height 30 -bd 2 -relief raised -bg green 2212 testmenubar window .t .f 2213 update 2214 testmenubar window .t {} 2215 update 2216 list [winfo ismapped .f] [winfo geometry .f] \ 2217 [expr [winfo rootx .t] - $x] \ 2218 [expr [winfo rooty .t] - $y] \ 2219 [expr [winfo rootx .] - [winfo rootx .f]] \ 2220 [expr [winfo rooty .] - [winfo rooty .f]] 2221} {0 300x30+0+0 0 0 0 0} 2222test unixWm-55.3 {TkUnixSetMenubar procedure, removing geometry manager} {unix testmenubar} { 2223 destroy .t 2224 toplevel .t -width 300 -height 200 -bd 2 -relief raised 2225 wm geom .t +0+0 2226 update 2227 set x [winfo rootx .t] 2228 set y [winfo rooty .t] 2229 frame .t.f -width 400 -height 30 -bd 2 -relief raised -bg green 2230 testmenubar window .t .t.f 2231 update 2232 testmenubar window .t {} 2233 update 2234 set result "[expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y]" 2235 .t.f configure -height 100 2236 update 2237 lappend result [expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y] 2238} {0 0 0 0} 2239test unixWm-55.4 {TkUnixSetMenubar procedure, toplevel not yet created} {unix testmenubar} { 2240 destroy .t 2241 toplevel .t -width 300 -height 200 -bd 2 -relief raised 2242 frame .t.f -width 400 -height 30 -bd 2 -relief raised -bg green 2243 testmenubar window .t .t.f 2244 wm geom .t +0+0 2245 update 2246 list [winfo ismapped .t.f] [winfo geometry .t.f] \ 2247 [expr [winfo rootx .t] - [winfo rootx .t.f]] \ 2248 [expr [winfo rooty .t] - [winfo rooty .t.f]] 2249} {1 300x30+0+0 0 30} 2250test unixWm-55.5 {TkUnixSetMenubar procedure, changing menubar} {unix testmenubar} { 2251 destroy .t 2252 destroy .f 2253 toplevel .t -width 300 -height 200 -bd 2 -relief raised 2254 frame .t.f -width 400 -height 30 -bd 2 -relief raised -bg green 2255 wm geom .t +0+0 2256 update 2257 set y [winfo rooty .t] 2258 frame .f -width 400 -height 50 -bd 2 -relief raised -bg green 2259 testmenubar window .t .t.f 2260 update 2261 set result {} 2262 lappend result [winfo ismapped .f] [winfo ismapped .t.f] 2263 lappend result [expr [winfo rooty .t.f] - $y] 2264 testmenubar window .t .f 2265 update 2266 lappend result [winfo ismapped .f] [winfo ismapped .t.f] 2267 lappend result [expr [winfo rooty .f] - $y] 2268} {0 1 0 1 0 0} 2269test unixWm-55.6 {TkUnixSetMenubar procedure, changing menubar to self} {unix testmenubar} { 2270 destroy .t 2271 toplevel .t -width 300 -height 200 -bd 2 -relief raised 2272 frame .t.f -width 400 -height 30 -bd 2 -relief raised -bg green 2273 testmenubar window .t .t.f 2274 wm geom .t +0+0 2275 update 2276 testmenubar window .t .t.f 2277 update 2278 list [winfo ismapped .t.f] [winfo geometry .t.f] \ 2279 [expr [winfo rootx .t] - [winfo rootx .t.f]] \ 2280 [expr [winfo rooty .t] - [winfo rooty .t.f]] 2281} {1 300x30+0+0 0 30} 2282test unixWm-55.7 {TkUnixSetMenubar procedure, unsetting event handler} {unix testmenubar} { 2283 destroy .t 2284 destroy .f 2285 toplevel .t -width 300 -height 200 -bd 2 -relief raised 2286 frame .t.f -width 400 -height 30 -bd 2 -relief raised -bg green 2287 frame .f -width 400 -height 40 -bd 2 -relief raised -bg blue 2288 wm geom .t +0+0 2289 update 2290 set y [winfo rooty .t] 2291 testmenubar window .t .t.f 2292 update 2293 set result [expr [winfo rooty .t] - $y] 2294 testmenubar window .t .f 2295 update 2296 lappend result [expr [winfo rooty .t] - $y] 2297 destroy .t.f 2298 update 2299 lappend result [expr [winfo rooty .t] - $y] 2300} {30 40 40} 2301 2302test unixWm-56.1 {MenubarDestroyProc procedure} {unix testmenubar} { 2303 destroy .t 2304 toplevel .t -width 300 -height 200 -bd 2 -relief raised 2305 wm geom .t +0+0 2306 update 2307 set y [winfo rooty .t] 2308 frame .t.f -width 400 -height 30 -bd 2 -relief raised -bg green 2309 testmenubar window .t .t.f 2310 update 2311 set result [expr [winfo rooty .t] - $y] 2312 destroy .t.f 2313 update 2314 lappend result [expr [winfo rooty .t] - $y] 2315} {30 0} 2316 2317test unixWm-57.1 {MenubarReqProc procedure} {unix testmenubar} { 2318 destroy .t 2319 toplevel .t -width 300 -height 200 -bd 2 -relief raised 2320 wm geom .t +0+0 2321 update 2322 set x [winfo rootx .t] 2323 set y [winfo rooty .t] 2324 frame .t.f -width 400 -height 10 -bd 2 -relief raised -bg green 2325 testmenubar window .t .t.f 2326 update 2327 set result "[expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y]" 2328 .t.f configure -height 100 2329 update 2330 lappend result [expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y] 2331} {0 10 0 100} 2332test unixWm-57.2 {MenubarReqProc procedure} {unix testmenubar} { 2333 destroy .t 2334 toplevel .t -width 300 -height 200 -bd 2 -relief raised 2335 wm geom .t +0+0 2336 update 2337 set x [winfo rootx .t] 2338 set y [winfo rooty .t] 2339 frame .t.f -width 400 -height 20 -bd 2 -relief raised -bg green 2340 testmenubar window .t .t.f 2341 update 2342 set result "[expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y]" 2343 .t.f configure -height 0 2344 update 2345 lappend result [expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y] 2346} {0 20 0 1} 2347 2348test unixWm-58.1 {UpdateCommand procedure, DString gets reallocated} {unix testwrapper} { 2349 destroy .t 2350 toplevel .t -width 100 -height 50 2351 wm geom .t +0+0 2352 wm command .t "argumentNumber0 argumentNumber1 argumentNumber2 argumentNumber0 argumentNumber3 argumentNumber4 argumentNumber5 argumentNumber6 argumentNumber0 argumentNumber7 argumentNumber8 argumentNumber9 argumentNumber10 argumentNumber0 argumentNumber11 argumentNumber12 argumentNumber13 argumentNumber14 argumentNumber15 argumentNumber16 argumentNumber17 argumentNumber18" 2353 update 2354 testprop [testwrapper .t] WM_COMMAND 2355} {argumentNumber0 2356argumentNumber1 2357argumentNumber2 2358argumentNumber0 2359argumentNumber3 2360argumentNumber4 2361argumentNumber5 2362argumentNumber6 2363argumentNumber0 2364argumentNumber7 2365argumentNumber8 2366argumentNumber9 2367argumentNumber10 2368argumentNumber0 2369argumentNumber11 2370argumentNumber12 2371argumentNumber13 2372argumentNumber14 2373argumentNumber15 2374argumentNumber16 2375argumentNumber17 2376argumentNumber18 2377} 2378 2379# Test exit processing and cleanup: 2380 2381test unixWm-59.1 {exit processing} unix { 2382 set script [makeFile { 2383 update 2384 exit 2385 } script] 2386 if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} { 2387 set error 1 2388 } else { 2389 set error 0 2390 } 2391 removeFile script 2392 list $error $msg 2393} {0 {}} 2394test unixWm-59.2 {exit processing} unix { 2395 set code [loadTkCommand] 2396 append code { 2397 interp create x 2398 x eval {set argc 2} 2399 x eval {set argv "-geometry 10x10+0+0"} 2400 x eval {load {} Tk} 2401 update 2402 exit 2403 } 2404 set script [makeFile $code script] 2405 if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} { 2406 set error 1 2407 } else { 2408 set error 0 2409 } 2410 removeFile script 2411 list $error $msg 2412} {0 {}} 2413test unixWm-59.3 {exit processing} unix { 2414 set code [loadTkCommand] 2415 append code { 2416 interp create x 2417 x eval {set argc 2} 2418 x eval {set argv "-geometry 10x10+0+0"} 2419 x eval {load {} Tk} 2420 x eval { 2421 button .b -text hello 2422 bind .b <Destroy> foo 2423 } 2424 x alias foo destroy_x 2425 proc destroy_x {} {interp delete x} 2426 update 2427 exit 2428 } 2429 set script [makeFile $code script] 2430 if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} { 2431 set error 1 2432 } else { 2433 set error 0 2434 } 2435 removeFile script 2436 list $error $msg 2437} {0 {}} 2438 2439# 2440# wm attributes tests: 2441# 2442# NOTE: since [wm attributes] is not guaranteed to have any effect, 2443# the only thing we can really test here is the syntax. 2444# 2445test unixWm-60.1 {wm attributes - test} -constraints unix -body { 2446 destroy .t 2447 toplevel .t 2448 wm attributes .t 2449} -result [list -alpha 1.0 -topmost 0 -zoomed 0 -fullscreen 0 -type {}] 2450 2451test unixWm-60.2 {wm attributes - test} -constraints unix -body { 2452 destroy .t 2453 toplevel .t 2454 wm attributes .t -topmost 2455} -result 0 2456 2457test unixWm-60.3 {wm attributes - set (unrealized)} -constraints unix -body { 2458 destroy .t 2459 toplevel .t 2460 wm attributes .t -topmost 1 2461} 2462 2463test unixWm-60.4 {wm attributes - set (realized)} -constraints unix -body { 2464 destroy .t 2465 toplevel .t 2466 tkwait visibility .t 2467 wm attributes .t -topmost 1 2468} 2469 2470test unixWm-60.5 {wm attributes - bad attribute} -constraints unix -body { 2471 destroy .t 2472 toplevel .t 2473 wm attributes .t -foo 2474} -returnCodes 1 -match glob -result {bad attribute "-foo":*} 2475 2476test unixWm-61.1 {Tk_WmCmd procedure, "iconphoto" option} unix { 2477 list [catch {wm iconph .} msg] $msg 2478} {1 {wrong # args: should be "wm iconphoto window ?-default? image1 ?image2 ...?"}} 2479test unixWm-61.2 {Tk_WmCmd procedure, "iconphoto" option} unix { 2480 destroy .t 2481 toplevel .t 2482 image create photo blank16 -width 16 -height 16 2483 image create photo blank32 -width 32 -height 32 2484 # This should just make blank icons for the window 2485 wm iconphoto .t blank16 blank32 2486 image delete blank16 blank32 2487} {} 2488 2489test unixWm-62.0 {wm attributes -type void} -constraints unix -setup { 2490 destroy .t 2491 toplevel .t 2492} -body { 2493 wm attributes .t -type {} 2494} -cleanup { 2495 destroy .t 2496} -result {} 2497 2498test unixWm-62.1 {wm attributes -type name} -constraints unix -setup { 2499 destroy .t 2500 toplevel .t 2501} -body { 2502 wm attributes .t -type dialog 2503} -cleanup { 2504 destroy .t 2505} -result {} 2506 2507test unixWm-62.2 {wm attributes -type name} -constraints unix -setup { 2508 destroy .t 2509 toplevel .t 2510} -body { 2511 tkwait visibility .t 2512 wm attributes .t -type dialog 2513} -cleanup { 2514 destroy .t 2515} -result {} 2516 2517test unixWm-62.3 {wm attributes -type list} -constraints unix -setup { 2518 destroy .t 2519 toplevel .t 2520} -body { 2521 wm attributes .t -type {xyzzy dialog} 2522} -cleanup { 2523 destroy .t 2524} -result {} 2525 2526test unixWm-62.4 {wm attributes -type list} -constraints unix -setup { 2527 destroy .t 2528 toplevel .t 2529} -body { 2530 tkwait visibility .t 2531 wm attributes .t -type {xyzzy dialog} 2532} -cleanup { 2533 destroy .t 2534} -result {} 2535 2536# cleanup 2537destroy .t 2538cleanupTests 2539return 2540