summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog5
-rw-r--r--library/text.tcl88
-rw-r--r--tests/text.test44
3 files changed, 100 insertions, 37 deletions
diff --git a/ChangeLog b/ChangeLog
index d3118f7..e07d422 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2008-11-12 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * library/text.tcl: Backported fix for bug #1777362 to have events
+ * test/text.test: work with window paths that include hyphens.
+
2008-10-23 Don Porter <dgp@users.sourceforge.net>
* generic/tk.h: Bump version number to 8.5.6b1 to distinguish
diff --git a/library/text.tcl b/library/text.tcl
index 36a15c2..8130d93 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.41.4.1 2008/11/12 22:17:02 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 c195426..273dccd 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.49 2007/12/13 15:27:54 dgp Exp $
+# RCS: @(#) $Id: text.test,v 1.49.2.1 2008/11/12 22:17:02 patthoyts Exp $
package require tcltest 2.1
eval tcltest::configure $argv
@@ -3625,6 +3625,48 @@ test text-33.3 {widget dump -command destroys widget} {
deleteWindows
option clear
+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