summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/textTag.test31
1 files changed, 29 insertions, 2 deletions
diff --git a/tests/textTag.test b/tests/textTag.test
index 6a60142..8f39142 100644
--- a/tests/textTag.test
+++ b/tests/textTag.test
@@ -6,14 +6,15 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: textTag.test,v 1.8 2003/05/19 13:04:24 vincentdarley Exp $
+# RCS: @(#) $Id: textTag.test,v 1.9 2003/11/12 17:19:18 vincentdarley Exp $
package require tcltest 2.1
eval tcltest::configure $argv
tcltest::loadTestedCommands
+namespace import -force tcltest::test
catch {destroy .t}
-testConstraint courier12 [expr {[catch {
+tcltest::testConstraint courier12 [expr {[catch {
text .t -font {Courier 12} -width 20 -height 10
}] == 0}]
@@ -772,6 +773,32 @@ test textTag-17.1 {insert procedure inserts tags} {
catch {destroy .t}
+test textTag-18.1 {TkTextPickCurrent tag bindings} {
+ text .t -width 30 -height 4 -relief sunken -borderwidth 10 \
+ -highlightthickness 10 -pady 2
+ pack .t
+
+ .t insert end " Tag here " TAG " no tag here"
+ .t tag configure TAG -borderwidth 4 -relief raised
+ .t tag bind TAG <Enter> {lappend res "%x %y tag-Enter"}
+ .t tag bind TAG <Leave> {lappend res "%x %y tag-Leave"}
+ bind .t <Enter> {lappend res Enter}
+ bind .t <Leave> {lappend res Leave}
+
+ set res {}
+ # Bindings must not trigger on the widget border, only over
+ # the actual tagged characters themselves.
+ event gen .t <Motion> -warp 1 -x 0 -y 0 ; update
+ event gen .t <Motion> -warp 1 -x 10 -y 10 ; update
+ event gen .t <Motion> -warp 1 -x 25 -y 25 ; update
+ event gen .t <Motion> -warp 1 -x 20 -y 20 ; update
+ event gen .t <Motion> -warp 1 -x 10 -y 10 ; update
+ event gen .t <Motion> -warp 1 -x 25 -y 25 ; update
+ set res
+} {Enter {25 25 tag-Enter} {20 20 tag-Leave} {25 25 tag-Enter}}
+
+catch {destroy .t}
+
# cleanup
cleanupTests
return