diff options
| -rw-r--r-- | ChangeLog | 5 | ||||
| -rw-r--r-- | library/text.tcl | 88 | ||||
| -rw-r--r-- | tests/text.test | 44 |
3 files changed, 100 insertions, 37 deletions
@@ -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 |