diff options
Diffstat (limited to 'library/spinbox.tcl')
| -rw-r--r-- | library/spinbox.tcl | 746 |
1 files changed, 746 insertions, 0 deletions
diff --git a/library/spinbox.tcl b/library/spinbox.tcl new file mode 100644 index 0000000..b93479b --- /dev/null +++ b/library/spinbox.tcl @@ -0,0 +1,746 @@ +# spinbox.tcl -- +# +# This file defines the default bindings for Tk spinbox widgets and provides +# procedures that help in implementing those bindings. +# +# RCS: @(#) $Id: spinbox.tcl,v 1.1 2000/05/29 01:43:15 hobbs Exp $ +# +# Copyright (c) 1992-1994 The Regents of the University of California. +# Copyright (c) 1994-1997 Sun Microsystems, Inc. +# Copyright (c) 1999-2000 Jeffrey Hobbs +# Copyright (c) 2000 Ajuba Solutions +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# + +#------------------------------------------------------------------------- +# Elements of tkPriv that are used in this file: +# +# afterId - If non-null, it means that auto-scanning is underway +# and it gives the "after" id for the next auto-scan +# command to be executed. +# mouseMoved - Non-zero means the mouse has moved a significant +# amount since the button went down (so, for example, +# start dragging out a selection). +# pressX - X-coordinate at which the mouse button was pressed. +# selectMode - The style of selection currently underway: +# char, word, or line. +# x, y - Last known mouse coordinates for scanning +# and auto-scanning. +# data - Used for Cut and Copy +#------------------------------------------------------------------------- + +# Initialize namespace +namespace eval ::tk::spinbox {} + +#------------------------------------------------------------------------- +# The code below creates the default class bindings for entries. +#------------------------------------------------------------------------- +bind Spinbox <<Cut>> { + if {![catch {::tk::spinbox::GetSelection %W} tkPriv(data)]} { + clipboard clear -displayof %W + clipboard append -displayof %W $tkPriv(data) + %W delete sel.first sel.last + unset tkPriv(data) + } +} +bind Spinbox <<Copy>> { + if {![catch {::tk::spinbox::GetSelection %W} tkPriv(data)]} { + clipboard clear -displayof %W + clipboard append -displayof %W $tkPriv(data) + unset tkPriv(data) + } +} +bind Spinbox <<Paste>> { + global tcl_platform + catch { + if {[string compare $tcl_platform(platform) "unix"]} { + catch { + %W delete sel.first sel.last + } + } + %W insert insert [selection get -displayof %W -selection CLIPBOARD] + ::tk::spinbox::SeeInsert %W + } +} +bind Spinbox <<Clear>> { + %W delete sel.first sel.last +} +bind Spinbox <<PasteSelection>> { + if {!$tkPriv(mouseMoved) || $tk_strictMotif} { + ::tk::spinbox::Paste %W %x + } +} + +# Standard Motif bindings: + +bind Spinbox <1> { + ::tk::spinbox::ButtonDown %W %x %y +} +bind Spinbox <B1-Motion> { + ::tk::spinbox::Motion %W %x %y +} +bind Spinbox <Double-1> { + set tkPriv(selectMode) word + ::tk::spinbox::MouseSelect %W %x sel.first +} +bind Spinbox <Triple-1> { + set tkPriv(selectMode) line + ::tk::spinbox::MouseSelect %W %x 0 +} +bind Spinbox <Shift-1> { + set tkPriv(selectMode) char + %W selection adjust @%x +} +bind Spinbox <Double-Shift-1> { + set tkPriv(selectMode) word + ::tk::spinbox::MouseSelect %W %x +} +bind Spinbox <Triple-Shift-1> { + set tkPriv(selectMode) line + ::tk::spinbox::MouseSelect %W %x +} +bind Spinbox <B1-Leave> { + set tkPriv(x) %x + ::tk::spinbox::AutoScan %W +} +bind Spinbox <B1-Enter> { + tkCancelRepeat +} +bind Spinbox <ButtonRelease-1> { + ::tk::spinbox::ButtonUp %W %x %y +} +bind Spinbox <Control-1> { + %W icursor @%x +} + +bind Spinbox <Up> { + %W invoke buttonup +} +bind Spinbox <Down> { + %W invoke buttondown +} + +bind Spinbox <Left> { + ::tk::spinbox::SetCursor %W [expr {[%W index insert] - 1}] +} +bind Spinbox <Right> { + ::tk::spinbox::SetCursor %W [expr {[%W index insert] + 1}] +} +bind Spinbox <Shift-Left> { + ::tk::spinbox::KeySelect %W [expr {[%W index insert] - 1}] + ::tk::spinbox::SeeInsert %W +} +bind Spinbox <Shift-Right> { + ::tk::spinbox::KeySelect %W [expr {[%W index insert] + 1}] + ::tk::spinbox::SeeInsert %W +} +bind Spinbox <Control-Left> { + ::tk::spinbox::SetCursor %W [::tk::spinbox::PreviousWord %W insert] +} +bind Spinbox <Control-Right> { + ::tk::spinbox::SetCursor %W [::tk::spinbox::NextWord %W insert] +} +bind Spinbox <Shift-Control-Left> { + ::tk::spinbox::KeySelect %W [::tk::spinbox::PreviousWord %W insert] + ::tk::spinbox::SeeInsert %W +} +bind Spinbox <Shift-Control-Right> { + ::tk::spinbox::KeySelect %W [::tk::spinbox::NextWord %W insert] + ::tk::spinbox::SeeInsert %W +} +bind Spinbox <Home> { + ::tk::spinbox::SetCursor %W 0 +} +bind Spinbox <Shift-Home> { + ::tk::spinbox::KeySelect %W 0 + ::tk::spinbox::SeeInsert %W +} +bind Spinbox <End> { + ::tk::spinbox::SetCursor %W end +} +bind Spinbox <Shift-End> { + ::tk::spinbox::KeySelect %W end + ::tk::spinbox::SeeInsert %W +} + +bind Spinbox <Delete> { + if {[%W selection present]} { + %W delete sel.first sel.last + } else { + %W delete insert + } +} +bind Spinbox <BackSpace> { + ::tk::spinbox::Backspace %W +} + +bind Spinbox <Control-space> { + %W selection from insert +} +bind Spinbox <Select> { + %W selection from insert +} +bind Spinbox <Control-Shift-space> { + %W selection adjust insert +} +bind Spinbox <Shift-Select> { + %W selection adjust insert +} +bind Spinbox <Control-slash> { + %W selection range 0 end +} +bind Spinbox <Control-backslash> { + %W selection clear +} +bind Spinbox <KeyPress> { + ::tk::spinbox::Insert %W %A +} + +# Ignore all Alt, Meta, and Control keypresses unless explicitly bound. +# Otherwise, if a widget binding for one of these is defined, the +# <KeyPress> class binding will also fire and insert the character, +# which is wrong. Ditto for Escape, Return, and Tab. + +bind Spinbox <Alt-KeyPress> {# nothing} +bind Spinbox <Meta-KeyPress> {# nothing} +bind Spinbox <Control-KeyPress> {# nothing} +bind Spinbox <Escape> {# nothing} +bind Spinbox <Return> {# nothing} +bind Spinbox <KP_Enter> {# nothing} +bind Spinbox <Tab> {# nothing} +if {[string equal $tcl_platform(platform) "macintosh"]} { + bind Spinbox <Command-KeyPress> {# nothing} +} + +# On Windows, paste is done using Shift-Insert. Shift-Insert already +# 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 [selection get -displayof %W]} + } +} + +# Additional emacs-like bindings: + +bind Spinbox <Control-a> { + if {!$tk_strictMotif} { + ::tk::spinbox::SetCursor %W 0 + } +} +bind Spinbox <Control-b> { + if {!$tk_strictMotif} { + ::tk::spinbox::SetCursor %W [expr {[%W index insert] - 1}] + } +} +bind Spinbox <Control-d> { + if {!$tk_strictMotif} { + %W delete insert + } +} +bind Spinbox <Control-e> { + if {!$tk_strictMotif} { + ::tk::spinbox::SetCursor %W end + } +} +bind Spinbox <Control-f> { + if {!$tk_strictMotif} { + ::tk::spinbox::SetCursor %W [expr {[%W index insert] + 1}] + } +} +bind Spinbox <Control-h> { + if {!$tk_strictMotif} { + ::tk::spinbox::Backspace %W + } +} +bind Spinbox <Control-k> { + if {!$tk_strictMotif} { + %W delete insert end + } +} +bind Spinbox <Control-t> { + if {!$tk_strictMotif} { + ::tk::spinbox::Transpose %W + } +} +bind Spinbox <Meta-b> { + if {!$tk_strictMotif} { + ::tk::spinbox::SetCursor %W [::tk::spinbox::PreviousWord %W insert] + } +} +bind Spinbox <Meta-d> { + if {!$tk_strictMotif} { + %W delete insert [::tk::spinbox::NextWord %W insert] + } +} +bind Spinbox <Meta-f> { + if {!$tk_strictMotif} { + ::tk::spinbox::SetCursor %W [::tk::spinbox::NextWord %W insert] + } +} +bind Spinbox <Meta-BackSpace> { + if {!$tk_strictMotif} { + %W delete [::tk::spinbox::PreviousWord %W insert] insert + } +} +bind Spinbox <Meta-Delete> { + if {!$tk_strictMotif} { + %W delete [::tk::spinbox::PreviousWord %W insert] insert + } +} + +# A few additional bindings of my own. + +bind Spinbox <2> { + if {!$tk_strictMotif} { + %W scan mark %x + set tkPriv(x) %x + set tkPriv(y) %y + set tkPriv(mouseMoved) 0 + } +} +bind Spinbox <B2-Motion> { + if {!$tk_strictMotif} { + if {abs(%x-$tkPriv(x)) > 2} { + set tkPriv(mouseMoved) 1 + } + %W scan dragto %x + } +} + +# ::tk::spinbox::Invoke -- +# Invoke an element of the spinbox +# +# Arguments: +# w - The spinbox window. +# elem - Element to invoke + +proc ::tk::spinbox::Invoke {w elem} { + global tkPriv + + if {![info exists tkPriv(outsideElement)]} { + $w invoke $elem + incr tkPriv(repeated) + } + set delay [$w cget -repeatinterval] + if {$delay > 0} { + set tkPriv(afterId) [after $delay \ + [list ::tk::spinbox::Invoke $w $elem]] + } +} + +# ::tk::spinbox::ClosestGap -- +# Given x and y coordinates, this procedure finds the closest boundary +# between characters to the given coordinates and returns the index +# of the character just after the boundary. +# +# Arguments: +# w - The spinbox window. +# x - X-coordinate within the window. + +proc ::tk::spinbox::ClosestGap {w x} { + set pos [$w index @$x] + set bbox [$w bbox $pos] + if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} { + return $pos + } + incr pos +} + +# ::tk::spinbox::ButtonDown -- +# This procedure is invoked to handle button-1 presses in spinbox +# widgets. It moves the insertion cursor, sets the selection anchor, +# and claims the input focus. +# +# Arguments: +# w - The spinbox window in which the button was pressed. +# x - The x-coordinate of the button press. + +proc ::tk::spinbox::ButtonDown {w x y} { + global tkPriv + + # Get the element that was clicked in. If we are not directly over + # the spinbox, default to entry. This is necessary for spinbox grabs. + # + set tkPriv(element) [$w identify $x $y] + if {$tkPriv(element) eq ""} { + set tkPriv(element) "entry" + } + + switch -exact $tkPriv(element) { + "buttonup" - "buttondown" { + if {[string compare "disabled" [$w cget -state]]} { + $w selection element $tkPriv(element) + set tkPriv(repeated) 0 + set tkPriv(relief) [$w cget -$tkPriv(element)relief] + after cancel $tkPriv(afterId) + set delay [$w cget -repeatdelay] + if {$delay > 0} { + set tkPriv(afterId) [after $delay \ + [list ::tk::spinbox::Invoke $w $tkPriv(element)]] + } + if {[info exists tkPriv(outsideElement)]} { + unset tkPriv(outsideElement) + } + } + } + "entry" { + set tkPriv(selectMode) char + set tkPriv(mouseMoved) 0 + set tkPriv(pressX) $x + $w icursor [::tk::spinbox::ClosestGap $w $x] + $w selection from insert + if {[string compare "disabled" [$w cget -state]]} {focus $w} + $w selection clear + } + default { + return -code error "unknown spinbox element \"$tkPriv(element)\"" + } + } +} + +# ::tk::spinbox::ButtonUp -- +# This procedure is invoked to handle button-1 releases in spinbox +# widgets. +# +# Arguments: +# w - The spinbox window in which the button was pressed. +# x - The x-coordinate of the button press. + +proc ::tk::spinbox::ButtonUp {w x y} { + global tkPriv + + tkCancelRepeat + + # tkPriv(relief) may not exist if the ButtonUp is not paired with + # a preceding ButtonDown + if {[info exists tkPriv(element)] && [info exists tkPriv(relief)] && \ + [string match "button*" $tkPriv(element)]} { + if {[info exists tkPriv(repeated)] && !$tkPriv(repeated)} { + $w invoke $tkPriv(element) + } + $w configure -$tkPriv(element)relief $tkPriv(relief) + $w selection element none + } +} + +# ::tk::spinbox::MouseSelect -- +# This procedure is invoked when dragging out a selection with +# the mouse. Depending on the selection mode (character, word, +# line) it selects in different-sized units. This procedure +# ignores mouse motions initially until the mouse has moved from +# one character to another or until there have been multiple clicks. +# +# Arguments: +# w - The spinbox window in which the button was pressed. +# x - The x-coordinate of the mouse. +# cursor - optional place to set cursor. + +proc ::tk::spinbox::MouseSelect {w x {cursor {}}} { + global tkPriv + + if {[string compare "entry" $tkPriv(element)]} { + if {[string compare "none" $tkPriv(element)] && \ + [string compare "ignore" $cursor]} { + $w selection element none + $w invoke $tkPriv(element) + $w selection element $tkPriv(element) + } + return + } + set cur [::tk::spinbox::ClosestGap $w $x] + set anchor [$w index anchor] + if {($cur != $anchor) || (abs($tkPriv(pressX) - $x) >= 3)} { + set tkPriv(mouseMoved) 1 + } + switch $tkPriv(selectMode) { + char { + if {$tkPriv(mouseMoved)} { + if {$cur < $anchor} { + $w selection range $cur $anchor + } elseif {$cur > $anchor} { + $w selection range $anchor $cur + } else { + $w selection clear + } + } + } + word { + if {$cur < [$w index anchor]} { + set before [tcl_wordBreakBefore [$w get] $cur] + set after [tcl_wordBreakAfter [$w get] [expr {$anchor-1}]] + } else { + set before [tcl_wordBreakBefore [$w get] $anchor] + set after [tcl_wordBreakAfter [$w get] [expr {$cur - 1}]] + } + if {$before < 0} { + set before 0 + } + if {$after < 0} { + set after end + } + $w selection range $before $after + } + line { + $w selection range 0 end + } + } + if {[string compare $cursor {}] && [string compare $cursor "ignore"]} { + catch {$w icursor $cursor} + } + update idletasks +} + +# ::tk::spinbox::Paste -- +# This procedure sets the insertion cursor to the current mouse position, +# pastes the selection there, and sets the focus to the window. +# +# Arguments: +# w - The spinbox window. +# x - X position of the mouse. + +proc ::tk::spinbox::Paste {w x} { + global tkPriv + + $w icursor [::tk::spinbox::ClosestGap $w $x] + catch {$w insert insert [selection get -displayof $w]} + if {[string equal "disabled" [$w cget -state]]} {focus $w} +} + +# ::tk::spinbox::Motion -- +# This procedure is invoked when the mouse moves in a spinbox window +# with button 1 down. +# +# Arguments: +# w - The spinbox window. + +proc ::tk::spinbox::Motion {w x y} { + global tkPriv + + if {![info exists tkPriv(element)]} { + set tkPriv(element) [$w identify $x $y] + } + + set tkPriv(x) $x + if {[string equal "entry" $tkPriv(element)]} { + ::tk::spinbox::MouseSelect $w $x ignore + } elseif {[string compare [$w identify $x $y] $tkPriv(element)]} { + if {![info exists tkPriv(outsideElement)]} { + # We've wandered out of the spin button + # setting outside element will cause ::tk::spinbox::Invoke to + # loop without doing anything + set tkPriv(outsideElement) "" + $w selection element none + } + } elseif {[info exists tkPriv(outsideElement)]} { + unset tkPriv(outsideElement) + $w selection element $tkPriv(element) + } +} + +# ::tk::spinbox::AutoScan -- +# This procedure is invoked when the mouse leaves an spinbox window +# with button 1 down. It scrolls the window left or right, +# depending on where the mouse is, and reschedules itself as an +# "after" command so that the window continues to scroll until the +# mouse moves back into the window or the mouse button is released. +# +# Arguments: +# w - The spinbox window. + +proc ::tk::spinbox::AutoScan {w} { + global tkPriv + + set x $tkPriv(x) + if {$x >= [winfo width $w]} { + $w xview scroll 2 units + ::tk::spinbox::MouseSelect $w $x ignore + } elseif {$x < 0} { + $w xview scroll -2 units + ::tk::spinbox::MouseSelect $w $x ignore + } + set tkPriv(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. +# +# Arguments: +# w - The spinbox window from which the text to get + +proc ::tk::spinbox::GetSelection {w} { + return [string range [$w get] [$w index sel.first] \ + [expr {[$w index sel.last] - 1}]] +} |