573 lines
15 KiB
Tcl
573 lines
15 KiB
Tcl
# 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.
|
|
#
|
|
# 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
|
|
}
|
|
}
|
|
|
|
bind Spinbox <<TraverseIn>> {
|
|
%W selection range 0 end
|
|
%W icursor end
|
|
}
|
|
|
|
# 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 "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 {[tk windowingsystem] ne "win32"} {
|
|
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}]]
|
|
}
|