diff options
author | mdejong <mdejong> | 2002-12-02 03:42:28 (GMT) |
---|---|---|
committer | mdejong <mdejong> | 2002-12-02 03:42:28 (GMT) |
commit | 2be80c2ee9e0835f69dbc4773498a020c025bd0c (patch) | |
tree | f102cbf497a352cff63f95898ecdff2e31b20815 /tests/event.test | |
parent | 86e45159acabbaf667b4c297ae2a07745369e792 (diff) | |
download | tk-2be80c2ee9e0835f69dbc4773498a020c025bd0c.zip tk-2be80c2ee9e0835f69dbc4773498a020c025bd0c.tar.gz tk-2be80c2ee9e0835f69dbc4773498a020c025bd0c.tar.bz2 |
* tests/event.test (_keypress, _text_ind_to_x_y):
Force focus to widget in _keypress method to
avoid problems with window managers that
use focus follows mouse. [Bug 526209]
Diffstat (limited to 'tests/event.test')
-rw-r--r-- | tests/event.test | 30 |
1 files changed, 17 insertions, 13 deletions
diff --git a/tests/event.test b/tests/event.test index 92a4396..e989f02 100644 --- a/tests/event.test +++ b/tests/event.test @@ -6,7 +6,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: event.test,v 1.11 2002/07/14 18:31:48 dgp Exp $ +# RCS: @(#) $Id: event.test,v 1.12 2002/12/02 03:42:28 mdejong Exp $ package require tcltest 2.1 namespace import -force tcltest::configure @@ -117,8 +117,19 @@ proc _keypress_lookup { char } { proc _keypress { win key } { set keysym [_keypress_lookup $key] + # Force focus to the window before delivering + # each event so that a window manager using + # a focus follows mouse will not steal away + # the focus if the mouse is moved around. + + if {[focus] != $win} { + focus -force $win + } event generate $win <KeyPress-$keysym> _pause 50 + if {[focus] != $win} { + focus -force $win + } event generate $win <KeyRelease-$keysym> _pause 50 } @@ -151,7 +162,11 @@ proc _pause { {msecs 1000} } { # Helper proc to convert index to x y position proc _text_ind_to_x_y { text ind } { - foreach {x1 y1 width height} [$text bbox $ind] break + set bbox [$text bbox $ind] + if {[llength $bbox] != 4} { + error "got bbox \{$bbox\} from $text, index $ind" + } + foreach {x1 y1 width height} $bbox break set middle_y [expr {$y1 + ($height / 2)}] return [list $x1 $middle_y] } @@ -210,7 +225,6 @@ test event-keypress-1.1 { type into entry widget and hit Return } { set return_binding 0 bind $e <Return> {set return_binding 1} tkwait visibility $e - focus -force $e _keypress_string $e HELLO\n list [$e get] $return_binding } {HELLO 1} @@ -222,7 +236,6 @@ test event-keypress-1.2 { type into entry widget and then delete some text } { set e [entry $t.e] pack $e tkwait visibility $e - focus -force $e _keypress_string $e MELLO _keypress $e BackSpace _keypress $e BackSpace @@ -236,7 +249,6 @@ test event-keypress-1.3 { type into entry widget, triple click, set e [entry $t.e] pack $e tkwait visibility $e - focus -force $e _keypress_string $e JUMP set result [$e get] @@ -263,7 +275,6 @@ test event-keypress-1.4 { type into text widget and hit Return } { set return_binding 0 bind $e <Return> {set return_binding 1} tkwait visibility $e - focus -force $e _keypress_string $e HELLO\n list [$e get 1.0 end] $return_binding } [list "HELLO\n\n" 1] @@ -274,7 +285,6 @@ test event-keypress-1.5 { type into text widget and then delete some text } { set e [text $t.e] pack $e tkwait visibility $e - focus -force $e _keypress_string $e MELLO _keypress $e BackSpace _keypress $e BackSpace @@ -288,7 +298,6 @@ test event-keypress-1.6 { type into text widget, triple click, set e [text $t.e] pack $e tkwait visibility $e - focus -force $e _keypress_string $e JUMP set result [$e get 1.0 1.end] @@ -315,7 +324,6 @@ test event-click-drag-1.1 { click and drag in a text widget, this set e [text $t.e] pack $e tkwait visibility $e - focus -force $e _keypress_string $e "A Tcl/Tk selection test!" set anchor 1.6 set selend 1.18 @@ -384,7 +392,6 @@ test event-click-drag-1.2 { click and drag in an entry widget, this set e [entry $t.e] pack $e tkwait visibility $e - focus -force $e _keypress_string $e "A Tcl/Tk selection!" set anchor 6 set selend 18 @@ -452,7 +459,6 @@ test event-double-click-drag-1.1 { click down, click up, click down again, set e [text $t.e] pack $e tkwait visibility $e - focus -force $e _keypress_string $e "Word select test" set anchor 1.8 @@ -523,7 +529,6 @@ test event-double-click-drag-1.2 { click down, click up, click down again, set e [entry $t.e] pack $e tkwait visibility $e - focus -force $e _keypress_string $e "Word select test" set anchor 8 @@ -593,7 +598,6 @@ test event-triple-click-drag-1.1 { Triple click and drag across lines in set e [text $t.e] pack $e tkwait visibility $e - focus -force $e _keypress_string $e "LINE ONE\nLINE TWO\nLINE THREE" set anchor 3.2 |