Viewing file: spinbox.tcl (14.75 KB) -rw-r--r-- Select action/file-type: (+) | (+) | (+) | Code (+) | Session (+) | (+) | SDB (+) | (+) | (+) | (+) | (+) | (+) |
# 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.6.2.1 2006/01/25 18:21:41 dgp 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 {[tk windowingsystem] eq "classic" || [tk windowingsystem] eq "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 {$tcl_platform(platform) ne "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 {"disabled" eq [$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}]] }
|