diff options
Diffstat (limited to 'tk8.6/tests/focus.test')
| -rw-r--r-- | tk8.6/tests/focus.test | 739 |
1 files changed, 739 insertions, 0 deletions
diff --git a/tk8.6/tests/focus.test b/tk8.6/tests/focus.test new file mode 100644 index 0000000..45cf73b --- /dev/null +++ b/tk8.6/tests/focus.test @@ -0,0 +1,739 @@ +# This file is a Tcl script to test out the "focus" command and the +# other procedures in the file tkFocus.c. It is organized in the +# standard fashion for Tcl tests. +# +# Copyright (c) 1994-1996 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. + +package require tcltest 2.2 +eval tcltest::configure $argv +tcltest::loadTestedCommands +namespace import -force tcltest::test + +proc focusSetup {} { + destroy .t + toplevel .t + wm geom .t +0+0 + foreach i {b1 b2 b3 b4} { + button .t.$i -text .t.$i -relief raised -bd 2 + pack .t.$i + } + tkwait visibility .t.b4 +} +proc focusSetupAlt {} { + global env + destroy .alt + toplevel .alt -screen $env(TK_ALT_DISPLAY) + foreach i {a b c d} { + button .alt.$i -text .alt.$i -relief raised -bd 2 + pack .alt.$i + } + tkwait visibility .alt.d +} + + +# The following procedure ensures that there is no input focus +# in this application. It does it by arranging for another +# application to grab the focus. The "after" and "update" stuff +# is needed to wait long enough for pending actions to get through +# the X server and possibly also the window manager. + +proc focusClear {} { + global x; + after 200 {set x 1} + tkwait variable x + dobg {focus -force .; update} + update +} + + +# Button used in some tests in the whole test file +button .b -text .b -relief raised -bd 2 +pack .b + +# Make sure the window manager knows who has focus +catch {fixfocus} + +# cleanupbg will be after 4.3 test +setupbg +update +bind all <FocusIn> { + append focusInfo "in %W %d\n" +} +bind all <FocusOut> { + append focusInfo "out %W %d\n" +} +bind all <KeyPress> { + append focusInfo "press %W %K" +} +focusSetup +if {[testConstraint altDisplay]} { + focusSetupAlt +} + + +test focus-1.1 {Tk_FocusCmd procedure} -constraints unix -body { + focusClear + focus +} -result {} +test focus-1.2 {Tk_FocusCmd procedure} -constraints { + unix altDisplay +} -body { + focus .alt.b + focus +} -result {} +test focus-1.3 {Tk_FocusCmd procedure} -constraints unix -body { + focusClear + focus .t.b3 + focus +} -result {} +test focus-1.4 {Tk_FocusCmd procedure} -constraints unix -body { + focus "" +} -returnCodes ok -result {} +test focus-1.5 {Tk_FocusCmd procedure} -constraints unix -body { + focusClear + focus -force .t + focus .t.b3 + focus +} -result {.t.b3} +test focus-1.6 {Tk_FocusCmd procedure} -constraints unix -body { + focus .gorp +} -returnCodes error -result {bad window path name ".gorp"} +test focus-1.7 {Tk_FocusCmd procedure} -constraints unix -body { + focus .gorp a +} -returnCodes error -result {bad option ".gorp": must be -displayof, -force, or -lastfor} +test focus-1.8 {Tk_FocusCmd procedure, focussing on dead window} -constraints { + unix +} -setup { + destroy .t2 +} -body { + focusClear + toplevel .t2 + wm geom .t2 +10+10 + frame .t2.f -width 200 -height 100 -bd 2 -relief raised + frame .t2.f2 -width 200 -height 100 -bd 2 -relief raised + pack .t2.f .t2.f2 + bind .t2.f <Destroy> {focus .t2.f} + bind .t2.f2 <Destroy> {focus .t2} + focus -force .t2.f2 + tkwait visibility .t2.f2 + update + set x [focus] + destroy .t2.f2 + lappend x [focus] + destroy .t2.f + lappend x [focus] + destroy .t2 + return $x +} -cleanup { + destroy .t2 +} -result {.t2.f2 .t2 .t2} +test focus-1.9 {Tk_FocusCmd procedure, -displayof option} -constraints { + unix +} -body { + focus -displayof +} -returnCodes error -result {wrong # args: should be "focus -displayof window"} +test focus-1.10 {Tk_FocusCmd procedure, -displayof option} -constraints { + unix +} -body { + focus -displayof a b +} -returnCodes error -result {wrong # args: should be "focus -displayof window"} +test focus-1.11 {Tk_FocusCmd procedure, -displayof option} -constraints { + unix +} -body { + focus -displayof .lousy +} -returnCodes error -result {bad window path name ".lousy"} +test focus-1.12 {Tk_FocusCmd procedure, -displayof option} -constraints { + unix +} -body { + focusClear + focus .t + focus -displayof .t.b3 +} -result {} +test focus-1.13 {Tk_FocusCmd procedure, -displayof option} -constraints { + unix +} -body { + focusClear + focus -force .t + focus -displayof .t.b3 +} -result {.t} +test focus-1.14 {Tk_FocusCmd procedure, -displayof option} -constraints { + unix altDisplay +} -body { + focusClear + focus -force .alt.c + focus -displayof .alt +} -result {.alt.c} +test focus-1.15 {Tk_FocusCmd procedure, -force option} -constraints unix -body { + focus -force +} -returnCodes error -result {wrong # args: should be "focus -force window"} +test focus-1.16 {Tk_FocusCmd procedure, -force option} -constraints unix -body { + focus -force a b +} -returnCodes error -result {wrong # args: should be "focus -force window"} +test focus-1.17 {Tk_FocusCmd procedure, -force option} -constraints unix -body { + focus -force foo +} -returnCodes error -result {bad window path name "foo"} +test focus-1.18 {Tk_FocusCmd procedure, -force option} -constraints unix -body { + focus -force "" +} -returnCodes ok -result {} +test focus-1.19 {Tk_FocusCmd procedure, -force option} -constraints unix -body { + focusClear + focus .t.b1 + set x [list [focus]] + focus -force .t.b1 + lappend x [focus] +} -result {{} .t.b1} +test focus-1.20 {Tk_FocusCmd procedure, -lastfor option} -constraints { + unix +} -body { + focus -lastfor +} -returnCodes error -result {wrong # args: should be "focus -lastfor window"} +test focus-1.21 {Tk_FocusCmd procedure, -lastfor option} -constraints { + unix +} -body { + focus -lastfor 1 2 +} -returnCodes error -result {wrong # args: should be "focus -lastfor window"} +test focus-1.22 {Tk_FocusCmd procedure, -lastfor option} -constraints { + unix +} -body { + focus -lastfor who_knows? +} -returnCodes error -result {bad window path name "who_knows?"} +test focus-1.23 {Tk_FocusCmd procedure, -lastfor option} -constraints { + unix +} -body { + focusClear + focusSetup + focus .b + focus .t.b1 + list [focus -lastfor .] [focus -lastfor .t.b3] +} -result {.b .t.b1} +test focus-1.24 {Tk_FocusCmd procedure, -lastfor option} -constraints { + unix +} -body { + focusClear + focusSetup + update + focus -lastfor .t.b2 +} -result {.t} +test focus-1.25 {Tk_FocusCmd procedure} -constraints unix -body { + focus -unknown +} -returnCodes error -result {bad option "-unknown": must be -displayof, -force, or -lastfor} + + +focusSetup +test focus-2.1 {TkFocusFilterEvent procedure} -constraints { + unix nonPortable testwrapper +} -body { + focusClear + focus -force .b + focusSetup + update + set focusInfo {} + event gen [testwrapper .t] <FocusIn> -detail NotifyAncestor \ + -sendevent 0x54217567 + return $focusInfo +} -result {} +test focus-2.2 {TkFocusFilterEvent procedure} -constraints { + unix nonPortable testwrapper +} -body { + focusClear + focus -force .b + focusSetup + update + set focusInfo {} + event gen .t <FocusIn> -detail NotifyAncestor -sendevent 0x547321ac + list $focusInfo [focus] +} -result {{in .t NotifyAncestor +} .b} +test focus-2.3 {TkFocusFilterEvent procedure} -constraints { + unix nonPortable testwrapper +} -body { + focusClear + focus -force .b + focusSetup + update + set focusInfo {} + event gen [testwrapper .t] <FocusIn> -detail NotifyAncestor + update + list $focusInfo [focus -lastfor .t] +} -result {{out .b NotifyNonlinear +out . NotifyNonlinearVirtual +in .t NotifyNonlinear +} .t} +test focus-2.4 {TkFocusFilterEvent procedure, FocusIn events} -constraints { + unix nonPortable testwrapper +} -body { + focusClear + set result {} + focus .t.b1 + # Important to end with NotifyAncestor, which is an + # event that is processed normally. This has a side + # effect on text 2.5 + foreach detail {NotifyAncestor NotifyNonlinear + NotifyNonlinearVirtual NotifyPointer NotifyPointerRoot + NotifyVirtual NotifyAncestor} { + focus -force . + update + event gen [testwrapper .t] <FocusIn> -detail $detail + set focusInfo {} + update + lappend result $focusInfo + } + return $result +} -result {{out . NotifyNonlinear +in .t NotifyNonlinearVirtual +in .t.b1 NotifyNonlinear +} {out . NotifyNonlinear +in .t NotifyNonlinearVirtual +in .t.b1 NotifyNonlinear +} {} {out . NotifyNonlinear +in .t NotifyNonlinearVirtual +in .t.b1 NotifyNonlinear +} {} {} {out . NotifyNonlinear +in .t NotifyNonlinearVirtual +in .t.b1 NotifyNonlinear +}} +test focus-2.5 {TkFocusFilterEvent procedure, creating FocusInfo struct} -constraints { + unix nonPortable testwrapper +} -body { + focusSetup + focus .t.b1 + update + event gen [testwrapper .t] <FocusIn> -detail NotifyAncestor + list $focusInfo [focus] +} -result {{out . NotifyNonlinear +in .t NotifyNonlinearVirtual +in .t.b1 NotifyNonlinear +} .t.b1} + +test focus-2.6 {TkFocusFilterEvent procedure, FocusIn events} -constraints { + unix testwrapper +} -body { + focus .t.b1 + focus . + update + event gen [testwrapper .t] <FocusIn> -detail NotifyAncestor + set focusInfo {} + set x [focus] + event gen . <KeyPress-x> + list $x $focusInfo +} -result {.t.b1 {press .t.b1 x}} +test focus-2.7 {TkFocusFilterEvent procedure, FocusOut events} -constraints { + unix testwrapper +} -body { + set result {} + foreach detail {NotifyAncestor NotifyInferior NotifyNonlinear + NotifyNonlinearVirtual NotifyPointer NotifyPointerRoot + NotifyVirtual} { + focus -force .t.b1 + event gen [testwrapper .t] <FocusOut> -detail $detail + update + lappend result [focus] + } + return $result +} -result {{} .t.b1 {} {} .t.b1 .t.b1 {}} +test focus-2.8 {TkFocusFilterEvent procedure, FocusOut events} -constraints { + unix testwrapper +} -body { + focus -force .t.b1 + event gen .t.b1 <FocusOut> -detail NotifyAncestor + focus +} -result {.t.b1} +test focus-2.9 {TkFocusFilterEvent procedure, FocusOut events} -constraints { + unix testwrapper +} -body { + focus .t.b1 + event gen [testwrapper .] <FocusOut> -detail NotifyAncestor + focus +} -result {} +test focus-2.10 {TkFocusFilterEvent procedure, Enter events} -constraints { + unix testwrapper +} -body { + set result {} + focus .t.b1 + focusClear + foreach detail {NotifyAncestor NotifyInferior NotifyNonlinear + NotifyNonlinearVirtual NotifyVirtual} { + event gen [testwrapper .t] <Enter> -detail $detail -focus 1 + update + lappend result [focus] + event gen [testwrapper .t] <Leave> -detail NotifyAncestor + update + } + return $result +} -result {.t.b1 {} .t.b1 .t.b1 .t.b1} +test focus-2.11 {TkFocusFilterEvent procedure, Enter events} -constraints { + unix testwrapper +} -body { + focusClear + set focusInfo {} + event gen [testwrapper .t] <Enter> -detail NotifyAncestor + update + return $focusInfo +} -result {} +test focus-2.12 {TkFocusFilterEvent procedure, Enter events} -constraints { + unix testwrapper +} -body { + focus -force .b + update + set focusInfo {} + event gen [testwrapper .t] <Enter> -detail NotifyAncestor -focus 1 + update + return $focusInfo +} -result {} +test focus-2.13 {TkFocusFilterEvent procedure, Enter events} -constraints { + unix testwrapper +} -body { + focus .t.b1 + focusClear + event gen [testwrapper .t] <Enter> -detail NotifyAncestor -focus 1 + set focusInfo {} + update + return $focusInfo +} -result {in .t NotifyVirtual +in .t.b1 NotifyAncestor +} +test focus-2.14 {TkFocusFilterEvent procedure, Enter events, ignore errors when setting focus due to implicit focus} -constraints { + unix testwrapper +} -setup { + destroy .t2 + set focusInfo {} +} -body { + focusClear + toplevel .t2 + wm withdraw .t2 + update + event gen [testwrapper .t2] <Enter> -detail NotifyAncestor -focus 1 + update +} -cleanup { + destroy .t2 +} -result {} +test focus-2.15 {TkFocusFilterEvent procedure, Leave events} -constraints { + unix testwrapper +} -body { + set result {} + focus .t.b1 + foreach detail {NotifyAncestor NotifyInferior NotifyNonlinear + NotifyNonlinearVirtual NotifyVirtual} { + focusClear + event gen [testwrapper .t] <Enter> -detail NotifyAncestor -focus 1 + update + event gen [testwrapper .t] <Leave> -detail $detail + update + lappend result [focus] + } + return $result +} -result {{} .t.b1 {} {} {}} +test focus-2.16 {TkFocusFilterEvent procedure, Leave events} -constraints { + unix testwrapper +} -body { + focusClear + focus .t.b1 + event gen [testwrapper .t] <Enter> -detail NotifyAncestor -focus 1 + update + set focusInfo {} + event gen [testwrapper .t] <Leave> -detail NotifyAncestor + update + return $focusInfo +} -result {out .t.b1 NotifyAncestor +out .t NotifyVirtual +} +test focus-2.17 {TkFocusFilterEvent procedure, Leave events} -constraints { + unix testwrapper +} -body { + focusClear + focus .t.b1 + event gen [testwrapper .t] <Enter> -detail NotifyAncestor -focus 1 + update + set focusInfo {} + event gen .t.b1 <Leave> -detail NotifyAncestor + event gen [testwrapper .] <Leave> -detail NotifyAncestor + update + list $focusInfo [focus] +} -result {{out .t.b1 NotifyAncestor +out .t NotifyVirtual +} {}} + + +test focus-3.1 {SetFocus procedure, create record on focus} -constraints { + unix testwrapper +} -body { + toplevel .t2 -width 250 -height 100 + wm geometry .t2 +0+0 + update + focus -force .t2 + update + focus +} -cleanup { + destroy .t2 +} -result {.t2} +# This test produces no result, but it will generate a protocol +# error if Tk forgets to make the window exist before focussing +# on it. +test focus-3.2 {SetFocus procedure, making window exist} -constraints { + unix testwrapper +} -body { + update + button .b2 -text "Another button" + focus .b2 + update +} -cleanup { + destroy .b2 + update +} -result {} +# The following test doesn't produce a check-able result, but if +# there are bugs it may generate an X protocol error. +test focus-3.3 {SetFocus procedure, delaying claim of X focus} -constraints { + unix testwrapper +} -body { + focusSetup + focus -force .t.b2 + update +} -result {} +test focus-3.4 {SetFocus procedure, delaying claim of X focus} -constraints { + unix testwrapper +} -body { + focusSetup + wm withdraw .t + focus -force .t.b2 + toplevel .t2 -width 250 -height 100 + wm geometry .t2 +10+10 + focus -force .t2 + wm withdraw .t2 + update + wm deiconify .t2 + wm deiconify .t +} -cleanup { + destroy .t2 +} -result {} +test focus-3.5 {SetFocus procedure, generating events} -constraints { + unix testwrapper +} -body { + focusSetup + focusClear + set focusInfo {} + focus -force .t.b2 + update + return $focusInfo +} -result {in .t NotifyVirtual +in .t.b2 NotifyAncestor +} +test focus-3.6 {SetFocus procedure, generating events} -constraints { + unix testwrapper +} -body { + focusSetup + focus -force .b + update + set focusInfo {} + focus .t.b2 + update + return $focusInfo +} -result {out .b NotifyNonlinear +out . NotifyNonlinearVirtual +in .t NotifyNonlinearVirtual +in .t.b2 NotifyNonlinear +} +test focus-3.7 {SetFocus procedure, generating events} -constraints { +unix nonPortable testwrapper +} -body { + # Non-portable because some platforms generate extra events. + focusSetup + focusClear + set focusInfo {} + focus .t.b2 + update + return $focusInfo +} -result {} + + +test focus-4.1 {TkFocusDeadWindow procedure} -constraints { + unix testwrapper +} -body { + focusSetup + update + focus -force .b + update + destroy .t + focus +} -result {.b} +test focus-4.2 {TkFocusDeadWindow procedure} -constraints { + unix testwrapper +} -body { + focusSetup + update + focus -force .t.b2 + focus .b + update + destroy .t.b2 + update + focus +} -result {.b} +# Non-portable due to wm-specific redirection of input focus when +# windows are deleted: +test focus-4.3 {TkFocusDeadWindow procedure} -constraints { + unix nonPortable testwrapper +} -body { + focusSetup + update + focus .t + update + destroy .t + update + focus +} -result {} +test focus-4.4 {TkFocusDeadWindow procedure} -constraints { + unix testwrapper +} -body { + focusSetup + focus -force .t.b2 + update + destroy .t.b2 + focus +} -result {.t} +cleanupbg + + +# I don't know how to test most of the remaining procedures of this file +# explicitly; they've already been exercised by the preceding tests. + +# Test 5.1 fails (before and after update) +test focus-5.1 {ChangeXFocus procedure, don't take focus unless have it} -constraints { + unix testwrapper secureserver +} -body { + setupbg + focusSetup + focus -force .t + update + set result [focus] + send [dobg {tk appname}] {focus -force .; update} + lappend result [focus] + focus .t.b2 + update + lappend result [focus] +} -cleanup { + cleanupbg +} -result {.t {} {}} +destroy .t +bind all <FocusIn> {} +bind all <FocusOut> {} +bind all <KeyPress> {} + + +fixfocus +test focus-6.1 {miscellaneous - embedded application in same process} -constraints { + unix testwrapper +} -setup { + eval interp delete [interp slaves] +} -body { + toplevel .t + wm geometry .t +0+0 + frame .t.f1 -container 1 + frame .t.f2 + pack .t.f1 .t.f2 + entry .t.f2.e1 -bg red + pack .t.f2.e1 + bind all <FocusIn> {lappend x "focus in %W %d"} + bind all <FocusOut> {lappend x "focus out %W %d"} + interp create child + child eval "set argv {-use [winfo id .t.f1]}" + load {} Tk child + child eval { + entry .e1 -bg lightBlue + pack .e1 + bind all <FocusIn> {lappend x "focus in %W %d"} + bind all <FocusOut> {lappend x "focus out %W %d"} + set x {} + } + + # Claim the focus and wait long enough for it to really arrive. + + focus -force .t.f2.e1 + after 300 {set timer 1} + vwait timer + set x {} + lappend x [focus] [child eval focus] + + # See if a "focus" command will move the focus to the embedded + # application. + + child eval {focus .e1} + after 300 {set timer 1} + vwait timer + lappend x | + child eval {lappend x |} + + # Bring the focus back to the main application. + + focus .t.f2.e1 + after 300 {set timer 1} + vwait timer + set result [list $x [child eval {set x}]] + return $result +} -cleanup { + interp delete child + destroy .t + bind all <FocusIn> {} + bind all <FocusOut> {} +} -result {{.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}}} + +test focus-6.2 {miscellaneous - embedded application in different process} -constraints { + unix testwrapper +} -body { + setupbg + toplevel .t + wm geometry .t +0+0 + frame .t.f1 -container 1 + frame .t.f2 + pack .t.f1 .t.f2 + entry .t.f2.e1 -bg red + pack .t.f2.e1 + bind all <FocusIn> {lappend x "focus in %W %d"} + bind all <FocusOut> {lappend x "focus out %W %d"} + setupbg -use [winfo id .t.f1] + dobg { + entry .e1 -bg lightBlue + pack .e1 + bind all <FocusIn> {lappend x "focus in %W %d"} + bind all <FocusOut> {lappend x "focus out %W %d"} + set x {} + } + + # Claim the focus and wait long enough for it to really arrive. + + focus -force .t.f2.e1 + after 300 {set timer 1} + vwait timer + set x {} + lappend x [focus] [dobg focus] + + # See if a "focus" command will move the focus to the embedded + # application. + + dobg {focus .e1} + after 300 {set timer 1} + vwait timer + lappend x | + dobg {lappend x |} + + # Bring the focus back to the main application. + + focus .t.f2.e1 + after 300 {set timer 1} + vwait timer + set result [list $x [dobg {set x}]] + return $result +} -cleanup { + destroy .t + cleanupbg + bind all <FocusIn> {} + bind all <FocusOut> {} +} -result {{.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}}} + + + +deleteWindows + +# cleanup +cleanupTests +return |