| # spinbox.tcl -- |
| # |
| # This file defines the default bindings for Tk spinbox widgets and provides |
| # 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 2003/01/21 20:24:46 hunt 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 tk::Priv 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} tk::Priv(data)]} { |
| clipboard clear -displayof %W |
| clipboard append -displayof %W $tk::Priv(data) |
| %W delete sel.first sel.last |
| unset tk::Priv(data) |
| } |
| } |
| bind Spinbox <<Copy>> { |
| if {![catch {::tk::spinbox::GetSelection %W} tk::Priv(data)]} { |
| clipboard clear -displayof %W |
| clipboard append -displayof %W $tk::Priv(data) |
| unset tk::Priv(data) |
| } |
| } |
| bind Spinbox <<Paste>> { |
| global tcl_platform |
| catch { |
| if {[tk windowingsystem] ne "x11"} { |
| catch { |
| %W delete sel.first sel.last |
| } |
| } |
| %W insert insert [::tk::GetSelection %W CLIPBOARD] |
| ::tk::EntrySeeInsert %W |
| } |
| } |
| bind Spinbox <<Clear>> { |
| %W delete sel.first sel.last |
| } |
| bind Spinbox <<PasteSelection>> { |
| if {$tk_strictMotif || ![info exists tk::Priv(mouseMoved)] |
| || !$tk::Priv(mouseMoved)} { |
| ::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 tk::Priv(selectMode) word |
| ::tk::spinbox::MouseSelect %W %x sel.first |
| } |
| bind Spinbox <Triple-1> { |
| set tk::Priv(selectMode) line |
| ::tk::spinbox::MouseSelect %W %x 0 |
| } |
| bind Spinbox <Shift-1> { |
| set tk::Priv(selectMode) char |
| %W selection adjust @%x |
| } |
| bind Spinbox <Double-Shift-1> { |
| set tk::Priv(selectMode) word |
| ::tk::spinbox::MouseSelect %W %x |
| } |
| bind Spinbox <Triple-Shift-1> { |
| set tk::Priv(selectMode) line |
| ::tk::spinbox::MouseSelect %W %x |
| } |
| bind Spinbox <B1-Leave> { |
| set tk::Priv(x) %x |
| ::tk::spinbox::AutoScan %W |
| } |
| bind Spinbox <B1-Enter> { |
| tk::CancelRepeat |
| } |
| 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::EntrySetCursor %W [expr {[%W index insert] - 1}] |
| } |
| bind Spinbox <Right> { |
| ::tk::EntrySetCursor %W [expr {[%W index insert] + 1}] |
| } |
| bind Spinbox <Shift-Left> { |
| ::tk::EntryKeySelect %W [expr {[%W index insert] - 1}] |
| ::tk::EntrySeeInsert %W |
| } |
| bind Spinbox <Shift-Right> { |
| ::tk::EntryKeySelect %W [expr {[%W index insert] + 1}] |
| ::tk::EntrySeeInsert %W |
| } |
| bind Spinbox <Control-Left> { |
| ::tk::EntrySetCursor %W [::tk::EntryPreviousWord %W insert] |
| } |
| bind Spinbox <Control-Right> { |
| ::tk::EntrySetCursor %W [::tk::EntryNextWord %W insert] |
| } |
| bind Spinbox <Shift-Control-Left> { |
| ::tk::EntryKeySelect %W [::tk::EntryPreviousWord %W insert] |
| ::tk::EntrySeeInsert %W |
| } |
| bind Spinbox <Shift-Control-Right> { |
| ::tk::EntryKeySelect %W [::tk::EntryNextWord %W insert] |
| ::tk::EntrySeeInsert %W |
| } |
| bind Spinbox <Home> { |
| ::tk::EntrySetCursor %W 0 |
| } |
| bind Spinbox <Shift-Home> { |
| ::tk::EntryKeySelect %W 0 |
| ::tk::EntrySeeInsert %W |
| } |
| bind Spinbox <End> { |
| ::tk::EntrySetCursor %W end |
| } |
| bind Spinbox <Shift-End> { |
| ::tk::EntryKeySelect %W end |
| ::tk::EntrySeeInsert %W |
| } |
| |
| bind Spinbox <Delete> { |
| if {[%W selection present]} { |
| %W delete sel.first sel.last |
| } else { |
| %W delete insert |
| } |
| } |
| bind Spinbox <BackSpace> { |
| ::tk::EntryBackspace %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::EntryInsert %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 [tk windowingsystem] "classic"] |
| || [string equal [tk windowingsystem] "aqua"]} { |
| 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::EntryInsert %W [::tk::GetSelection %W PRIMARY]} |
| } |
| } |
| |
| # Additional emacs-like bindings: |
| |
| bind Spinbox <Control-a> { |
| if {!$tk_strictMotif} { |
| ::tk::EntrySetCursor %W 0 |
| } |
| } |
| bind Spinbox <Control-b> { |
| if {!$tk_strictMotif} { |
| ::tk::EntrySetCursor %W [expr {[%W index insert] - 1}] |
| } |
| } |
| bind Spinbox <Control-d> { |
| if {!$tk_strictMotif} { |
| %W delete insert |
| } |
| } |
| bind Spinbox <Control-e> { |
| if {!$tk_strictMotif} { |
| ::tk::EntrySetCursor %W end |
| } |
| } |
| bind Spinbox <Control-f> { |
| if {!$tk_strictMotif} { |
| ::tk::EntrySetCursor %W [expr {[%W index insert] + 1}] |
| } |
| } |
| bind Spinbox <Control-h> { |
| if {!$tk_strictMotif} { |
| ::tk::EntryBackspace %W |
| } |
| } |
| bind Spinbox <Control-k> { |
| if {!$tk_strictMotif} { |
| %W delete insert end |
| } |
| } |
| bind Spinbox <Control-t> { |
| if {!$tk_strictMotif} { |
| ::tk::EntryTranspose %W |
| } |
| } |
| bind Spinbox <Meta-b> { |
| if {!$tk_strictMotif} { |
| ::tk::EntrySetCursor %W [::tk::EntryPreviousWord %W insert] |
| } |
| } |
| bind Spinbox <Meta-d> { |
| if {!$tk_strictMotif} { |
| %W delete insert [::tk::EntryNextWord %W insert] |
| } |
| } |
| bind Spinbox <Meta-f> { |
| if {!$tk_strictMotif} { |
| ::tk::EntrySetCursor %W [::tk::EntryNextWord %W insert] |
| } |
| } |
| bind Spinbox <Meta-BackSpace> { |
| if {!$tk_strictMotif} { |
| %W delete [::tk::EntryPreviousWord %W insert] insert |
| } |
| } |
| bind Spinbox <Meta-Delete> { |
| if {!$tk_strictMotif} { |
| %W delete [::tk::EntryPreviousWord %W insert] insert |
| } |
| } |
| |
| # A few additional bindings of my own. |
| |
| bind Spinbox <2> { |
| if {!$tk_strictMotif} { |
| ::tk::EntryScanMark %W %x |
| } |
| } |
| bind Spinbox <B2-Motion> { |
| if {!$tk_strictMotif} { |
| ::tk::EntryScanDrag %W %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} { |
| variable ::tk::Priv |
| |
| if {![info exists Priv(outsideElement)]} { |
| $w invoke $elem |
| incr Priv(repeated) |
| } |
| set delay [$w cget -repeatinterval] |
| if {$delay > 0} { |
| set Priv(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} { |
| variable ::tk::Priv |
| |
| # 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 Priv(element) [$w identify $x $y] |
| if {$Priv(element) eq ""} { |
| set Priv(element) "entry" |
| } |
| |
| switch -exact $Priv(element) { |
| "buttonup" - "buttondown" { |
| if {"disabled" ne [$w cget -state]} { |
| $w selection element $Priv(element) |
| set Priv(repeated) 0 |
| set Priv(relief) [$w cget -$Priv(element)relief] |
| catch {after cancel $Priv(afterId)} |
| set delay [$w cget -repeatdelay] |
| if {$delay > 0} { |
| set Priv(afterId) [after $delay \ |
| [list ::tk::spinbox::Invoke $w $Priv(element)]] |
| } |
| if {[info exists Priv(outsideElement)]} { |
| unset Priv(outsideElement) |
| } |
| } |
| } |
| "entry" { |
| set Priv(selectMode) char |
| set Priv(mouseMoved) 0 |
| set Priv(pressX) $x |
| $w icursor [::tk::spinbox::ClosestGap $w $x] |
| $w selection from insert |
| if {"disabled" ne [$w cget -state]} {focus $w} |
| $w selection clear |
| } |
| default { |
| return -code error "unknown spinbox element \"$Priv(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} { |
| variable ::tk::Priv |
| |
| ::tk::CancelRepeat |
| |
| # Priv(relief) may not exist if the ButtonUp is not paired with |
| # a preceding ButtonDown |
| if {[info exists Priv(element)] && [info exists Priv(relief)] && \ |
| [string match "button*" $Priv(element)]} { |
| if {[info exists Priv(repeated)] && !$Priv(repeated)} { |
| $w invoke $Priv(element) |
| } |
| $w configure -$Priv(element)relief $Priv(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 {}}} { |
| variable ::tk::Priv |
| |
| if {$Priv(element) ne "entry"} { |
| # The ButtonUp command triggered by ButtonRelease-1 handles |
| # invoking one of the spinbuttons. |
| return |
| } |
| set cur [::tk::spinbox::ClosestGap $w $x] |
| set anchor [$w index anchor] |
| if {($cur ne $anchor) || (abs($Priv(pressX) - $x) >= 3)} { |
| set Priv(mouseMoved) 1 |
| } |
| switch $Priv(selectMode) { |
| char { |
| if {$Priv(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 {$cursor ne {} && $cursor ne "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} { |
| $w icursor [::tk::spinbox::ClosestGap $w $x] |
| catch {$w insert insert [::tk::GetSelection $w PRIMARY]} |
| 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} { |
| variable ::tk::Priv |
| |
| if {![info exists Priv(element)]} { |
| set Priv(element) [$w identify $x $y] |
| } |
| |
| set Priv(x) $x |
| if {"entry" eq $Priv(element)} { |
| ::tk::spinbox::MouseSelect $w $x ignore |
| } elseif {[$w identify $x $y] ne $Priv(element)} { |
| if {![info exists Priv(outsideElement)]} { |
| # We've wandered out of the spin button |
| # setting outside element will cause ::tk::spinbox::Invoke to |
| # loop without doing anything |
| set Priv(outsideElement) "" |
| $w selection element none |
| } |
| } elseif {[info exists Priv(outsideElement)]} { |
| unset Priv(outsideElement) |
| $w selection element $Priv(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} { |
| variable ::tk::Priv |
| |
| set x $Priv(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 Priv(afterId) [after 50 [list ::tk::spinbox::AutoScan $w]] |
| } |
| |
| # ::tk::spinbox::GetSelection -- |
| # |
| # 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 |
| |
| proc ::tk::spinbox::GetSelection {w} { |
| return [string range [$w get] [$w index sel.first] \ |
| [expr {[$w index sel.last] - 1}]] |
| } |