diff --git a/tests/event.test b/tests/event.test index 015720e2d..147eb326f 100644 --- a/tests/event.test +++ b/tests/event.test @@ -3,7 +3,7 @@ # # Copyright (c) 1994 The Regents of the University of California. # Copyright (c) 1994-1995 Sun Microsystems, Inc. -# Copyright (c) 1998-1999 by Scriptics Corporation. +# Copyright (c) 1998-1999 Scriptics Corporation. # All rights reserved. package require tcltest 2.2 @@ -24,53 +24,53 @@ proc _init_keypress_lookup {} { scan Z %c finish for {set i $start} {$i <= $finish} {incr i} { - set l [format %c $i] - set keypress_lookup($l) $l + set l [format %c $i] + set keypress_lookup($l) $l } scan a %c start scan z %c finish for {set i $start} {$i <= $finish} {incr i} { - set l [format %c $i] - set keypress_lookup($l) $l + set l [format %c $i] + set keypress_lookup($l) $l } scan 0 %c start scan 9 %c finish for {set i $start} {$i <= $finish} {incr i} { - set l [format %c $i] - set keypress_lookup($l) $l + set l [format %c $i] + set keypress_lookup($l) $l } # Most punctuation array set keypress_lookup { - ! exclam - % percent - & ampersand - ( parenleft - ) parenright - * asterisk - + plus - , comma - - minus - . period - / slash - : colon - < less - = equal - > greater - ? question - @ at - ^ asciicircum - _ underscore - | bar - ~ asciitilde - ' apostrophe + ! exclam + % percent + & ampersand + ( parenleft + ) parenright + * asterisk + + plus + , comma + . period + / slash + : colon + < less + = equal + ? question + @ at + ^ asciicircum + _ underscore + | bar + ~ asciitilde + ' apostrophe } # Characters with meaning to Tcl... array set keypress_lookup [list \ + - minus \ + > greater \ \" quotedbl \ \# numbersign \ \$ dollar \ @@ -81,6 +81,7 @@ proc _init_keypress_lookup {} { \{ braceleft \ \} braceright \ " " space \ + \xA0 nobreakspace \ "\n" Return \ "\t" Tab] } @@ -88,8 +89,8 @@ proc _init_keypress_lookup {} { # Lookup an event in the keypress table. # For example: # Q -> Q -# . -> period -# / -> slash +# ; -> semicolon +# > -> greater # Delete -> Delete # Escape -> Escape @@ -97,21 +98,21 @@ proc _keypress_lookup {char} { global keypress_lookup if {! [info exists keypress_lookup]} { - _init_keypress_lookup + _init_keypress_lookup } if {$char == ""} { - error "empty char" + error "empty char" } if {[info exists keypress_lookup($char)]} { - return $keypress_lookup($char) + return $keypress_lookup($char) } else { - return $char + return $char } } -# Lookup and generate a pair of KeyPress and KeyRelease events +# Lookup and generate a pair of Key and KeyRelease events proc _keypress {win key} { set keysym [_keypress_lookup $key] @@ -122,12 +123,12 @@ proc _keypress {win key} { # the focus if the mouse is moved around. if {[focus] != $win} { - focus -force $win + focus -force $win } - event generate $win + event generate $win _pause 50 if {[focus] != $win} { - focus -force $win + focus -force $win } event generate $win _pause 50 @@ -137,7 +138,7 @@ proc _keypress {win key} { proc _keypress_string {win string} { foreach letter [split $string ""] { - _keypress $win $letter + _keypress $win $letter } } @@ -147,7 +148,7 @@ proc _pause {{msecs 1000}} { global _pause if {! [info exists _pause(number)]} { - set _pause(number) 0 + set _pause(number) 0 } set num [incr _pause(number)] @@ -163,7 +164,7 @@ proc _pause {{msecs 1000}} { proc _text_ind_to_x_y {text ind} { set bbox [$text bbox $ind] if {[llength $bbox] != 4} { - error "got bbox \{$bbox\} from $text, index $ind" + error "got bbox \{$bbox\} from $text, index $ind" } foreach {x1 y1 width height} $bbox break set middle_y [expr {$y1 + ($height / 2)}] @@ -174,10 +175,10 @@ proc _text_ind_to_x_y {text ind} { proc _get_selection {widget} { if {[string compare $widget [selection own]] != 0} { - return "" + return "" } if {[catch {selection get} sel]} { - return "" + return "" } return $sel } @@ -194,10 +195,10 @@ test event-1.1 {Tk_HandleEvent procedure, filter events for dead windows} -setup update bind .b { lappend x destroy - event generate .b <1> + event generate .b event generate .b } - bind .b <1> { + bind .b { lappend x button } @@ -255,7 +256,7 @@ test event-2.2(keypress) {type into entry widget and then delete some text} -set deleteWindows } -result {MEL} test event-2.3(keypress) {type into entry widget, triple click, hit Delete key, - and then type some more} -setup { + and then type some more} -setup { deleteWindows } -body { set t [toplevel .t] @@ -268,10 +269,10 @@ test event-2.3(keypress) {type into entry widget, triple click, hit Delete key, event generate $e for {set i 0} {$i < 3} {incr i} { - _pause 100 - event generate $e - _pause 100 - event generate $e + _pause 100 + event generate $e + _pause 100 + event generate $e } _keypress $e Delete @@ -311,6 +312,7 @@ test event-2.5(keypress) {type into text widget and then delete some text} -setu test event-2.6(keypress) {type into text widget, triple click, hit Delete key, and then type some more} -setup { deleteWindows + update idletasks } -body { set t [toplevel .t] set e [text $t.e] @@ -322,10 +324,10 @@ test event-2.6(keypress) {type into text widget, triple click, event generate $e for {set i 0} {$i < 3} {incr i} { - _pause 100 - event generate $e - _pause 100 - event generate $e + _pause 100 + event generate $e + _pause 100 + event generate $e } _keypress $e Delete @@ -355,7 +357,7 @@ test event-3.1(click-drag) {click and drag in a text widget, this tests # Click down to set the insert cursor position event generate $e - event generate $e -x $anchor_x -y $anchor_y + event generate $e -x $anchor_x -y $anchor_y # Save the position of the insert cursor lappend result [$e index insert] @@ -364,10 +366,10 @@ test event-3.1(click-drag) {click and drag in a text widget, this tests set current $anchor while {[$e compare $current <= $selend]} { - foreach {current_x current_y} [_text_ind_to_x_y $e $current] break - event generate $e -x $current_x -y $current_y - set current [$e index [list $current + 1 char]] - _pause 50 + foreach {current_x current_y} [_text_ind_to_x_y $e $current] break + event generate $e -x $current_x -y $current_y + set current [$e index [list $current + 1 char]] + _pause 50 } event generate $e -x $current_x -y $current_y @@ -381,13 +383,13 @@ test event-3.1(click-drag) {click and drag in a text widget, this tests # Now click and click and drag to the left, over "Tcl/Tk selection" - event generate $e -x $current_x -y $current_y + event generate $e -x $current_x -y $current_y while {[$e compare $current >= [list $anchor - 4 char]]} { - foreach {current_x current_y} [_text_ind_to_x_y $e $current] break - event generate $e -x $current_x -y $current_y - set current [$e index [list $current - 1 char]] - _pause 50 + foreach {current_x current_y} [_text_ind_to_x_y $e $current] break + event generate $e -x $current_x -y $current_y + set current [$e index [list $current - 1 char]] + _pause 50 } event generate $e -x $current_x -y $current_y @@ -422,7 +424,7 @@ test event-3.1(click-drag) {click and drag in a text widget, this tests # Click down to set the insert cursor position event generate $e - event generate $e -x $anchor_x -y $anchor_y + event generate $e -x $anchor_x -y $anchor_y # Save the position of the insert cursor lappend result [$e index insert] @@ -431,10 +433,10 @@ test event-3.1(click-drag) {click and drag in a text widget, this tests set current $anchor while {$current <= $selend} { - foreach {current_x current_y} [_text_ind_to_x_y $e $current] break - event generate $e -x $current_x -y $current_y - incr current - _pause 50 + foreach {current_x current_y} [_text_ind_to_x_y $e $current] break + event generate $e -x $current_x -y $current_y + incr current + _pause 50 } event generate $e -x $current_x -y $current_y @@ -448,13 +450,13 @@ test event-3.1(click-drag) {click and drag in a text widget, this tests # Now click and click and drag to the left, over "Tcl/Tk selection" - event generate $e -x $current_x -y $current_y + event generate $e -x $current_x -y $current_y while {$current >= ($anchor - 4)} { - foreach {current_x current_y} [_text_ind_to_x_y $e $current] break - event generate $e -x $current_x -y $current_y - incr current -1 - _pause 50 + foreach {current_x current_y} [_text_ind_to_x_y $e $current] break + event generate $e -x $current_x -y $current_y + incr current -1 + _pause 50 } event generate $e -x $current_x -y $current_y @@ -487,11 +489,11 @@ test event-4.1(double-click-drag) {click down, click up, click down again, # Click down, release, then click down again event generate $e - event generate $e -x $anchor_x -y $anchor_y + event generate $e -x $anchor_x -y $anchor_y _pause 50 event generate $e -x $anchor_x -y $anchor_y _pause 50 - event generate $e -x $anchor_x -y $anchor_y + event generate $e -x $anchor_x -y $anchor_y _pause 50 # Save the highlighted text @@ -558,11 +560,11 @@ test event-4.2(double-click-drag) {click down, click up, click down again, # Click down, release, then click down again event generate $e - event generate $e -x $anchor_x -y $anchor_y + event generate $e -x $anchor_x -y $anchor_y _pause 50 event generate $e -x $anchor_x -y $anchor_y _pause 50 - event generate $e -x $anchor_x -y $anchor_y + event generate $e -x $anchor_x -y $anchor_y _pause 50 set result [list] @@ -613,7 +615,7 @@ test event-4.2(double-click-drag) {click down, click up, click down again, } -result {select 11 7 select 4 { select} {Word select} 2} test event-5.1(triple-click-drag) {Triple click and drag across lines in a - text widget, this should extend the selection to the new line} -setup { + text widget, this should extend the selection to the new line} -setup { deleteWindows } -body { set t [toplevel .t] @@ -630,17 +632,17 @@ test event-5.1(triple-click-drag) {Triple click and drag across lines in a event generate $e - event generate $e -x $anchor_x -y $anchor_y + event generate $e -x $anchor_x -y $anchor_y _pause 50 event generate $e -x $anchor_x -y $anchor_y _pause 50 - event generate $e -x $anchor_x -y $anchor_y + event generate $e -x $anchor_x -y $anchor_y _pause 50 event generate $e -x $anchor_x -y $anchor_y _pause 50 - event generate $e -x $anchor_x -y $anchor_y + event generate $e -x $anchor_x -y $anchor_y _pause 50 set result [list] @@ -670,17 +672,17 @@ test event-5.1(triple-click-drag) {Triple click and drag across lines in a } -cleanup { deleteWindows } -result [list "LINE THREE\n" "LINE TWO\nLINE THREE\n" \ - "LINE ONE\nLINE TWO\nLINE THREE\n"] + "LINE ONE\nLINE TWO\nLINE THREE\n"] test event-6.1(button-state) {button press in a window that is then - destroyed, when the mouse is moved into another window it - should not generate a event since the mouse - was not pressed down in that window} -setup { + destroyed, when the mouse is moved into another window it + should not generate a event since the mouse + was not pressed down in that window} -setup { deleteWindows } -body { set t [toplevel .t] - event generate $t + event generate $t destroy $t set t [toplevel .t] set motion nomotion @@ -719,11 +721,11 @@ test event-7.1(double-click) {A double click on a lone character # Double click near left hand egde of the letter A event generate $e - event generate $e -x $left_x -y $left_y + event generate $e -x $left_x -y $left_y _pause 50 event generate $e -x $left_x -y $left_y _pause 50 - event generate $e -x $left_x -y $left_y + event generate $e -x $left_x -y $left_y _pause 50 event generate $e -x $left_x -y $left_y _pause 50 @@ -734,18 +736,18 @@ test event-7.1(double-click) {A double click on a lone character # Clear selection by clicking at 0,0 - event generate $e -x 0 -y 0 + event generate $e -x 0 -y 0 _pause 50 event generate $e -x 0 -y 0 _pause 50 # Double click near right hand edge of the letter A - event generate $e -x $right_x -y $right_y + event generate $e -x $right_x -y $right_y _pause 50 event generate $e -x $right_x -y $right_y _pause 50 - event generate $e -x $right_x -y $right_y + event generate $e -x $right_x -y $right_y _pause 50 event generate $e -x $right_x -y $right_y _pause 50 @@ -786,11 +788,11 @@ test event-7.2(double-click) {A double click on a lone character # Double click near left hand egde of the letter A event generate $e - event generate $e -x $left_x -y $left_y + event generate $e -x $left_x -y $left_y _pause 50 event generate $e -x $left_x -y $left_y _pause 50 - event generate $e -x $left_x -y $left_y + event generate $e -x $left_x -y $left_y _pause 50 event generate $e -x $left_x -y $left_y _pause 50 @@ -801,18 +803,18 @@ test event-7.2(double-click) {A double click on a lone character # Clear selection by clicking at 0,0 - event generate $e -x 0 -y 0 + event generate $e -x 0 -y 0 _pause 50 event generate $e -x 0 -y 0 _pause 50 # Double click near right hand edge of the letter A - event generate $e -x $right_x -y $right_y + event generate $e -x $right_x -y $right_y _pause 50 event generate $e -x $right_x -y $right_y _pause 50 - event generate $e -x $right_x -y $right_y + event generate $e -x $right_x -y $right_y _pause 50 event generate $e -x $right_x -y $right_y _pause 50 @@ -827,8 +829,8 @@ test event-7.2(double-click) {A double click on a lone character } -result {4 A 4 A} test event-8 {event generate with keysyms corresponding to - multi-byte virtual keycodes - bug - e36963bfe8df9f5e528134707a91b9c0051de723} -constraints nonPortable -setup { + multi-byte virtual keycodes - bug + e36963bfe8df9f5e528134707a91b9c0051de723} -constraints nonPortable -setup { deleteWindows set res [list ] } -body { @@ -836,7 +838,7 @@ test event-8 {event generate with keysyms corresponding to set e [entry $t.e] pack $e tkwait visibility $e - bind $e {lappend res keycode: %k keysym: %K} + bind $e {lappend res keycode: %k keysym: %K} focus -force $e update event generate $e @@ -850,12 +852,12 @@ test event-8 {event generate with keysyms corresponding to # running the test does not have a keyboard with a # diaeresis key. if {[expr {[lindex $res 3] ne "??"}]} { - # keyboard has a physical diaeresis key and bug is fixed - return "OK" + # keyboard has a physical diaeresis key and bug is fixed + return "OK" } else { - return "Test failed, unless the keyboard tied to the system \ - on which this test is run does NOT have a diaeresis \ - physical key - in this case, test is actually void." + return "Test failed, unless the keyboard tied to the system \ + on which this test is run does NOT have a diaeresis \ + physical key - in this case, test is actually void." } } -cleanup { deleteWindows @@ -869,6 +871,7 @@ test event-9.1 {enter . window by destroying a toplevel - bug b1d115fa60} -setup _pause 200 toplevel .top2 -width 200 -height 200 wm geometry .top2 +[expr {[winfo rootx .]+50}]+[expr {[winfo rooty .]+50}] + _pause 200 wm deiconify .top2 raise .top2 _pause 400 @@ -886,9 +889,9 @@ test event-9.1 {enter . window by destroying a toplevel - bug b1d115fa60} -setup test event-9.2 {enter toplevel window by destroying a toplevel - bug b1d115fa60} -setup { set iconified false if {[winfo ismapped .]} { - wm iconify . - update - set iconified true + wm iconify . + update + set iconified true } } -body { toplevel .top1 @@ -896,6 +899,7 @@ test event-9.2 {enter toplevel window by destroying a toplevel - bug b1d115fa60} wm deiconify .top1 _pause 200 toplevel .top2 -width 200 -height 200 + _pause 200 wm geometry .top2 +[expr {[winfo rootx .top1]+50}]+[expr {[winfo rooty .top1]+50}] _pause 200 wm deiconify .top2 @@ -911,8 +915,8 @@ test event-9.2 {enter toplevel window by destroying a toplevel - bug b1d115fa60} } -cleanup { deleteWindows ; # destroy all children of ".", this already includes .top1 if {$iconified} { - wm deiconify . - update + wm deiconify . + update } } -result {.top1}