summaryrefslogtreecommitdiffstats
path: root/tests/event.test
diff options
context:
space:
mode:
authormdejong <mdejong>2002-02-14 12:13:51 (GMT)
committermdejong <mdejong>2002-02-14 12:13:51 (GMT)
commitdff8c7d408c1584688b32c9c52a534d930ea9762 (patch)
tree82b57c5c0129a743cde9fc0e9cb841d90fd3b193 /tests/event.test
parent22946a8cd411fca97059fd12ff2e1b015afc922c (diff)
downloadtk-dff8c7d408c1584688b32c9c52a534d930ea9762.zip
tk-dff8c7d408c1584688b32c9c52a534d930ea9762.tar.gz
tk-dff8c7d408c1584688b32c9c52a534d930ea9762.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.
Diffstat (limited to 'tests/event.test')
-rw-r--r--tests/event.test32
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