old tk text widget bugs fixed

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