summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog9
-rw-r--r--tests/event.test32
2 files changed, 31 insertions, 10 deletions
diff --git a/ChangeLog b/ChangeLog
index fc4e6aa..fe328b0 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,12 @@
+2002-02-14 Mo DeJong <mdejong@users.sourceforge.net>
+
+ * 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.
+
2002-02-07 Don Porter <dgp@users.sourceforge.net>
* generic/tkMain.c:
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