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