# 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 2002/08/31 06:12:28 das 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:
# x, y - Last known mouse coordinates for scanning
# data - Used for Cut and Copy
#-------------------------------------------------------------------------
namespace eval ::tk::spinbox {}
#-------------------------------------------------------------------------
# The code below creates the default class bindings for entries.
#-------------------------------------------------------------------------
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
if {![catch {::tk::spinbox::GetSelection %W
} tk::Priv(data
)]} {
clipboard clear
-displayof %W
clipboard append -displayof %W
$tk::Priv(data
)
if {[tk windowingsystem
] ne
"x11"} {
%W delete sel.first sel.last
%W insert insert
[::tk::GetSelection %W CLIPBOARD
]
%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:
::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
set tk::Priv(selectMode
) char
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
> {
::tk::spinbox::AutoScan %W
bind Spinbox
<B1-Enter
> {
bind Spinbox
<ButtonRelease-1
> {
::tk::spinbox::ButtonUp %W
%x
%y
bind Spinbox
<Control-1
> {
::tk::EntrySetCursor %W
[expr {[%W index insert
] - 1}]
::tk::EntrySetCursor %W
[expr {[%W index insert
] + 1}]
bind Spinbox
<Shift-Left
> {
::tk::EntryKeySelect %W
[expr {[%W index insert
] - 1}]
bind Spinbox
<Shift-Right
> {
::tk::EntryKeySelect %W
[expr {[%W index insert
] + 1}]
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
]
bind Spinbox
<Shift-Control-Right
> {
::tk::EntryKeySelect %W
[::tk::EntryNextWord %W insert
]
::tk::EntrySetCursor %W
0
bind Spinbox
<Shift-Home
> {
::tk::EntryKeySelect %W
0
::tk::EntrySetCursor %W end
bind Spinbox
<Shift-End
> {
::tk::EntryKeySelect %W end
if {[%W
selection present
]} {
%W delete sel.first sel.last
bind Spinbox
<BackSpace
> {
bind Spinbox
<Control-space
> {
bind Spinbox
<Control-Shift-space
> {
%W
selection adjust insert
bind Spinbox
<Shift-Select
> {
%W
selection adjust insert
bind Spinbox
<Control-slash
> {
bind Spinbox
<Control-backslash
> {
bind Spinbox
<KeyPress
> {
# 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"]} {
catch {::tk::EntryInsert %W
[::tk::GetSelection %W PRIMARY
]}
# Additional emacs-like bindings:
bind Spinbox
<Control-a
> {
::tk::EntrySetCursor %W
0
bind Spinbox
<Control-b
> {
::tk::EntrySetCursor %W
[expr {[%W index insert
] - 1}]
bind Spinbox
<Control-d
> {
bind Spinbox
<Control-e
> {
::tk::EntrySetCursor %W end
bind Spinbox
<Control-f
> {
::tk::EntrySetCursor %W
[expr {[%W index insert
] + 1}]
bind Spinbox
<Control-h
> {
bind Spinbox
<Control-k
> {
bind Spinbox
<Control-t
> {
::tk::EntrySetCursor %W
[::tk::EntryPreviousWord %W insert
]
%W delete insert
[::tk::EntryNextWord %W insert
]
::tk::EntrySetCursor %W
[::tk::EntryNextWord %W insert
]
bind Spinbox
<Meta-BackSpace
> {
%W delete
[::tk::EntryPreviousWord %W insert
] insert
bind Spinbox
<Meta-Delete
> {
%W delete
[::tk::EntryPreviousWord %W insert
] insert
# A few additional bindings of my own.
::tk::EntryScanMark %W
%x
bind Spinbox
<B2-Motion
> {
::tk::EntryScanDrag %W
%x
# ::tk::spinbox::Invoke --
# Invoke an element of the spinbox
# w - The spinbox window.
# elem - Element to invoke
proc ::tk::spinbox::Invoke {w elem
} {
if {![info exists Priv
(outsideElement
)]} {
set delay
[$w cget
-repeatinterval]
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.
# w - The spinbox window.
# x - X-coordinate within the window.
proc ::tk::spinbox::ClosestGap {w x
} {
if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} {
# ::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.
# 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
} {
# 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
(relief
) [$w cget
-$Priv(element
)relief
]
catch {after cancel
$Priv(afterId
)}
set delay
[$w cget
-repeatdelay]
set Priv
(afterId
) [after $delay \
[list ::tk::spinbox::Invoke $w $Priv(element
)]]
if {[info exists Priv
(outsideElement
)]} {
unset Priv
(outsideElement
)
set Priv
(selectMode
) char
$w icursor
[::tk::spinbox::ClosestGap $w $x]
if {"disabled" ne
[$w cget
-state]} {focus $w}
return -code error "unknown spinbox element \"$Priv(element)\""
# ::tk::spinbox::ButtonUp --
# This procedure is invoked to handle button-1 releases in spinbox
# 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
} {
# Priv(relief) may not exist if the ButtonUp is not paired with
if {[info exists Priv
(element
)] && [info exists Priv
(relief
)] && \
[string match
"button*" $Priv(element
)]} {
if {[info exists Priv
(repeated
)] && !$Priv(repeated
)} {
$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.
# 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
{}}} {
if {$Priv(element
) ne
"entry"} {
# The ButtonUp command triggered by ButtonRelease-1 handles
# invoking one of the spinbuttons.
set cur
[::tk::spinbox::ClosestGap $w $x]
set anchor
[$w index anchor
]
if {($cur ne
$anchor) ||
(abs
($Priv(pressX
) - $x) >= 3)} {
switch $Priv(selectMode
) {
$w selection range
$cur $anchor
} elseif
{$cur > $anchor} {
$w selection range
$anchor $cur
if {$cur < [$w index anchor
]} {
set before
[tcl_wordBreakBefore [$w get
] $cur]
set after [tcl_wordBreakAfter [$w get
] [expr {$anchor-1}]]
set before
[tcl_wordBreakBefore [$w get
] $anchor]
set after [tcl_wordBreakAfter [$w get
] [expr {$cur - 1}]]
$w selection range
$before $after
if {$cursor ne
{} && $cursor ne
"ignore"} {
catch {$w icursor
$cursor}
# ::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.
# 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
# w - The spinbox window.
proc ::tk::spinbox::Motion {w x y
} {
if {![info exists Priv
(element
)]} {
set Priv
(element
) [$w identify
$x $y]
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.
# w - The spinbox window.
proc ::tk::spinbox::AutoScan {w
} {
if {$x >= [winfo width
$w]} {
::tk::spinbox::MouseSelect $w $x ignore
::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.
# 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}]]