From eb78d528032eb6aed4fea23a56198aa78a88adaf Mon Sep 17 00:00:00 2001
From: patthoyts <patthoyts@users.sourceforge.net>
Date: Wed, 12 Nov 2008 16:38:13 +0000
Subject: bug #1777362 - handle windows with funky names by avoiding use of the
 window path for anchors.

---
 ChangeLog        |  5 ++++
 library/text.tcl | 88 +++++++++++++++++++++++++++++++++-----------------------
 tests/text.test  | 49 +++++++++++++++++++++++++++----
 3 files changed, 100 insertions(+), 42 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index b271108..9fdbcac 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2008-11-12  Pat Thoyts  <patthoyts@users.sourceforge.net>
+
+	* library/text.tcl: bug #1777362 - handle windows with funky names
+	* test/text.test:   by avoiding use of the window path for anchors.
+
 2008-11-11  Jan Nijtmans  <nijtmans@users.sf.net>
 
 	* generic/tkImgPhoto.c    Fix [Bug 2265860] new test failures
diff --git a/library/text.tcl b/library/text.tcl
index 36a15c2..0d9b9d2 100644
--- a/library/text.tcl
+++ b/library/text.tcl
@@ -3,7 +3,7 @@
 # This file defines the default bindings for Tk text widgets and provides
 # procedures that help in implementing the bindings.
 #
-# RCS: @(#) $Id: text.tcl,v 1.41 2006/09/10 17:06:32 das Exp $
+# RCS: @(#) $Id: text.tcl,v 1.42 2008/11/12 16:38:13 patthoyts Exp $
 #
 # Copyright (c) 1992-1994 The Regents of the University of California.
 # Copyright (c) 1994-1997 Sun Microsystems, Inc.
@@ -33,6 +33,7 @@
 #			char, word, or line.
 # x, y -		Last known mouse coordinates for scanning
 #			and auto-scanning.
+#
 #-------------------------------------------------------------------------
 
 #-------------------------------------------------------------------------
@@ -224,10 +225,10 @@ bind Text <BackSpace> {
 }
 
 bind Text <Control-space> {
-    %W mark set tk::anchor%W insert
+    %W mark set [tk::TextAnchor %W] insert
 }
 bind Text <Select> {
-    %W mark set tk::anchor%W insert
+    %W mark set [tk::TextAnchor %W] insert
 }
 bind Text <Control-Shift-space> {
     set tk::Priv(selectMode) char
@@ -527,15 +528,16 @@ proc ::tk::TextButton1 {w x y} {
     set Priv(selectMode) char
     set Priv(mouseMoved) 0
     set Priv(pressX) $x
+    set anchorname [tk::TextAnchor $w]
     $w mark set insert [TextClosestGap $w $x $y]
-    $w mark set tk::anchor$w insert
+    $w mark set $anchorname insert
     # Set the anchor mark's gravity depending on the click position
     # relative to the gap
-    set bbox [$w bbox [$w index tk::anchor$w]]
+    set bbox [$w bbox [$w index $anchorname]]
     if {$x > [lindex $bbox 0]} {
-	$w mark gravity tk::anchor$w right
+	$w mark gravity $anchorname right
     } else {
-	$w mark gravity tk::anchor$w left
+	$w mark gravity $anchorname left
     }
     # Allow focus in any case on Windows, because that will let the
     # selection be displayed even for state disabled text widgets.
@@ -565,36 +567,47 @@ proc ::tk::TextButton1 {w x y} {
 # x -		Mouse x position.
 # y - 		Mouse y position.
 
+set ::tk::Priv(textanchoruid) 0
+
+proc ::tk::TextAnchor {w} {
+    variable Priv
+    if {![info exists Priv(textanchor,$w)]} {
+        set Priv(textanchor,$w) tk::anchor[incr Priv(textanchoruid)]
+    }
+    return $Priv(textanchor,$w)
+}
+
 proc ::tk::TextSelectTo {w x y {extend 0}} {
     global tcl_platform
     variable ::tk::Priv
 
+    set anchorname [tk::TextAnchor $w]
     set cur [TextClosestGap $w $x $y]
-    if {[catch {$w index tk::anchor$w}]} {
-	$w mark set tk::anchor$w $cur
+    if {[catch {$w index $anchorname}]} {
+	$w mark set $anchorname $cur
     }
-    set anchor [$w index tk::anchor$w]
+    set anchor [$w index $anchorname]
     if {[$w compare $cur != $anchor] || (abs($Priv(pressX) - $x) >= 3)} {
 	set Priv(mouseMoved) 1
     }
     switch -- $Priv(selectMode) {
 	char {
-	    if {[$w compare $cur < tk::anchor$w]} {
+	    if {[$w compare $cur < $anchorname]} {
 		set first $cur
-		set last tk::anchor$w
+		set last $anchorname
 	    } else {
-		set first tk::anchor$w
+		set first $anchorname
 		set last $cur
 	    }
 	}
 	word {
 	    # Set initial range based only on the anchor (1 char min width)
-	    if {[$w mark gravity tk::anchor$w] eq "right"} {
-		set first "tk::anchor$w"
-		set last "tk::anchor$w + 1c"
+	    if {[$w mark gravity $anchorname] eq "right"} {
+		set first $anchorname
+		set last "$anchorname + 1c"
 	    } else {
-		set first "tk::anchor$w - 1c"
-		set last "tk::anchor$w"
+		set first "$anchorname - 1c"
+		set last $anchorname
 	    }
 	    # Extend range (if necessary) based on the current point
 	    if {[$w compare $cur < $first]} {
@@ -609,8 +622,8 @@ proc ::tk::TextSelectTo {w x y {extend 0}} {
 	}
 	line {
 	    # Set initial range based only on the anchor
-	    set first "tk::anchor$w linestart"
-	    set last "tk::anchor$w lineend"
+	    set first "$anchorname linestart"
+	    set last "$anchorname lineend"
 
 	    # Extend range (if necessary) based on the current point
 	    if {[$w compare $cur < $first]} {
@@ -642,16 +655,17 @@ proc ::tk::TextSelectTo {w x y {extend 0}} {
 
 proc ::tk::TextKeyExtend {w index} {
 
+    set anchorname [tk::TextAnchor $w]
     set cur [$w index $index]
-    if {[catch {$w index tk::anchor$w}]} {
-	$w mark set tk::anchor$w $cur
+    if {[catch {$w index $anchorname}]} {
+	$w mark set $anchorname $cur
     }
-    set anchor [$w index tk::anchor$w]
-    if {[$w compare $cur < tk::anchor$w]} {
+    set anchor [$w index $anchorname]
+    if {[$w compare $cur < $anchorname]} {
 	set first $cur
-	set last tk::anchor$w
+	set last $anchorname
     } else {
-	set first tk::anchor$w
+	set first $anchorname
 	set last $cur
     }
     $w tag remove sel 0.0 $first
@@ -752,19 +766,20 @@ proc ::tk::TextSetCursor {w pos} {
 
 proc ::tk::TextKeySelect {w new} {
 
+    set anchorname [tk::TextAnchor $w]
     if {[$w tag nextrange sel 1.0 end] eq ""} {
 	if {[$w compare $new < insert]} {
 	    $w tag add sel $new insert
 	} else {
 	    $w tag add sel insert $new
 	}
-	$w mark set tk::anchor$w insert
+	$w mark set $anchorname insert
     } else {
-	if {[$w compare $new < tk::anchor$w]} {
+	if {[$w compare $new < $anchorname]} {
 	    set first $new
-	    set last tk::anchor$w
+	    set last $anchorname
 	} else {
-	    set first tk::anchor$w
+	    set first $anchorname
 	    set last $new
 	}
 	$w tag remove sel 1.0 $first
@@ -798,15 +813,16 @@ proc ::tk::TextResetAnchor {w index} {
 	# the two clicks will be selected. [Bug: 5929].
 	return
     }
+    set anchorname [tk::TextAnchor $w]
     set a [$w index $index]
     set b [$w index sel.first]
     set c [$w index sel.last]
     if {[$w compare $a < $b]} {
-	$w mark set tk::anchor$w sel.last
+	$w mark set $anchorname sel.last
 	return
     }
     if {[$w compare $a > $c]} {
-	$w mark set tk::anchor$w sel.first
+	$w mark set $anchorname sel.first
 	return
     }
     scan $a "%d.%d" lineA chA
@@ -818,16 +834,16 @@ proc ::tk::TextResetAnchor {w index} {
 	    return
 	}
 	if {[string length [$w get $b $a]] < ($total/2)} {
-	    $w mark set tk::anchor$w sel.last
+	    $w mark set $anchorname sel.last
 	} else {
-	    $w mark set tk::anchor$w sel.first
+	    $w mark set $anchorname sel.first
 	}
 	return
     }
     if {($lineA-$lineB) < ($lineC-$lineA)} {
-	$w mark set tk::anchor$w sel.last
+	$w mark set $anchorname sel.last
     } else {
-	$w mark set tk::anchor$w sel.first
+	$w mark set $anchorname sel.first
     }
 }
 
diff --git a/tests/text.test b/tests/text.test
index ac5a543..5709b33 100644
--- a/tests/text.test
+++ b/tests/text.test
@@ -6,7 +6,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: text.test,v 1.51 2008/08/03 15:30:26 aniap Exp $
+# RCS: @(#) $Id: text.test,v 1.52 2008/11/12 16:38:13 patthoyts Exp $
 
 package require tcltest 2.2
 eval tcltest::configure $argv
@@ -6653,11 +6653,48 @@ test text-35.3 {widget dump -command destroys widget} -setup {
 } -result {ok}
 
 
-# cleanup
-cleanupTests
-return
-
-
+test text-36.1 "bug #1777362: event handling with hyphenated windows" -setup {
+    proc bgerror {m} {set ::my_error $m}
+    set ::my_error {}
+    pack [set w [text .t-1]]
+} -body {
+    tkwait visibility $w
+    event generate $w <1>
+    event generate $w <1>
+    update
+    set ::my_error
+} -cleanup {
+    destroy .t-1
+} -result {}
 
+test text-36.2 "bug #1777362: event handling with hyphenated windows" -setup {
+    proc bgerror {m} {set ::my_error $m}
+    set ::my_error {}
+    pack [set w [text .t+1]]
+} -body {
+    tkwait visibility $w
+    event generate $w <1>
+    event generate $w <1>
+    update
+    set ::my_error
+} -cleanup {
+    destroy $w
+} -result {}
 
+test text-36.3 "bug #1777362: event handling with hyphenated windows" -setup {
+    proc bgerror {m} {set ::my_error $m}
+    set ::my_error {}
+    pack [set w [text .t*1]]
+} -body {
+    tkwait visibility $w
+    event generate $w <1>
+    event generate $w <1>
+    update
+    set ::my_error
+} -cleanup {
+    destroy $w
+} -result {}
 
+# cleanup
+cleanupTests
+return
-- 
cgit v0.12