diff options
Diffstat (limited to 'tk8.6/tests/focus.test')
| -rw-r--r-- | tk8.6/tests/focus.test | 739 |
1 files changed, 0 insertions, 739 deletions
diff --git a/tk8.6/tests/focus.test b/tk8.6/tests/focus.test deleted file mode 100644 index 45cf73b..0000000 --- a/tk8.6/tests/focus.test +++ /dev/null @@ -1,739 +0,0 @@ -# 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 |