1# This file is a Tcl script to test out the "focus" command and the 2# other procedures in the file tkFocus.c. It is organized in the 3# standard fashion for Tcl tests. 4# 5# Copyright (c) 1994-1996 Sun Microsystems, Inc. 6# Copyright (c) 1998-1999 by Scriptics Corporation. 7# All rights reserved. 8# 9# RCS: @(#) $Id: focus.test,v 1.8 2002/07/14 05:48:46 dgp Exp $ 10 11package require tcltest 2.1 12namespace import -force tcltest::configure 13namespace import -force tcltest::testsDirectory 14configure -testdir [file join [pwd] [file dirname [info script]]] 15configure -loadfile [file join [testsDirectory] constraints.tcl] 16tcltest::loadTestedCommands 17 18button .b -text .b -relief raised -bd 2 19pack .b 20 21proc focusSetup {} { 22 catch {destroy .t} 23 toplevel .t 24 wm geom .t +0+0 25 foreach i {b1 b2 b3 b4} { 26 button .t.$i -text .t.$i -relief raised -bd 2 27 pack .t.$i 28 } 29 tkwait visibility .t.b4 30} 31proc focusSetupAlt {} { 32 global env 33 catch {destroy .alt} 34 toplevel .alt -screen $env(TK_ALT_DISPLAY) 35 foreach i {a b c d} { 36 button .alt.$i -text .alt.$i -relief raised -bd 2 37 pack .alt.$i 38 } 39 tkwait visibility .alt.d 40} 41 42# Make sure the window manager knows who has focus 43catch {fixfocus} 44 45# The following procedure ensures that there is no input focus 46# in this application. It does it by arranging for another 47# application to grab the focus. The "after" and "update" stuff 48# is needed to wait long enough for pending actions to get through 49# the X server and possibly also the window manager. 50 51setupbg 52proc focusClear {} { 53 global x; 54 after 200 {set x 1} 55 tkwait variable x 56 dobg {focus -force .; update} 57 update 58} 59 60focusSetup 61if {[testConstraint altDisplay]} { 62 focusSetupAlt 63} 64update 65 66bind all <FocusIn> { 67 append focusInfo "in %W %d\n" 68} 69bind all <FocusOut> { 70 append focusInfo "out %W %d\n" 71} 72bind all <KeyPress> { 73 append focusInfo "press %W %K" 74} 75 76test focus-1.1 {Tk_FocusCmd procedure} {unixOnly} { 77 focusClear 78 focus 79} {} 80test focus-1.2 {Tk_FocusCmd procedure} {unixOnly altDisplay} { 81 focus .alt.b 82 focus 83} {} 84test focus-1.3 {Tk_FocusCmd procedure} {unixOnly} { 85 focusClear 86 focus .t.b3 87 focus 88} {} 89test focus-1.4 {Tk_FocusCmd procedure} {unixOnly} { 90 list [catch {focus ""} msg] $msg 91} {0 {}} 92test focus-1.5 {Tk_FocusCmd procedure} {unixOnly} { 93 focusClear 94 focus -force .t 95 focus .t.b3 96 focus 97} {.t.b3} 98test focus-1.6 {Tk_FocusCmd procedure} {unixOnly} { 99 list [catch {focus .gorp} msg] $msg 100} {1 {bad window path name ".gorp"}} 101test focus-1.7 {Tk_FocusCmd procedure} {unixOnly} { 102 list [catch {focus .gorp a} msg] $msg 103} {1 {bad option ".gorp": must be -displayof, -force, or -lastfor}} 104test focus-1.8 {Tk_FocusCmd procedure, focussing on dead window} {unixOnly} { 105 toplevel .t2 106 wm geom .t2 +10+10 107 frame .t2.f -width 200 -height 100 -bd 2 -relief raised 108 frame .t2.f2 -width 200 -height 100 -bd 2 -relief raised 109 pack .t2.f .t2.f2 110 bind .t2.f <Destroy> {focus .t2.f} 111 bind .t2.f2 <Destroy> {focus .t2} 112 focus -force .t2.f2 113 tkwait visibility .t2.f2 114 update 115 set x [focus] 116 destroy .t2.f2 117 lappend x [focus] 118 destroy .t2.f 119 lappend x [focus] 120 destroy .t2 121 set x 122} {.t2.f2 .t2 .t2} 123test focus-1.9 {Tk_FocusCmd procedure, -displayof option} {unixOnly} { 124 list [catch {focus -displayof} msg] $msg 125} {1 {wrong # args: should be "focus -displayof window"}} 126test focus-1.10 {Tk_FocusCmd procedure, -displayof option} {unixOnly} { 127 list [catch {focus -displayof a b} msg] $msg 128} {1 {wrong # args: should be "focus -displayof window"}} 129test focus-1.11 {Tk_FocusCmd procedure, -displayof option} {unixOnly} { 130 list [catch {focus -displayof .lousy} msg] $msg 131} {1 {bad window path name ".lousy"}} 132test focus-1.12 {Tk_FocusCmd procedure, -displayof option} {unixOnly} { 133 focusClear 134 focus .t 135 focus -displayof .t.b3 136} {} 137test focus-1.13 {Tk_FocusCmd procedure, -displayof option} {unixOnly} { 138 focusClear 139 focus -force .t 140 focus -displayof .t.b3 141} {.t} 142test focus-1.14 {Tk_FocusCmd procedure, -displayof option} {unixOnly altDisplay} { 143 focus -force .alt.c 144 focus -displayof .alt 145} {.alt.c} 146test focus-1.15 {Tk_FocusCmd procedure, -force option} {unixOnly} { 147 list [catch {focus -force} msg] $msg 148} {1 {wrong # args: should be "focus -force window"}} 149test focus-1.16 {Tk_FocusCmd procedure, -force option} {unixOnly} { 150 list [catch {focus -force a b} msg] $msg 151} {1 {wrong # args: should be "focus -force window"}} 152test focus-1.17 {Tk_FocusCmd procedure, -force option} {unixOnly} { 153 list [catch {focus -force foo} msg] $msg 154} {1 {bad window path name "foo"}} 155test focus-1.18 {Tk_FocusCmd procedure, -force option} {unixOnly} { 156 list [catch {focus -force ""} msg] $msg 157} {0 {}} 158test focus-1.19 {Tk_FocusCmd procedure, -force option} {unixOnly} { 159 focusClear 160 focus .t.b1 161 set x [list [focus]] 162 focus -force .t.b1 163 lappend x [focus] 164} {{} .t.b1} 165test focus-1.20 {Tk_FocusCmd procedure, -lastfor option} {unixOnly} { 166 list [catch {focus -lastfor} msg] $msg 167} {1 {wrong # args: should be "focus -lastfor window"}} 168test focus-1.21 {Tk_FocusCmd procedure, -lastfor option} {unixOnly} { 169 list [catch {focus -lastfor 1 2} msg] $msg 170} {1 {wrong # args: should be "focus -lastfor window"}} 171test focus-1.22 {Tk_FocusCmd procedure, -lastfor option} {unixOnly} { 172 list [catch {focus -lastfor who_knows?} msg] $msg 173} {1 {bad window path name "who_knows?"}} 174test focus-1.23 {Tk_FocusCmd procedure, -lastfor option} {unixOnly} { 175 focus .b 176 focus .t.b1 177 list [focus -lastfor .] [focus -lastfor .t.b3] 178} {.b .t.b1} 179test focus-1.24 {Tk_FocusCmd procedure, -lastfor option} {unixOnly} { 180 destroy .t 181 focusSetup 182 update 183 focus -lastfor .t.b2 184} {.t} 185test focus-1.25 {Tk_FocusCmd procedure} {unixOnly} { 186 list [catch {focus -unknown} msg] $msg 187} {1 {bad option "-unknown": must be -displayof, -force, or -lastfor}} 188 189test focus-2.1 {TkFocusFilterEvent procedure} {unixOnly nonPortable testwrapper} { 190 focus -force .b 191 destroy .t 192 focusSetup 193 update 194 set focusInfo {} 195 event gen [testwrapper .t] <FocusIn> -detail NotifyAncestor \ 196 -sendevent 0x54217567 197 list $focusInfo 198} {{}} 199test focus-2.2 {TkFocusFilterEvent procedure} {unixOnly nonPortable testwrapper} { 200 focus -force .b 201 destroy .t 202 focusSetup 203 update 204 set focusInfo {} 205 event gen .t <FocusIn> -detail NotifyAncestor -sendevent 0x547321ac 206 list $focusInfo [focus] 207} {{in .t NotifyAncestor 208} .b} 209test focus-2.3 {TkFocusFilterEvent procedure} {unixOnly nonPortable testwrapper} { 210 focus -force .b 211 destroy .t 212 focusSetup 213 update 214 set focusInfo {} 215 event gen [testwrapper .t] <FocusIn> -detail NotifyAncestor 216 update 217 list $focusInfo [focus -lastfor .t] 218} {{out .b NotifyNonlinear 219out . NotifyNonlinearVirtual 220in .t NotifyNonlinear 221} .t} 222test focus-2.4 {TkFocusFilterEvent procedure, FocusIn events} \ 223 {unixOnly nonPortable testwrapper} { 224 set result {} 225 focus .t.b1 226 # Important to end with NotifyAncestor, which is an 227 # event that is processed normally. This has a side 228 # effect on text 2.5 229 foreach detail {NotifyAncestor NotifyNonlinear 230 NotifyNonlinearVirtual NotifyPointer NotifyPointerRoot 231 NotifyVirtual NotifyAncestor} { 232 focus -force . 233 update 234 event gen [testwrapper .t] <FocusIn> -detail $detail 235 set focusInfo {} 236 update 237 lappend result $focusInfo 238 } 239 set result 240} {{out . NotifyNonlinear 241in .t NotifyNonlinearVirtual 242in .t.b1 NotifyNonlinear 243} {out . NotifyNonlinear 244in .t NotifyNonlinearVirtual 245in .t.b1 NotifyNonlinear 246} {} {out . NotifyNonlinear 247in .t NotifyNonlinearVirtual 248in .t.b1 NotifyNonlinear 249} {} {} {out . NotifyNonlinear 250in .t NotifyNonlinearVirtual 251in .t.b1 NotifyNonlinear 252}} 253test focus-2.5 {TkFocusFilterEvent procedure, creating FocusInfo struct} \ 254 {unixOnly nonPortable testwrapper} { 255 focusSetup 256 focus .t.b1 257 update 258 event gen [testwrapper .t] <FocusIn> -detail NotifyAncestor 259 list $focusInfo [focus] 260} {{out . NotifyNonlinear 261in .t NotifyNonlinearVirtual 262in .t.b1 NotifyNonlinear 263} .t.b1} 264test focus-2.6 {TkFocusFilterEvent procedure, FocusIn events} \ 265 {unixOnly testwrapper} { 266 focus .t.b1 267 focus . 268 update 269 event gen [testwrapper .t] <FocusIn> -detail NotifyAncestor 270 set focusInfo {} 271 set x [focus] 272 event gen . <KeyPress-x> 273 list $x $focusInfo 274} {.t.b1 {press .t.b1 x}} 275test focus-2.7 {TkFocusFilterEvent procedure, FocusOut events} \ 276 {unixOnly testwrapper} { 277 set result {} 278 foreach detail {NotifyAncestor NotifyInferior NotifyNonlinear 279 NotifyNonlinearVirtual NotifyPointer NotifyPointerRoot 280 NotifyVirtual} { 281 focus -force .t.b1 282 event gen [testwrapper .t] <FocusOut> -detail $detail 283 update 284 lappend result [focus] 285 } 286 set result 287} {{} .t.b1 {} {} .t.b1 .t.b1 {}} 288test focus-2.8 {TkFocusFilterEvent procedure, FocusOut events} \ 289 {unixOnly testwrapper} { 290 focus -force .t.b1 291 event gen .t.b1 <FocusOut> -detail NotifyAncestor 292 focus 293} {.t.b1} 294test focus-2.9 {TkFocusFilterEvent procedure, FocusOut events} \ 295 {unixOnly testwrapper} { 296 focus .t.b1 297 event gen [testwrapper .] <FocusOut> -detail NotifyAncestor 298 focus 299} {} 300test focus-2.10 {TkFocusFilterEvent procedure, Enter events} \ 301 {unixOnly testwrapper} { 302 set result {} 303 focus .t.b1 304 focusClear 305 foreach detail {NotifyAncestor NotifyInferior NotifyNonlinear 306 NotifyNonlinearVirtual NotifyVirtual} { 307 event gen [testwrapper .t] <Enter> -detail $detail -focus 1 308 update 309 lappend result [focus] 310 event gen [testwrapper .t] <Leave> -detail NotifyAncestor 311 update 312 } 313 set result 314} {.t.b1 {} .t.b1 .t.b1 .t.b1} 315test focus-2.11 {TkFocusFilterEvent procedure, Enter events} \ 316 {unixOnly testwrapper} { 317 focusClear 318 set focusInfo {} 319 event gen [testwrapper .t] <Enter> -detail NotifyAncestor 320 update 321 set focusInfo 322} {} 323test focus-2.12 {TkFocusFilterEvent procedure, Enter events} \ 324 {unixOnly testwrapper} { 325 focus -force .b 326 update 327 set focusInfo {} 328 event gen [testwrapper .t] <Enter> -detail NotifyAncestor -focus 1 329 update 330 set focusInfo 331} {} 332test focus-2.13 {TkFocusFilterEvent procedure, Enter events} \ 333 {unixOnly testwrapper} { 334 focus .t.b1 335 focusClear 336 event gen [testwrapper .t] <Enter> -detail NotifyAncestor -focus 1 337 set focusInfo {} 338 update 339 set focusInfo 340} {in .t NotifyVirtual 341in .t.b1 NotifyAncestor 342} 343test focus-2.14 {TkFocusFilterEvent procedure, Enter events, ignore errors when setting focus due to implicit focus} {unixOnly testwrapper} { 344 focusClear 345 catch {destroy .t2} 346 toplevel .t2 347 wm withdraw .t2 348 update 349 set focusInfo {} 350 event gen [testwrapper .t2] <Enter> -detail NotifyAncestor -focus 1 351 update 352 destroy .t2 353} {} 354test focus-2.15 {TkFocusFilterEvent procedure, Leave events} \ 355 {unixOnly testwrapper} { 356 set result {} 357 focus .t.b1 358 foreach detail {NotifyAncestor NotifyInferior NotifyNonlinear 359 NotifyNonlinearVirtual NotifyVirtual} { 360 focusClear 361 event gen [testwrapper .t] <Enter> -detail NotifyAncestor -focus 1 362 update 363 event gen [testwrapper .t] <Leave> -detail $detail 364 update 365 lappend result [focus] 366 } 367 set result 368} {{} .t.b1 {} {} {}} 369test focus-2.16 {TkFocusFilterEvent procedure, Leave events} \ 370 {unixOnly testwrapper} { 371 set result {} 372 focus .t.b1 373 event gen [testwrapper .t] <Enter> -detail NotifyAncestor -focus 1 374 update 375 set focusInfo {} 376 event gen [testwrapper .t] <Leave> -detail NotifyAncestor 377 update 378 set focusInfo 379} {out .t.b1 NotifyAncestor 380out .t NotifyVirtual 381} 382test focus-2.17 {TkFocusFilterEvent procedure, Leave events} \ 383 {unixOnly testwrapper} { 384 set result {} 385 focus .t.b1 386 event gen [testwrapper .t] <Enter> -detail NotifyAncestor -focus 1 387 update 388 set focusInfo {} 389 event gen .t.b1 <Leave> -detail NotifyAncestor 390 event gen [testwrapper .] <Leave> -detail NotifyAncestor 391 update 392 list $focusInfo [focus] 393} {{out .t.b1 NotifyAncestor 394out .t NotifyVirtual 395} {}} 396 397test focus-3.1 {SetFocus procedure, create record on focus} \ 398 {unixOnly testwrapper} { 399 toplevel .t2 -width 250 -height 100 400 wm geometry .t2 +0+0 401 update 402 focus -force .t2 403 update 404 focus 405} {.t2} 406catch {destroy .t2} 407# This test produces no result, but it will generate a protocol 408# error if Tk forgets to make the window exist before focussing 409# on it. 410test focus-3.2 {SetFocus procedure, making window exist} \ 411 {unixOnly testwrapper} { 412 update 413 button .b2 -text "Another button" 414 focus .b2 415 update 416} {} 417catch {destroy .b2} 418update 419# The following test doesn't produce a check-able result, but if 420# there are bugs it may generate an X protocol error. 421test focus-3.3 {SetFocus procedure, delaying claim of X focus} \ 422 {unixOnly testwrapper} { 423 focusSetup 424 focus -force .t.b2 425 update 426} {} 427test focus-3.4 {SetFocus procedure, delaying claim of X focus} \ 428 {unixOnly testwrapper} { 429 focusSetup 430 wm withdraw .t 431 focus -force .t.b2 432 toplevel .t2 -width 250 -height 100 433 wm geometry .t2 +10+10 434 focus -force .t2 435 wm withdraw .t2 436 update 437 wm deiconify .t2 438 wm deiconify .t 439} {} 440catch {destroy .t2} 441test focus-3.5 {SetFocus procedure, generating events} \ 442 {unixOnly testwrapper} { 443 focusSetup 444 focusClear 445 set focusInfo {} 446 focus -force .t.b2 447 update 448 set focusInfo 449} {in .t NotifyVirtual 450in .t.b2 NotifyAncestor 451} 452test focus-3.6 {SetFocus procedure, generating events} \ 453 {unixOnly testwrapper} { 454 focusSetup 455 focus -force .b 456 update 457 set focusInfo {} 458 focus .t.b2 459 update 460 set focusInfo 461} {out .b NotifyNonlinear 462out . NotifyNonlinearVirtual 463in .t NotifyNonlinearVirtual 464in .t.b2 NotifyNonlinear 465} 466test focus-3.7 {SetFocus procedure, generating events} \ 467 {unixOnly nonPortable testwrapper} { 468 # Non-portable because some platforms generate extra events. 469 470 focusSetup 471 focusClear 472 set focusInfo {} 473 focus .t.b2 474 update 475 set focusInfo 476} {} 477 478test focus-4.1 {TkFocusDeadWindow procedure} {unixOnly testwrapper} { 479 focusSetup 480 update 481 focus -force .b 482 update 483 destroy .t 484 focus 485} {.b} 486test focus-4.2 {TkFocusDeadWindow procedure} {unixOnly testwrapper} { 487 focusSetup 488 update 489 focus -force .t.b2 490 focus .b 491 update 492 destroy .t.b2 493 update 494 focus 495} {.b} 496 497# Non-portable due to wm-specific redirection of input focus when 498# windows are deleted: 499 500test focus-4.3 {TkFocusDeadWindow procedure} {unixOnly nonPortable testwrapper} { 501 focusSetup 502 update 503 focus .t 504 update 505 destroy .t 506 update 507 focus 508} {} 509test focus-4.4 {TkFocusDeadWindow procedure} {unixOnly testwrapper} { 510 focusSetup 511 focus -force .t.b2 512 update 513 destroy .t.b2 514 focus 515} {.t} 516 517# I don't know how to test most of the remaining procedures of this file 518# explicitly; they've already been exercised by the preceding tests. 519 520setupbg 521test focus-5.1 {ChangeXFocus procedure, don't take focus unless have it} \ 522 {unixOnly testwrapper secureserver} { 523 focusSetup 524 focus -force .t 525 update 526 set result [focus] 527 send [dobg {tk appname}] {focus -force .; update} 528 lappend result [focus] 529 focus .t.b2 530 update 531 lappend result [focus] 532} {.t {} {}} 533 534catch {destroy .t} 535bind all <FocusIn> {} 536bind all <FocusOut> {} 537bind all <KeyPress> {} 538cleanupbg 539fixfocus 540 541test focus-6.1 {miscellaneous - embedded application in same process} \ 542 {unixOnly testwrapper} { 543 eval interp delete [interp slaves] 544 catch {destroy .t} 545 toplevel .t 546 wm geometry .t +0+0 547 frame .t.f1 -container 1 548 frame .t.f2 549 pack .t.f1 .t.f2 550 entry .t.f2.e1 -bg red 551 pack .t.f2.e1 552 bind all <FocusIn> {lappend x "focus in %W %d"} 553 bind all <FocusOut> {lappend x "focus out %W %d"} 554 interp create child 555 child eval "set argv {-use [winfo id .t.f1]}" 556 load {} Tk child 557 child eval { 558 entry .e1 -bg lightBlue 559 pack .e1 560 bind all <FocusIn> {lappend x "focus in %W %d"} 561 bind all <FocusOut> {lappend x "focus out %W %d"} 562 set x {} 563 } 564 565 # Claim the focus and wait long enough for it to really arrive. 566 567 focus -force .t.f2.e1 568 after 300 {set timer 1} 569 vwait timer 570 set x {} 571 lappend x [focus] [child eval focus] 572 573 # See if a "focus" command will move the focus to the embedded 574 # application. 575 576 child eval {focus .e1} 577 after 300 {set timer 1} 578 vwait timer 579 lappend x | 580 child eval {lappend x |} 581 582 # Bring the focus back to the main application. 583 584 focus .t.f2.e1 585 after 300 {set timer 1} 586 vwait timer 587 set result [list $x [child eval {set x}]] 588 interp delete child 589 set result 590} {{.t.f2.e1 {} {focus out .t.f2.e1 NotifyNonlinear} {focus out .t.f2 NotifyNonlinearVirtual} {focus in .t.f1 NotifyNonlinear} | {focus out .t.f1 NotifyNonlinear} {focus in .t.f2 NotifyNonlinearVirtual} {focus in .t.f2.e1 NotifyNonlinear}} {{focus in . NotifyVirtual} {focus in .e1 NotifyAncestor} | {focus out .e1 NotifyAncestor} {focus out . NotifyVirtual}}} 591test focus-6.2 {miscellaneous - embedded application in different process} \ 592 {unixOnly testwrapper} { 593 eval interp delete [interp slaves] 594 catch {destroy .t} 595 setupbg 596 toplevel .t 597 wm geometry .t +0+0 598 frame .t.f1 -container 1 599 frame .t.f2 600 pack .t.f1 .t.f2 601 entry .t.f2.e1 -bg red 602 pack .t.f2.e1 603 bind all <FocusIn> {lappend x "focus in %W %d"} 604 bind all <FocusOut> {lappend x "focus out %W %d"} 605 setupbg -use [winfo id .t.f1] 606 dobg { 607 entry .e1 -bg lightBlue 608 pack .e1 609 bind all <FocusIn> {lappend x "focus in %W %d"} 610 bind all <FocusOut> {lappend x "focus out %W %d"} 611 set x {} 612 } 613 614 # Claim the focus and wait long enough for it to really arrive. 615 616 focus -force .t.f2.e1 617 after 300 {set timer 1} 618 vwait timer 619 set x {} 620 lappend x [focus] [dobg focus] 621 622 # See if a "focus" command will move the focus to the embedded 623 # application. 624 625 dobg {focus .e1} 626 after 300 {set timer 1} 627 vwait timer 628 lappend x | 629 dobg {lappend x |} 630 631 # Bring the focus back to the main application. 632 633 focus .t.f2.e1 634 after 300 {set timer 1} 635 vwait timer 636 set result [list $x [dobg {set x}]] 637 cleanupbg 638 set result 639} {{.t.f2.e1 {} {focus out .t.f2.e1 NotifyNonlinear} {focus out .t.f2 NotifyNonlinearVirtual} {focus in .t.f1 NotifyNonlinear} | {focus out .t.f1 NotifyNonlinear} {focus in .t.f2 NotifyNonlinearVirtual} {focus in .t.f2.e1 NotifyNonlinear}} {{focus in . NotifyVirtual} {focus in .e1 NotifyAncestor} | {focus out .e1 NotifyAncestor} {focus out . NotifyVirtual}}} 640 641deleteWindows 642bind all <FocusIn> {} 643bind all <FocusOut> {} 644 645# cleanup 646::tcltest::cleanupTests 647return 648 649 650 651 652 653 654 655 656 657 658 659 660 661