diff options
author | mdejong <mdejong@noemail.net> | 2002-02-14 12:13:50 (GMT) |
---|---|---|
committer | mdejong <mdejong@noemail.net> | 2002-02-14 12:13:50 (GMT) |
commit | 323359551984ac5d81c4a0964b891b25091959a9 (patch) | |
tree | 82b57c5c0129a743cde9fc0e9cb841d90fd3b193 /tests | |
parent | 626dc7e539654752754f8f096dd7873afc8cddff (diff) | |
download | tk-323359551984ac5d81c4a0964b891b25091959a9.zip tk-323359551984ac5d81c4a0964b891b25091959a9.tar.gz tk-323359551984ac5d81c4a0964b891b25091959a9.tar.bz2 |
* tests/event.test (_text_ind_to_x_y, _get_selection): Fix
incorrect use of results from bbox invocation so that
y center point for a give index is calculated correctly.
Add new method to return the selection and use it in
test cases. Always lappend to the result list to avoid
case where initial result includes a space.
FossilOrigin-Name: b14fadab2449a58b63a9ce0b7450708f759df95f
Diffstat (limited to 'tests')
-rw-r--r-- | tests/event.test | 32 |
1 files changed, 22 insertions, 10 deletions
diff --git a/tests/event.test b/tests/event.test index a06b0b9..bd48393 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.7 2001/12/19 01:12:58 dgp Exp $ +# RCS: @(#) $Id: event.test,v 1.8 2002/02/14 12:13:51 mdejong Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -156,13 +156,22 @@ proc _pause { {msecs 1000} } { # 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)}] + foreach {x1 y1 width height} [$text bbox $ind] break + set middle_y [expr {$y1 + ($height / 2)}] return [list $x1 $middle_y] } +# Return selection only if owned by the given widget - +proc _get_selection { widget } { + if {[string compare $widget [selection own]] != 0} { + return "" + } + if {[catch {selection get} sel]} { + return "" + } + return $sel +} # Begining of the actual tests @@ -316,7 +325,8 @@ test event-click-drag-1.1 { click and drag in a text widget, this set anchor 1.6 set selend 1.18 - set result [list [$e get 1.0 1.end]] + set result [list] + lappend result [$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 @@ -345,7 +355,7 @@ test event-click-drag-1.1 { click and drag in a text widget, this lappend result [$e index insert] # Save the highlighted text - lappend result [$e get sel.first sel.last] + lappend result [_get_selection $e] # Now click and click and drag to the left, over "Tcl/Tk selection" @@ -365,7 +375,7 @@ test event-click-drag-1.1 { click and drag in a text widget, this lappend result [$e index insert] # Save the highlighted text - lappend result [$e get sel.first sel.last] + lappend result [_get_selection $e] } {{A Tcl/Tk selection test!} 1.6 1.18 {Tk selection} 1.2 {Tcl/Tk selection}} @@ -384,7 +394,8 @@ test event-click-drag-1.2 { click and drag in an entry widget, this set anchor 6 set selend 18 - set result [list [$e get]] + set result [list] + lappend result [$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 @@ -413,7 +424,7 @@ test event-click-drag-1.2 { click and drag in an entry widget, this lappend result [$e index insert] # Save the highlighted text - lappend result [selection get] + lappend result [_get_selection $e] # Now click and click and drag to the left, over "Tcl/Tk selection" @@ -433,7 +444,7 @@ test event-click-drag-1.2 { click and drag in an entry widget, this lappend result [$e index insert] # Save the highlighted text - lappend result [selection get] + lappend result [_get_selection $e] } {{A Tcl/Tk selection!} 6 18 {Tk selection} 2 {Tcl/Tk selection}} @@ -449,6 +460,7 @@ rename _keypress_lookup {} rename _keypress {} rename _pause {} rename _text_ind_to_x_y {} +rename _get_selection {} ::tcltest::cleanupTests return |