diff options
author | hobbs <hobbs> | 2001-12-27 22:26:41 (GMT) |
---|---|---|
committer | hobbs <hobbs> | 2001-12-27 22:26:41 (GMT) |
commit | 3f850339f62a30d1302728860ed3ea45c5560570 (patch) | |
tree | e4b064aac21b465e766a16b4e853df07be7509e2 | |
parent | c27c015cb68d53bd84f0661a1f2d588aa6e8d8cf (diff) | |
download | tk-3f850339f62a30d1302728860ed3ea45c5560570.zip tk-3f850339f62a30d1302728860ed3ea45c5560570.tar.gz tk-3f850339f62a30d1302728860ed3ea45c5560570.tar.bz2 |
* library/entry.tcl:
* library/spinbox.tcl:
* library/text.tcl: added extra checks against bug #220269 and
made spinbox reuse more of the entry procedure code.
-rw-r--r-- | library/entry.tcl | 56 | ||||
-rw-r--r-- | library/spinbox.tcl | 260 | ||||
-rw-r--r-- | library/text.tcl | 55 |
3 files changed, 130 insertions, 241 deletions
diff --git a/library/entry.tcl b/library/entry.tcl index 57f95fd..943e719 100644 --- a/library/entry.tcl +++ b/library/entry.tcl @@ -3,7 +3,7 @@ # This file defines the default bindings for Tk entry widgets and provides # procedures that help in implementing those bindings. # -# RCS: @(#) $Id: entry.tcl,v 1.16 2001/08/01 16:21:11 dgp Exp $ +# RCS: @(#) $Id: entry.tcl,v 1.17 2001/12/27 22:26:41 hobbs Exp $ # # Copyright (c) 1992-1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. @@ -63,7 +63,8 @@ bind Entry <<Clear>> { %W delete sel.first sel.last } bind Entry <<PasteSelection>> { - if {!$tk::Priv(mouseMoved) || $tk_strictMotif} { + if {$tk_strictMotif || ![info exists tk::Priv(mouseMoved)] + || !$tk::Priv(mouseMoved)} { tk::EntryPaste %W %x } } @@ -286,18 +287,12 @@ bind Entry <Meta-Delete> { bind Entry <2> { if {!$tk_strictMotif} { - %W scan mark %x - set tk::Priv(x) %x - set tk::Priv(y) %y - set tk::Priv(mouseMoved) 0 + ::tk::EntryScanMark %W %x } } bind Entry <B2-Motion> { if {!$tk_strictMotif} { - if {abs(%x-$tk::Priv(x)) > 2} { - set tk::Priv(mouseMoved) 1 - } - %W scan dragto %x + ::tk::EntryScanDrag %W %x } } @@ -549,7 +544,8 @@ proc ::tk::EntryTranspose w { if {$first < 0} { return } - set new [string index [$w get] [expr {$i-1}]][string index [$w get] $first] + set data [$w get] + set new [string index $data [expr {$i-1}]][string index $data $first] $w delete $first $i $w insert insert $new EntrySeeInsert $w @@ -602,6 +598,41 @@ proc ::tk::EntryPreviousWord {w start} { } return $pos } + +# ::tk::EntryScanMark -- +# +# Marks the start of a possible scan drag operation +# +# Arguments: +# w - The entry window from which the text to get +# x - x location on screen + +proc ::tk::EntryScanMark {w x} { + $w scan mark $x + set ::tk::Priv(x) $x + set ::tk::Priv(y) 0 ; # not used + set ::tk::Priv(mouseMoved) 0 +} + +# ::tk::EntryScanDrag -- +# +# Marks the start of a possible scan drag operation +# +# Arguments: +# w - The entry window from which the text to get +# x - x location on screen + +proc ::tk::EntryScanDrag {w x} { + # Make sure these exist, as some weird situations can trigger the + # motion binding without the initial press. [Bug #220269] + if {![info exists ::tk::Priv(x)]} { set ::tk::Priv(x) $x } + # allow for a delta + if {abs($x-$::tk::Priv(x)) > 2} { + set ::tk::Priv(mouseMoved) 1 + } + $w scan dragto $x +} + # ::tk::EntryGetSelection -- # # Returns the selected text of the entry with respect to the -show option. @@ -613,7 +644,8 @@ proc ::tk::EntryGetSelection {w} { set entryString [string range [$w get] [$w index sel.first] \ [expr {[$w index sel.last] - 1}]] if {[string compare [$w cget -show] ""]} { - regsub -all . $entryString [string index [$w cget -show] 0] entryString + return [string repeat [string index [$w cget -show] 0] \ + [string length $entryString]] } return $entryString } diff --git a/library/spinbox.tcl b/library/spinbox.tcl index 666e500..8967347 100644 --- a/library/spinbox.tcl +++ b/library/spinbox.tcl @@ -1,9 +1,10 @@ # spinbox.tcl -- # # This file defines the default bindings for Tk spinbox widgets and provides -# procedures that help in implementing those bindings. +# procedures that help in implementing those bindings. The spinbox builds +# off the entry widget, so it can reuse Entry bindings and procedures. # -# RCS: @(#) $Id: spinbox.tcl,v 1.3 2001/08/01 16:21:11 dgp Exp $ +# RCS: @(#) $Id: spinbox.tcl,v 1.4 2001/12/27 22:26:41 hobbs Exp $ # # Copyright (c) 1992-1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. @@ -61,14 +62,15 @@ bind Spinbox <<Paste>> { } } %W insert insert [::tk::GetSelection %W CLIPBOARD] - ::tk::spinbox::SeeInsert %W + ::tk::EntrySeeInsert %W } } bind Spinbox <<Clear>> { %W delete sel.first sel.last } bind Spinbox <<PasteSelection>> { - if {!$tk::Priv(mouseMoved) || $tk_strictMotif} { + if {$tk_strictMotif || ![info exists tk::Priv(mouseMoved)] + || !$tk::Priv(mouseMoved)} { ::tk::spinbox::Paste %W %x } } @@ -123,46 +125,46 @@ bind Spinbox <Down> { } bind Spinbox <Left> { - ::tk::spinbox::SetCursor %W [expr {[%W index insert] - 1}] + ::tk::EntrySetCursor %W [expr {[%W index insert] - 1}] } bind Spinbox <Right> { - ::tk::spinbox::SetCursor %W [expr {[%W index insert] + 1}] + ::tk::EntrySetCursor %W [expr {[%W index insert] + 1}] } bind Spinbox <Shift-Left> { - ::tk::spinbox::KeySelect %W [expr {[%W index insert] - 1}] - ::tk::spinbox::SeeInsert %W + ::tk::EntryKeySelect %W [expr {[%W index insert] - 1}] + ::tk::EntrySeeInsert %W } bind Spinbox <Shift-Right> { - ::tk::spinbox::KeySelect %W [expr {[%W index insert] + 1}] - ::tk::spinbox::SeeInsert %W + ::tk::EntryKeySelect %W [expr {[%W index insert] + 1}] + ::tk::EntrySeeInsert %W } bind Spinbox <Control-Left> { - ::tk::spinbox::SetCursor %W [::tk::spinbox::PreviousWord %W insert] + ::tk::EntrySetCursor %W [::tk::EntryPreviousWord %W insert] } bind Spinbox <Control-Right> { - ::tk::spinbox::SetCursor %W [::tk::spinbox::NextWord %W insert] + ::tk::EntrySetCursor %W [::tk::EntryNextWord %W insert] } bind Spinbox <Shift-Control-Left> { - ::tk::spinbox::KeySelect %W [::tk::spinbox::PreviousWord %W insert] - ::tk::spinbox::SeeInsert %W + ::tk::EntryKeySelect %W [::tk::EntryPreviousWord %W insert] + ::tk::EntrySeeInsert %W } bind Spinbox <Shift-Control-Right> { - ::tk::spinbox::KeySelect %W [::tk::spinbox::NextWord %W insert] - ::tk::spinbox::SeeInsert %W + ::tk::EntryKeySelect %W [::tk::EntryNextWord %W insert] + ::tk::EntrySeeInsert %W } bind Spinbox <Home> { - ::tk::spinbox::SetCursor %W 0 + ::tk::EntrySetCursor %W 0 } bind Spinbox <Shift-Home> { - ::tk::spinbox::KeySelect %W 0 - ::tk::spinbox::SeeInsert %W + ::tk::EntryKeySelect %W 0 + ::tk::EntrySeeInsert %W } bind Spinbox <End> { - ::tk::spinbox::SetCursor %W end + ::tk::EntrySetCursor %W end } bind Spinbox <Shift-End> { - ::tk::spinbox::KeySelect %W end - ::tk::spinbox::SeeInsert %W + ::tk::EntryKeySelect %W end + ::tk::EntrySeeInsert %W } bind Spinbox <Delete> { @@ -173,7 +175,7 @@ bind Spinbox <Delete> { } } bind Spinbox <BackSpace> { - ::tk::spinbox::Backspace %W + ::tk::EntryBackspace %W } bind Spinbox <Control-space> { @@ -195,7 +197,7 @@ bind Spinbox <Control-backslash> { %W selection clear } bind Spinbox <KeyPress> { - ::tk::spinbox::Insert %W %A + ::tk::EntryInsert %W %A } # Ignore all Alt, Meta, and Control keypresses unless explicitly bound. @@ -218,7 +220,7 @@ if {[string equal $tcl_platform(platform) "macintosh"]} { # generates the <<Paste>> event, so we don't need to do anything here. if {[string compare $tcl_platform(platform) "windows"]} { bind Spinbox <Insert> { - catch {::tk::spinbox::Insert %W [::tk::GetSelection %W PRIMARY]} + catch {::tk::EntryInsert %W [::tk::GetSelection %W PRIMARY]} } } @@ -226,12 +228,12 @@ if {[string compare $tcl_platform(platform) "windows"]} { bind Spinbox <Control-a> { if {!$tk_strictMotif} { - ::tk::spinbox::SetCursor %W 0 + ::tk::EntrySetCursor %W 0 } } bind Spinbox <Control-b> { if {!$tk_strictMotif} { - ::tk::spinbox::SetCursor %W [expr {[%W index insert] - 1}] + ::tk::EntrySetCursor %W [expr {[%W index insert] - 1}] } } bind Spinbox <Control-d> { @@ -241,17 +243,17 @@ bind Spinbox <Control-d> { } bind Spinbox <Control-e> { if {!$tk_strictMotif} { - ::tk::spinbox::SetCursor %W end + ::tk::EntrySetCursor %W end } } bind Spinbox <Control-f> { if {!$tk_strictMotif} { - ::tk::spinbox::SetCursor %W [expr {[%W index insert] + 1}] + ::tk::EntrySetCursor %W [expr {[%W index insert] + 1}] } } bind Spinbox <Control-h> { if {!$tk_strictMotif} { - ::tk::spinbox::Backspace %W + ::tk::EntryBackspace %W } } bind Spinbox <Control-k> { @@ -261,32 +263,32 @@ bind Spinbox <Control-k> { } bind Spinbox <Control-t> { if {!$tk_strictMotif} { - ::tk::spinbox::Transpose %W + ::tk::EntryTranspose %W } } bind Spinbox <Meta-b> { if {!$tk_strictMotif} { - ::tk::spinbox::SetCursor %W [::tk::spinbox::PreviousWord %W insert] + ::tk::EntrySetCursor %W [::tk::EntryPreviousWord %W insert] } } bind Spinbox <Meta-d> { if {!$tk_strictMotif} { - %W delete insert [::tk::spinbox::NextWord %W insert] + %W delete insert [::tk::EntryNextWord %W insert] } } bind Spinbox <Meta-f> { if {!$tk_strictMotif} { - ::tk::spinbox::SetCursor %W [::tk::spinbox::NextWord %W insert] + ::tk::EntrySetCursor %W [::tk::EntryNextWord %W insert] } } bind Spinbox <Meta-BackSpace> { if {!$tk_strictMotif} { - %W delete [::tk::spinbox::PreviousWord %W insert] insert + %W delete [::tk::EntryPreviousWord %W insert] insert } } bind Spinbox <Meta-Delete> { if {!$tk_strictMotif} { - %W delete [::tk::spinbox::PreviousWord %W insert] insert + %W delete [::tk::EntryPreviousWord %W insert] insert } } @@ -294,18 +296,12 @@ bind Spinbox <Meta-Delete> { bind Spinbox <2> { if {!$tk_strictMotif} { - %W scan mark %x - set tk::Priv(x) %x - set tk::Priv(y) %y - set tk::Priv(mouseMoved) 0 + ::tk::EntryScanMark %W %x } } bind Spinbox <B2-Motion> { if {!$tk_strictMotif} { - if {abs(%x-$tk::Priv(x)) > 2} { - set tk::Priv(mouseMoved) 1 - } - %W scan dragto %x + ::tk::EntryScanDrag %W %x } } @@ -374,7 +370,7 @@ proc ::tk::spinbox::ButtonDown {w x y} { $w selection element $Priv(element) set Priv(repeated) 0 set Priv(relief) [$w cget -$Priv(element)relief] - after cancel $Priv(afterId) + catch {after cancel $Priv(afterId)} set delay [$w cget -repeatdelay] if {$delay > 0} { set Priv(afterId) [after $delay \ @@ -501,7 +497,6 @@ proc ::tk::spinbox::MouseSelect {w x {cursor {}}} { # x - X position of the mouse. proc ::tk::spinbox::Paste {w x} { - $w icursor [::tk::spinbox::ClosestGap $w $x] catch {$w insert insert [::tk::GetSelection $w PRIMARY]} if {[string equal "disabled" [$w cget -state]]} {focus $w} @@ -562,179 +557,10 @@ proc ::tk::spinbox::AutoScan {w} { set Priv(afterId) [after 50 [list ::tk::spinbox::AutoScan $w]] } -# ::tk::spinbox::KeySelect -- -# This procedure is invoked when stroking out selections using the -# keyboard. It moves the cursor to a new position, then extends -# the selection to that position. -# -# Arguments: -# w - The spinbox window. -# new - A new position for the insertion cursor (the cursor hasn't -# actually been moved to this position yet). - -proc ::tk::spinbox::KeySelect {w new} { - if {![$w selection present]} { - $w selection from insert - $w selection to $new - } else { - $w selection adjust $new - } - $w icursor $new -} - -# ::tk::spinbox::Insert -- -# Insert a string into an spinbox at the point of the insertion cursor. -# If there is a selection in the spinbox, and it covers the point of the -# insertion cursor, then delete the selection before inserting. -# -# Arguments: -# w - The spinbox window in which to insert the string -# s - The string to insert (usually just a single character) - -proc ::tk::spinbox::Insert {w s} { - if {$s == ""} { - return - } - catch { - set insert [$w index insert] - if {([$w index sel.first] <= $insert) \ - && ([$w index sel.last] >= $insert)} { - $w delete sel.first sel.last - } - } - $w insert insert $s - ::tk::spinbox::SeeInsert $w -} - -# ::tk::spinbox::Backspace -- -# Backspace over the character just before the insertion cursor. -# If backspacing would move the cursor off the left edge of the -# window, reposition the cursor at about the middle of the window. -# -# Arguments: -# w - The spinbox window in which to backspace. - -proc ::tk::spinbox::Backspace w { - if {[$w selection present]} { - $w delete sel.first sel.last - } else { - set x [expr {[$w index insert] - 1}] - if {$x >= 0} {$w delete $x} - if {[$w index @0] >= [$w index insert]} { - set range [$w xview] - set left [lindex $range 0] - set right [lindex $range 1] - $w xview moveto [expr {$left - ($right - $left)/2.0}] - } - } -} - -# ::tk::spinbox::SeeInsert -- -# Make sure that the insertion cursor is visible in the spinbox window. -# If not, adjust the view so that it is. -# -# Arguments: -# w - The spinbox window. - -proc ::tk::spinbox::SeeInsert w { - set c [$w index insert] - if {($c < [$w index @0]) || ($c > [$w index @[winfo width $w]])} { - $w xview $c - } -} - -# ::tk::spinbox::SetCursor - -# Move the insertion cursor to a given position in an spinbox. Also -# clears the selection, if there is one in the spinbox, and makes sure -# that the insertion cursor is visible. -# -# Arguments: -# w - The spinbox window. -# pos - The desired new position for the cursor in the window. - -proc ::tk::spinbox::SetCursor {w pos} { - $w icursor $pos - $w selection clear - ::tk::spinbox::SeeInsert $w -} - -# ::tk::spinbox::Transpose - -# This procedure implements the "transpose" function for spinbox widgets. -# It tranposes the characters on either side of the insertion cursor, -# unless the cursor is at the end of the line. In this case it -# transposes the two characters to the left of the cursor. In either -# case, the cursor ends up to the right of the transposed characters. -# -# Arguments: -# w - The spinbox window. - -proc ::tk::spinbox::Transpose w { - set i [$w index insert] - if {$i < [$w index end]} { - incr i - } - set first [expr {$i-2}] - if {$first < 0} { - return - } - set data [$w get] - set new [string index $data [expr {$i-1}]][string index $data $first] - $w delete $first $i - $w insert insert $new - ::tk::spinbox::SeeInsert $w -} - -# ::tk::spinbox::NextWord -- -# Returns the index of the next word position after a given position in the -# spinbox. The next word is platform dependent and may be either the next -# end-of-word position or the next start-of-word position after the next -# end-of-word position. -# -# Arguments: -# w - The spinbox window in which the cursor is to move. -# start - Position at which to start search. - -if {[string equal $tcl_platform(platform) "windows"]} { - proc ::tk::spinbox::NextWord {w start} { - set pos [tcl_endOfWord [$w get] [$w index $start]] - if {$pos >= 0} { - set pos [tcl_startOfNextWord [$w get] $pos] - } - if {$pos < 0} { - return end - } - return $pos - } -} else { - proc ::tk::spinbox::NextWord {w start} { - set pos [tcl_endOfWord [$w get] [$w index $start]] - if {$pos < 0} { - return end - } - return $pos - } -} - -# ::tk::spinbox::PreviousWord -- -# -# Returns the index of the previous word position before a given -# position in the spinbox. -# -# Arguments: -# w - The spinbox window in which the cursor is to move. -# start - Position at which to start search. - -proc ::tk::spinbox::PreviousWord {w start} { - set pos [tcl_startOfPreviousWord [$w get] [$w index $start]] - if {$pos < 0} { - return 0 - } - return $pos -} - # ::tk::spinbox::GetSelection -- # -# Returns the selected text of the spinbox. +# Returns the selected text of the spinbox. Differs from entry in that +# a spinbox has no -show option to obscure contents. # # Arguments: # w - The spinbox window from which the text to get diff --git a/library/text.tcl b/library/text.tcl index c1a2b54..988466d 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.18 2001/11/13 00:19:05 hobbs Exp $ +# RCS: @(#) $Id: text.tcl,v 1.19 2001/12/27 22:26:41 hobbs Exp $ # # Copyright (c) 1992-1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. @@ -256,7 +256,8 @@ bind Text <<Clear>> { catch {%W delete sel.first sel.last} } bind Text <<PasteSelection>> { - if {!$tk::Priv(mouseMoved) || $tk_strictMotif} { + if {$tk_strictMotif || ![info exists tk::Priv(mouseMoved)] + || !$tk::Priv(mouseMoved)} { tk::TextPaste %W %x %y } } @@ -447,20 +448,12 @@ bind Text <Control-h> { } bind Text <2> { if {!$tk_strictMotif} { - %W scan mark %x %y - set tk::Priv(x) %x - set tk::Priv(y) %y - set tk::Priv(mouseMoved) 0 + tk::TextScanMark %W %x %y } } bind Text <B2-Motion> { if {!$tk_strictMotif} { - if {(%x != $tk::Priv(x)) || (%y != $tk::Priv(y))} { - set tk::Priv(mouseMoved) 1 - } - if {$tk::Priv(mouseMoved)} { - %W scan dragto %x %y - } + tk::TextScanDrag %W %x %y } } set ::tk::Priv(prevPos) {} @@ -1104,3 +1097,41 @@ proc ::tk::TextPrevPos {w start op} { } return 0.0 } + +# ::tk::TextScanMark -- +# +# Marks the start of a possible scan drag operation +# +# Arguments: +# w - The text window from which the text to get +# x - x location on screen +# y - y location on screen + +proc ::tk::TextScanMark {w x y} { + $w scan mark $x $y + set ::tk::Priv(x) $x + set ::tk::Priv(y) $y + set ::tk::Priv(mouseMoved) 0 +} + +# ::tk::TextScanDrag -- +# +# Marks the start of a possible scan drag operation +# +# Arguments: +# w - The text window from which the text to get +# x - x location on screen +# y - y location on screen + +proc ::tk::TextScanDrag {w x y} { + # Make sure these exist, as some weird situations can trigger the + # motion binding without the initial press. [Bug #220269] + if {![info exists ::tk::Priv(x)]} { set ::tk::Priv(x) $x } + if {![info exists ::tk::Priv(y)]} { set ::tk::Priv(y) $y } + if {($x != $::tk::Priv(x)) || ($y != $::tk::Priv(y))} { + set ::tk::Priv(mouseMoved) 1 + } + if {[info exists ::tk::Priv(mouseMoved)] && $::tk::Priv(mouseMoved)} { + $w scan dragto $x $y + } +} |