diff options
Diffstat (limited to 'tests/event.test')
| -rw-r--r-- | tests/event.test | 292 |
1 files changed, 198 insertions, 94 deletions
diff --git a/tests/event.test b/tests/event.test index f6f30df..fa75610 100644 --- a/tests/event.test +++ b/tests/event.test @@ -7,10 +7,7 @@ # All rights reserved. package require tcltest 2.1 -namespace import -force tcltest::configure -namespace import -force tcltest::testsDirectory -configure -testdir [file join [pwd] [file dirname [info script]]] -configure -loadfile [file join [testsDirectory] constraints.tcl] +eval tcltest::configure $argv tcltest::loadTestedCommands # XXX This test file is woefully incomplete. Right now it only tests @@ -19,7 +16,7 @@ tcltest::loadTestedCommands # Setup table used to query key events. -proc _init_keypress_lookup { } { +proc _init_keypress_lookup {} { global keypress_lookup scan A %c start @@ -46,43 +43,47 @@ proc _init_keypress_lookup { } { 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 + } + # Characters with meaning to Tcl... 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] + \" quotedbl \ + \# numbersign \ + \$ dollar \ + \; semicolon \ + \[ bracketleft \ + \\ backslash \ + \] bracketright \ + \{ braceleft \ + \} braceright \ + " " space \ + "\n" Return \ + "\t" Tab] } - # Lookup an event in the keypress table. # For example: # Q -> Q @@ -91,7 +92,7 @@ proc _init_keypress_lookup { } { # Delete -> Delete # Escape -> Escape -proc _keypress_lookup { char } { +proc _keypress_lookup {char} { global keypress_lookup if {! [info exists keypress_lookup]} { @@ -109,10 +110,9 @@ proc _keypress_lookup { char } { } } - # Lookup and generate a pair of KeyPress and KeyRelease events -proc _keypress { win key } { +proc _keypress {win key} { set keysym [_keypress_lookup $key] # Force focus to the window before delivering @@ -134,7 +134,7 @@ proc _keypress { win key } { # Call _keypress for each character in the given string -proc _keypress_string { win string } { +proc _keypress_string {win string} { foreach letter [split $string ""] { _keypress $win $letter } @@ -142,7 +142,7 @@ proc _keypress_string { win string } { # Delay script execution for a given amount of time -proc _pause { {msecs 1000} } { +proc _pause {{msecs 1000}} { global _pause if {! [info exists _pause(number)]} { @@ -159,7 +159,7 @@ proc _pause { {msecs 1000} } { # Helper proc to convert index to x y position -proc _text_ind_to_x_y { text ind } { +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" @@ -171,7 +171,7 @@ proc _text_ind_to_x_y { text ind } { # Return selection only if owned by the given widget -proc _get_selection { widget } { +proc _get_selection {widget} { if {[string compare $widget [selection own]] != 0} { return "" } @@ -200,7 +200,6 @@ test event-1.1 {Tk_HandleEvent procedure, filter events for dead windows} { destroy .b set x } {destroy} - test event-1.2 {event generate <Alt-z>} { catch {destroy .e} catch {unset ::event12result} @@ -213,9 +212,7 @@ test event-1.2 {event generate <Alt-z>} { set ::event12result } 1 - - -test event-keypress-1.1 { type into entry widget and hit Return } { +test event-2.1(keypress) {type into entry widget and hit Return} { destroy .t set t [toplevel .t] set e [entry $t.e] @@ -226,9 +223,7 @@ test event-keypress-1.1 { type into entry widget and hit Return } { _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 } { +test event-2.2(keypress) {type into entry widget and then delete some text} { destroy .t set t [toplevel .t] set e [entry $t.e] @@ -239,9 +234,8 @@ test event-keypress-1.2 { type into entry widget and then delete some text } { _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 } { +test event-2.3(keypress) {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] @@ -263,9 +257,7 @@ test event-keypress-1.3 { type into entry widget, triple click, _keypress_string $e UP lappend result [$e get] } {JUMP UP} - - -test event-keypress-1.4 { type into text widget and hit Return } { +test event-1.4(keypress) {type into text widget and hit Return} { destroy .t set t [toplevel .t] set e [text $t.e] @@ -276,8 +268,7 @@ test event-keypress-1.4 { type into text widget and hit Return } { _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 } { +test event-2.5(keypress) {type into text widget and then delete some text} { destroy .t set t [toplevel .t] set e [text $t.e] @@ -288,9 +279,8 @@ test event-keypress-1.5 { type into text widget and then delete some text } { _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 } { +test event-2.6(keypress) {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] @@ -313,10 +303,8 @@ test event-keypress-1.6 { type into text widget, triple click, 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 } { +test event-3.1(click-drag) {click and drag in a text widget, this tests\ + tkTextSelectTo in text.tcl} { destroy .t set t [toplevel .t] set e [text $t.e] @@ -379,12 +367,8 @@ test event-click-drag-1.1 { click and drag in a text widget, this lappend result [_get_selection $e] } {{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 } { +test event-3.2(click-drag) {click and drag in an entry widget, this\ + tests tkEntryMouseSelect in entry.tcl} { destroy .t set t [toplevel .t] set e [entry $t.e] @@ -448,10 +432,8 @@ test event-click-drag-1.2 { click and drag in an entry widget, this } {{A Tcl/Tk selection!} 6 18 {Tk selection} 2 {Tcl/Tk selection}} - - -test event-double-click-drag-1.1 { click down, click up, click down again, - then drag in a text widget } { +test event-4.1(double-click-drag) {click down, click up, click down again,\ + then drag in a text widget} { destroy .t set t [toplevel .t] set e [text $t.e] @@ -476,7 +458,7 @@ test event-double-click-drag-1.1 { click down, click up, click down again, set result [list] lappend result [_get_selection $e] - # Insert cursor should be at end of "select" + # Insert cursor should be at beginning of "select" lappend result [$e index insert] # Move mouse one character to the left @@ -516,12 +498,9 @@ test event-double-click-drag-1.1 { click down, click up, click down again, lappend result [$e index insert] set result -} {select 1.11 1.7 select 1.4 { select} {Word select} 1.2} - - - -test event-double-click-drag-1.2 { click down, click up, click down again, - then drag in an entry widget } { +} {select 1.5 1.7 select 1.4 { select} {Word select} 1.2} +test event-4.2(double-click-drag) {click down, click up, click down again,\ + then drag in an entry widget} { destroy .t set t [toplevel .t] set e [entry $t.e] @@ -588,9 +567,8 @@ test event-double-click-drag-1.2 { click down, click up, click down again, set result } {select 11 7 select 4 { select} {Word select} 2} - -test event-triple-click-drag-1.1 { Triple click and drag across lines in - a text widget, this should extend the selection to the new line } { +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} { destroy .t set t [toplevel .t] set e [text $t.e] @@ -647,10 +625,10 @@ test event-triple-click-drag-1.1 { Triple click and drag across lines in } [list "LINE THREE\n" "LINE TWO\nLINE THREE\n" \ "LINE ONE\nLINE TWO\nLINE THREE\n"] -test event-button-state-1.1 { button press in a window that is then - destroyed, when the mouse is moved into another window it - should not generate a <B1-motion> event since the mouse - was not pressed down in that window. } { +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 <B1-motion> event since the mouse\ + was not pressed down in that window} { destroy .t set t [toplevel .t] @@ -663,6 +641,133 @@ test event-button-state-1.1 { button press in a window that is then set motion } nomotion +test event-7.1(double-click) {A double click on a lone character + in a text widget should select that character} { + destroy .t + set t [toplevel .t] + set e [text $t.e] + pack $e + tkwait visibility $e + focus -force $e + _keypress_string $e "On A letter" + + set anchor 1.3 + + # Get x,y coords just inside the left + # and right hand side of the letter A + foreach {x1 y1 width height} [$e bbox $anchor] break + + set middle_y [expr {$y1 + ($height / 2)}] + + set left_x [expr {$x1 + 2}] + set left_y $middle_y + + set right_x [expr {($x1 + $width) - 2}] + set right_y $middle_y + + # Double click near left hand egde of the letter A + + event generate $e <Enter> + event generate $e <ButtonPress-1> -x $left_x -y $left_y + _pause 50 + event generate $e <ButtonRelease-1> -x $left_x -y $left_y + _pause 50 + event generate $e <ButtonPress-1> -x $left_x -y $left_y + _pause 50 + event generate $e <ButtonRelease-1> -x $left_x -y $left_y + _pause 50 + + set result [list] + lappend result [$e index insert] + lappend result [_get_selection $e] + + # Clear selection by clicking at 0,0 + + event generate $e <ButtonPress-1> -x 0 -y 0 + _pause 50 + event generate $e <ButtonRelease-1> -x 0 -y 0 + _pause 50 + + # Double click near right hand edge of the letter A + + event generate $e <ButtonPress-1> -x $right_x -y $right_y + _pause 50 + event generate $e <ButtonRelease-1> -x $right_x -y $right_y + _pause 50 + event generate $e <ButtonPress-1> -x $right_x -y $right_y + _pause 50 + event generate $e <ButtonRelease-1> -x $right_x -y $right_y + _pause 50 + + lappend result [$e index insert] + lappend result [_get_selection $e] + + set result +} {1.3 A 1.3 A} +test event-7.2(double-click) {A double click on a lone character\ + in an entry widget should select that character} {knownBug} { + destroy .t + set t [toplevel .t] + set e [entry $t.e] + pack $e + tkwait visibility $e + focus -force $e + _keypress_string $e "On A letter" + + set anchor 3 + + # Get x,y coords just inside the left + # and right hand side of the letter A + foreach {x1 y1 width height} [$e bbox $anchor] break + + set middle_y [expr {$y1 + ($height / 2)}] + + set left_x [expr {$x1 + 2}] + set left_y $middle_y + + set right_x [expr {($x1 + $width) - 2}] + set right_y $middle_y + + # Double click near left hand egde of the letter A + + event generate $e <Enter> + event generate $e <ButtonPress-1> -x $left_x -y $left_y + _pause 50 + event generate $e <ButtonRelease-1> -x $left_x -y $left_y + _pause 50 + event generate $e <ButtonPress-1> -x $left_x -y $left_y + _pause 50 + event generate $e <ButtonRelease-1> -x $left_x -y $left_y + _pause 50 + + set result [list] + lappend result [$e index insert] + lappend result [_get_selection $e] + + # Clear selection by clicking at 0,0 + + event generate $e <ButtonPress-1> -x 0 -y 0 + _pause 50 + event generate $e <ButtonRelease-1> -x 0 -y 0 + _pause 50 + + # Double click near right hand edge of the letter A + + event generate $e <ButtonPress-1> -x $right_x -y $right_y + _pause 50 + event generate $e <ButtonRelease-1> -x $right_x -y $right_y + _pause 50 + event generate $e <ButtonPress-1> -x $right_x -y $right_y + _pause 50 + event generate $e <ButtonRelease-1> -x $right_x -y $right_y + _pause 50 + + lappend result [$e index insert] + lappend result [_get_selection $e] + + set result +} {3 A 4 A} + # cleanup destroy .t @@ -675,6 +780,5 @@ rename _pause {} rename _text_ind_to_x_y {} rename _get_selection {} -::tcltest::cleanupTests +cleanupTests return - |