diff options
Diffstat (limited to 'tests/event.test')
| -rw-r--r-- | tests/event.test | 394 |
1 files changed, 390 insertions, 4 deletions
diff --git a/tests/event.test b/tests/event.test index f1d0450..933b826 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.5 2000/04/10 22:43:13 ericm Exp $ +# RCS: @(#) $Id: event.test,v 1.5.6.1 2001/07/03 20:01:09 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -22,6 +22,150 @@ raise . # a few of the procedures in tkEvent.c. Please add more tests whenever # possible. + + +# Setup table used to query key events. + +proc _init_keypress_lookup { } { + global keypress_lookup + + 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 + } + + 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 + } + + 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 + } + + array set keypress_lookup [list \ + " " space \ + ! exclam \ + \" quotedbl \ + \# numbersign \ + \$ dollar \ + % percent \ + & ampersand \ + ( parenleft \ + ) parenright \ + * asterisk \ + + plus \ + , comma \ + - minus \ + . period \ + / slash \ + : colon \ + \; semicolon \ + < less \ + = equal \ + > greater \ + ? question \ + @ at \ + \[ bracketleft \ + \\ backslash \ + \] bracketright \ + ^ asciicircum \ + _ underscore \ + \{ braceleft \ + | bar \ + \} braceright \ + ~ asciitilde \ + ' apostrophe \ + "\n" Return] +} + + +# Lookup an event in the keypress table. +# For example: +# Q -> Q +# . -> period +# / -> slash +# Delete -> Delete +# Escape -> Escape + +proc _keypress_lookup { char } { + global keypress_lookup + + if {! [info exists keypress_lookup]} { + _init_keypress_lookup + } + + if {$char == ""} { + error "empty char" + } + + if {[info exists keypress_lookup($char)]} { + return $keypress_lookup($char) + } else { + return $char + } +} + + +# Lookup and generate a pair of KeyPress and KeyRelease events + +proc _keypress { win key } { + set keysym [_keypress_lookup $key] + + event generate $win <KeyPress-$keysym> + _pause 50 + event generate $win <KeyRelease-$keysym> + _pause 50 +} + +# Call _keypress for each character in the given string + +proc _keypress_string { win string } { + foreach letter [split $string ""] { + _keypress $win $letter + } +} + +# Delay script execution for a given amount of time + +proc _pause { {msecs 1000} } { + global _pause + + if {! [info exists _pause(number)]} { + set _pause(number) 0 + } + + set num [incr _pause(number)] + set _pause($num) 0 + + after $msecs "set _pause($num) 1" + vwait _pause($num) + unset _pause($num) +} + +# Helper proc to convert index to x y position + +proc _text_ind_to_x_y { text ind } { + foreach {x1 y1 x2 y2} [$text bbox $ind] break + set middle_y [expr {$y1 + (($y2 - $y1) / 2)}] + return [list $x1 $middle_y] +} + + + + +# Begining of the actual tests + test event-1.1 {Tk_HandleEvent procedure, filter events for dead windows} { button .b -text Test pack .b @@ -51,19 +195,261 @@ test event-1.2 {event generate <Alt-z>} { destroy .e set ::event12result } 1 -# cleanup -::tcltest::cleanupTests -return +test event-keypress-1.1 { type into entry widget and hit Return } { + destroy .t + set t [toplevel .t] + set e [entry $t.e] + pack $e + 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} +test event-keypress-1.2 { type into entry widget and then delete some text } { + destroy .t + set t [toplevel .t] + set e [entry $t.e] + pack $e + tkwait visibility $e + focus -force $e + _keypress_string $e MELLO + _keypress $e BackSpace + _keypress $e BackSpace + $e get +} MEL +test event-keypress-1.3 { type into entry widget, triple click, + hit Delete key, and then type some more } { + destroy .t + set t [toplevel .t] + set e [entry $t.e] + pack $e + tkwait visibility $e + focus -force $e + _keypress_string $e JUMP + + set result [$e get] + + event generate $e <Enter> + for {set i 0} {$i < 3} {incr i} { + _pause 100 + event generate $e <ButtonPress-1> + _pause 100 + event generate $e <ButtonRelease-1> + } + _keypress $e Delete + _keypress_string $e UP + lappend result [$e get] +} {JUMP UP} +test event-keypress-1.4 { type into text widget and hit Return } { + destroy .t + set t [toplevel .t] + set e [text $t.e] + pack $e + 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] +test event-keypress-1.5 { type into text widget and then delete some text } { + destroy .t + set t [toplevel .t] + set e [text $t.e] + pack $e + tkwait visibility $e + focus -force $e + _keypress_string $e MELLO + _keypress $e BackSpace + _keypress $e BackSpace + $e get 1.0 1.end +} MEL +test event-keypress-1.6 { type into text widget, triple click, + hit Delete key, and then type some more } { + destroy .t + set t [toplevel .t] + 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] + + event generate $e <Enter> + for {set i 0} {$i < 3} {incr i} { + _pause 100 + event generate $e <ButtonPress-1> + _pause 100 + event generate $e <ButtonRelease-1> + } + + _keypress $e Delete + _keypress_string $e UP + lappend result [$e get 1.0 1.end] +} {JUMP UP} + + + +test event-click-drag-1.1 { click and drag in a text widget, this + tests tkTextSelectTo in text.tcl } { + destroy .t + set t [toplevel .t] + 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 + + set result [list [$e get 1.0 1.end]] + + # Get the x,y coords of the second T in "Tcl/Tk" + foreach {anchor_x anchor_y} [_text_ind_to_x_y $e $anchor] break + + # Click down to set the insert cursor position + event generate $e <Enter> + event generate $e <ButtonPress-1> -x $anchor_x -y $anchor_y + + # Save the position of the insert cursor + lappend result [$e index insert] + + # Now drag until selend is highlighted, then click up + + set current $anchor + while {[$e compare $current <= $selend]} { + foreach {current_x current_y} [_text_ind_to_x_y $e $current] break + event generate $e <B1-Motion> -x $current_x -y $current_y + set current [$e index [list $current + 1 char]] + _pause 50 + } + + event generate $e <ButtonRelease-1> -x $current_x -y $current_y + _pause 200 + + # Save the position of the insert cursor + lappend result [$e index insert] + + # Save the highlighted text + lappend result [$e get sel.first sel.last] + + # Now click and click and drag to the left, over "Tcl/Tk selection" + + event generate $e <ButtonPress-1> -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 <B1-Motion> -x $current_x -y $current_y + set current [$e index [list $current - 1 char]] + _pause 50 + } + + event generate $e <ButtonRelease-1> -x $current_x -y $current_y + _pause 200 + + # Save the position of the insert cursor + lappend result [$e index insert] + + # Save the highlighted text + lappend result [$e get sel.first sel.last] + +} {{A Tcl/Tk selection test!} 1.6 1.18 {Tk selection} 1.2 {Tcl/Tk selection}} + + + + +test event-click-drag-1.2 { click and drag in an entry widget, this + tests tkEntryMouseSelect in entry.tcl } { + destroy .t + set t [toplevel .t] + set e [entry $t.e] + pack $e + tkwait visibility $e + focus -force $e + _keypress_string $e "A Tcl/Tk selection test!" + set anchor 6 + set selend 18 + + set result [list [$e get]] + + # Get the x,y coords of the second T in "Tcl/Tk" + foreach {anchor_x anchor_y} [_text_ind_to_x_y $e $anchor] break + + # Click down to set the insert cursor position + event generate $e <Enter> + event generate $e <ButtonPress-1> -x $anchor_x -y $anchor_y + + # Save the position of the insert cursor + lappend result [$e index insert] + + # Now drag until selend is highlighted, then click up + + set current $anchor + while {$current <= $selend} { + foreach {current_x current_y} [_text_ind_to_x_y $e $current] break + event generate $e <B1-Motion> -x $current_x -y $current_y + incr current + _pause 50 + } + + event generate $e <ButtonRelease-1> -x $current_x -y $current_y + _pause 200 + + # Save the position of the insert cursor + lappend result [$e index insert] + + # Save the highlighted text + lappend result [selection get] + + # Now click and click and drag to the left, over "Tcl/Tk selection" + + event generate $e <ButtonPress-1> -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 <B1-Motion> -x $current_x -y $current_y + incr current -1 + _pause 50 + } + + event generate $e <ButtonRelease-1> -x $current_x -y $current_y + _pause 200 + + # Save the position of the insert cursor + lappend result [$e index insert] + + # Save the highlighted text + lappend result [selection get] + +} {{A Tcl/Tk selection test!} 6 18 {Tk selection} 2 {Tcl/Tk selection}} + + + +# cleanup + +destroy .t + +unset keypress_lookup +rename _init_keypress_lookup {} +rename _keypress_lookup {} +rename _keypress {} +rename _pause {} +rename _text_ind_to_x_y {} + +::tcltest::cleanupTests +return |