3 # This file defines the default bindings for Tk spinbox widgets and provides
4 # procedures that help in implementing those bindings. The spinbox builds
5 # off the entry widget, so it can reuse Entry bindings and procedures.
7 # RCS: @(#) $Id: spinbox.tcl,v 1.9 2005/07/25 09:06:00 dkf Exp $
9 # Copyright (c) 1992-1994 The Regents of the University of California.
10 # Copyright (c) 1994-1997 Sun Microsystems, Inc.
11 # Copyright (c) 1999-2000 Jeffrey Hobbs
12 # Copyright (c) 2000 Ajuba Solutions
14 # See the file "license.terms" for information on usage and redistribution
15 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
18 #-------------------------------------------------------------------------
19 # Elements of tk::Priv that are used in this file:
21 # afterId - If non-null, it means that auto-scanning is underway
22 # and it gives the "after" id for the next auto-scan
23 # command to be executed.
24 # mouseMoved - Non-zero means the mouse has moved a significant
25 # amount since the button went down (so, for example,
26 # start dragging out a selection).
27 # pressX - X-coordinate at which the mouse button was pressed.
28 # selectMode - The style of selection currently underway:
29 # char, word, or line.
30 # x, y - Last known mouse coordinates for scanning
32 # data - Used for Cut and Copy
33 #-------------------------------------------------------------------------
35 # Initialize namespace
36 namespace eval ::tk::spinbox {}
38 #-------------------------------------------------------------------------
39 # The code below creates the default class bindings for entries.
40 #-------------------------------------------------------------------------
41 bind Spinbox
<<Cut
>> {
42 if {![catch {::tk::spinbox::GetSelection %W
} tk::Priv(data
)]} {
43 clipboard clear
-displayof %W
44 clipboard append -displayof %W
$tk::Priv(data
)
45 %W delete sel.first sel.last
49 bind Spinbox
<<Copy
>> {
50 if {![catch {::tk::spinbox::GetSelection %W
} tk::Priv(data
)]} {
51 clipboard clear
-displayof %W
52 clipboard append -displayof %W
$tk::Priv(data
)
56 bind Spinbox
<<Paste
>> {
59 if {[tk windowingsystem
] ne
"x11"} {
61 %W delete sel.first sel.last
64 %W insert insert
[::tk::GetSelection %W CLIPBOARD
]
65 ::tk::EntrySeeInsert %W
68 bind Spinbox
<<Clear
>> {
69 %W delete sel.first sel.last
71 bind Spinbox
<<PasteSelection
>> {
72 if {$tk_strictMotif ||
![info exists
tk::Priv(mouseMoved
)]
73 ||
!$tk::Priv(mouseMoved
)} {
74 ::tk::spinbox::Paste %W
%x
78 bind Spinbox
<<TraverseIn
>> {
79 %W
selection range
0 end
83 # Standard Motif bindings:
86 ::tk::spinbox::ButtonDown %W
%x
%y
88 bind Spinbox
<B1-Motion
> {
89 ::tk::spinbox::Motion %W
%x
%y
91 bind Spinbox
<Double-1
> {
92 set tk::Priv(selectMode
) word
93 ::tk::spinbox::MouseSelect %W
%x sel.first
95 bind Spinbox
<Triple-1
> {
96 set tk::Priv(selectMode
) line
97 ::tk::spinbox::MouseSelect %W
%x
0
99 bind Spinbox
<Shift-1
> {
100 set tk::Priv(selectMode
) char
101 %W
selection adjust
@%x
103 bind Spinbox
<Double-Shift-1
> {
104 set tk::Priv(selectMode
) word
105 ::tk::spinbox::MouseSelect %W
%x
107 bind Spinbox
<Triple-Shift-1
> {
108 set tk::Priv(selectMode
) line
109 ::tk::spinbox::MouseSelect %W
%x
111 bind Spinbox
<B1-Leave
> {
113 ::tk::spinbox::AutoScan %W
115 bind Spinbox
<B1-Enter
> {
118 bind Spinbox
<ButtonRelease-1
> {
119 ::tk::spinbox::ButtonUp %W
%x
%y
121 bind Spinbox
<Control-1
> {
128 bind Spinbox
<Down
> {
132 bind Spinbox
<Left
> {
133 ::tk::EntrySetCursor %W
[expr {[%W index insert
] - 1}]
135 bind Spinbox
<Right
> {
136 ::tk::EntrySetCursor %W
[expr {[%W index insert
] + 1}]
138 bind Spinbox
<Shift-Left
> {
139 ::tk::EntryKeySelect %W
[expr {[%W index insert
] - 1}]
140 ::tk::EntrySeeInsert %W
142 bind Spinbox
<Shift-Right
> {
143 ::tk::EntryKeySelect %W
[expr {[%W index insert
] + 1}]
144 ::tk::EntrySeeInsert %W
146 bind Spinbox
<Control-Left
> {
147 ::tk::EntrySetCursor %W
[::tk::EntryPreviousWord %W insert
]
149 bind Spinbox
<Control-Right
> {
150 ::tk::EntrySetCursor %W
[::tk::EntryNextWord %W insert
]
152 bind Spinbox
<Shift-Control-Left
> {
153 ::tk::EntryKeySelect %W
[::tk::EntryPreviousWord %W insert
]
154 ::tk::EntrySeeInsert %W
156 bind Spinbox
<Shift-Control-Right
> {
157 ::tk::EntryKeySelect %W
[::tk::EntryNextWord %W insert
]
158 ::tk::EntrySeeInsert %W
160 bind Spinbox
<Home
> {
161 ::tk::EntrySetCursor %W
0
163 bind Spinbox
<Shift-Home
> {
164 ::tk::EntryKeySelect %W
0
165 ::tk::EntrySeeInsert %W
168 ::tk::EntrySetCursor %W end
170 bind Spinbox
<Shift-End
> {
171 ::tk::EntryKeySelect %W end
172 ::tk::EntrySeeInsert %W
175 bind Spinbox
<Delete
> {
176 if {[%W
selection present
]} {
177 %W delete sel.first sel.last
182 bind Spinbox
<BackSpace
> {
183 ::tk::EntryBackspace %W
186 bind Spinbox
<Control-space
> {
187 %W
selection from insert
189 bind Spinbox
<Select
> {
190 %W
selection from insert
192 bind Spinbox
<Control-Shift-space
> {
193 %W
selection adjust insert
195 bind Spinbox
<Shift-Select
> {
196 %W
selection adjust insert
198 bind Spinbox
<Control-slash
> {
199 %W
selection range
0 end
201 bind Spinbox
<Control-backslash
> {
204 bind Spinbox
<KeyPress
> {
205 ::tk::EntryInsert %W
%A
208 # Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
209 # Otherwise, if a widget binding for one of these is defined, the
210 # <KeyPress> class binding will also fire and insert the character,
211 # which is wrong. Ditto for Escape, Return, and Tab.
213 bind Spinbox
<Alt-KeyPress
> {# nothing}
214 bind Spinbox
<Meta-KeyPress
> {# nothing}
215 bind Spinbox
<Control-KeyPress
> {# nothing}
216 bind Spinbox
<Escape
> {# nothing}
217 bind Spinbox
<Return
> {# nothing}
218 bind Spinbox
<KP_Enter
> {# nothing}
219 bind Spinbox
<Tab
> {# nothing}
220 if {[tk windowingsystem
] eq
"aqua"} {
221 bind Spinbox
<Command-KeyPress
> {# nothing}
224 # On Windows, paste is done using Shift-Insert. Shift-Insert already
225 # generates the <<Paste>> event, so we don't need to do anything here.
226 if {$tcl_platform(platform
) ne
"windows"} {
227 bind Spinbox
<Insert
> {
228 catch {::tk::EntryInsert %W
[::tk::GetSelection %W PRIMARY
]}
232 # Additional emacs-like bindings:
234 bind Spinbox
<Control-a
> {
235 if {!$tk_strictMotif} {
236 ::tk::EntrySetCursor %W
0
239 bind Spinbox
<Control-b
> {
240 if {!$tk_strictMotif} {
241 ::tk::EntrySetCursor %W
[expr {[%W index insert
] - 1}]
244 bind Spinbox
<Control-d
> {
245 if {!$tk_strictMotif} {
249 bind Spinbox
<Control-e
> {
250 if {!$tk_strictMotif} {
251 ::tk::EntrySetCursor %W end
254 bind Spinbox
<Control-f
> {
255 if {!$tk_strictMotif} {
256 ::tk::EntrySetCursor %W
[expr {[%W index insert
] + 1}]
259 bind Spinbox
<Control-h
> {
260 if {!$tk_strictMotif} {
261 ::tk::EntryBackspace %W
264 bind Spinbox
<Control-k
> {
265 if {!$tk_strictMotif} {
269 bind Spinbox
<Control-t
> {
270 if {!$tk_strictMotif} {
271 ::tk::EntryTranspose %W
274 bind Spinbox
<Meta-b
> {
275 if {!$tk_strictMotif} {
276 ::tk::EntrySetCursor %W
[::tk::EntryPreviousWord %W insert
]
279 bind Spinbox
<Meta-d
> {
280 if {!$tk_strictMotif} {
281 %W delete insert
[::tk::EntryNextWord %W insert
]
284 bind Spinbox
<Meta-f
> {
285 if {!$tk_strictMotif} {
286 ::tk::EntrySetCursor %W
[::tk::EntryNextWord %W insert
]
289 bind Spinbox
<Meta-BackSpace
> {
290 if {!$tk_strictMotif} {
291 %W delete
[::tk::EntryPreviousWord %W insert
] insert
294 bind Spinbox
<Meta-Delete
> {
295 if {!$tk_strictMotif} {
296 %W delete
[::tk::EntryPreviousWord %W insert
] insert
300 # A few additional bindings of my own.
303 if {!$tk_strictMotif} {
304 ::tk::EntryScanMark %W
%x
307 bind Spinbox
<B2-Motion
> {
308 if {!$tk_strictMotif} {
309 ::tk::EntryScanDrag %W
%x
313 # ::tk::spinbox::Invoke --
314 # Invoke an element of the spinbox
317 # w - The spinbox window.
318 # elem - Element to invoke
320 proc ::tk::spinbox::Invoke {w elem
} {
323 if {![info exists Priv
(outsideElement
)]} {
327 set delay
[$w cget
-repeatinterval]
329 set Priv
(afterId
) [after $delay \
330 [list ::tk::spinbox::Invoke $w $elem]]
334 # ::tk::spinbox::ClosestGap --
335 # Given x and y coordinates, this procedure finds the closest boundary
336 # between characters to the given coordinates and returns the index
337 # of the character just after the boundary.
340 # w - The spinbox window.
341 # x - X-coordinate within the window.
343 proc ::tk::spinbox::ClosestGap {w x
} {
344 set pos
[$w index
@$x]
345 set bbox
[$w bbox
$pos]
346 if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} {
352 # ::tk::spinbox::ButtonDown --
353 # This procedure is invoked to handle button-1 presses in spinbox
354 # widgets. It moves the insertion cursor, sets the selection anchor,
355 # and claims the input focus.
358 # w - The spinbox window in which the button was pressed.
359 # x - The x-coordinate of the button press.
361 proc ::tk::spinbox::ButtonDown {w x y
} {
364 # Get the element that was clicked in. If we are not directly over
365 # the spinbox, default to entry. This is necessary for spinbox grabs.
367 set Priv
(element
) [$w identify
$x $y]
368 if {$Priv(element
) eq
""} {
369 set Priv
(element
) "entry"
372 switch -exact $Priv(element
) {
373 "buttonup" - "buttondown" {
374 if {"disabled" ne
[$w cget
-state]} {
375 $w selection element
$Priv(element
)
377 set Priv
(relief
) [$w cget
-$Priv(element
)relief
]
378 catch {after cancel
$Priv(afterId
)}
379 set delay
[$w cget
-repeatdelay]
381 set Priv
(afterId
) [after $delay \
382 [list ::tk::spinbox::Invoke $w $Priv(element
)]]
384 if {[info exists Priv
(outsideElement
)]} {
385 unset Priv
(outsideElement
)
390 set Priv
(selectMode
) char
391 set Priv
(mouseMoved
) 0
393 $w icursor
[::tk::spinbox::ClosestGap $w $x]
394 $w selection from insert
395 if {"disabled" ne
[$w cget
-state]} {focus $w}
399 return -code error "unknown spinbox element \"$Priv(element)\""
404 # ::tk::spinbox::ButtonUp --
405 # This procedure is invoked to handle button-1 releases in spinbox
409 # w - The spinbox window in which the button was pressed.
410 # x - The x-coordinate of the button press.
412 proc ::tk::spinbox::ButtonUp {w x y
} {
417 # Priv(relief) may not exist if the ButtonUp is not paired with
418 # a preceding ButtonDown
419 if {[info exists Priv
(element
)] && [info exists Priv
(relief
)] && \
420 [string match
"button*" $Priv(element
)]} {
421 if {[info exists Priv
(repeated
)] && !$Priv(repeated
)} {
422 $w invoke
$Priv(element
)
424 $w configure
-$Priv(element
)relief
$Priv(relief
)
425 $w selection element none
429 # ::tk::spinbox::MouseSelect --
430 # This procedure is invoked when dragging out a selection with
431 # the mouse. Depending on the selection mode (character, word,
432 # line) it selects in different-sized units. This procedure
433 # ignores mouse motions initially until the mouse has moved from
434 # one character to another or until there have been multiple clicks.
437 # w - The spinbox window in which the button was pressed.
438 # x - The x-coordinate of the mouse.
439 # cursor - optional place to set cursor.
441 proc ::tk::spinbox::MouseSelect {w x
{cursor
{}}} {
444 if {$Priv(element
) ne
"entry"} {
445 # The ButtonUp command triggered by ButtonRelease-1 handles
446 # invoking one of the spinbuttons.
449 set cur
[::tk::spinbox::ClosestGap $w $x]
450 set anchor
[$w index anchor
]
451 if {($cur ne
$anchor) ||
(abs
($Priv(pressX
) - $x) >= 3)} {
452 set Priv
(mouseMoved
) 1
454 switch $Priv(selectMode
) {
456 if {$Priv(mouseMoved
)} {
457 if {$cur < $anchor} {
458 $w selection range
$cur $anchor
459 } elseif
{$cur > $anchor} {
460 $w selection range
$anchor $cur
467 if {$cur < [$w index anchor
]} {
468 set before
[tcl_wordBreakBefore [$w get
] $cur]
469 set after [tcl_wordBreakAfter [$w get
] [expr {$anchor-1}]]
471 set before
[tcl_wordBreakBefore [$w get
] $anchor]
472 set after [tcl_wordBreakAfter [$w get
] [expr {$cur - 1}]]
480 $w selection range
$before $after
483 $w selection range
0 end
486 if {$cursor ne
{} && $cursor ne
"ignore"} {
487 catch {$w icursor
$cursor}
492 # ::tk::spinbox::Paste --
493 # This procedure sets the insertion cursor to the current mouse position,
494 # pastes the selection there, and sets the focus to the window.
497 # w - The spinbox window.
498 # x - X position of the mouse.
500 proc ::tk::spinbox::Paste {w x
} {
501 $w icursor
[::tk::spinbox::ClosestGap $w $x]
502 catch {$w insert insert
[::tk::GetSelection $w PRIMARY
]}
503 if {"disabled" eq
[$w cget
-state]} {
508 # ::tk::spinbox::Motion --
509 # This procedure is invoked when the mouse moves in a spinbox window
510 # with button 1 down.
513 # w - The spinbox window.
515 proc ::tk::spinbox::Motion {w x y
} {
518 if {![info exists Priv
(element
)]} {
519 set Priv
(element
) [$w identify
$x $y]
523 if {"entry" eq
$Priv(element
)} {
524 ::tk::spinbox::MouseSelect $w $x ignore
525 } elseif
{[$w identify
$x $y] ne
$Priv(element
)} {
526 if {![info exists Priv
(outsideElement
)]} {
527 # We've wandered out of the spin button
528 # setting outside element will cause ::tk::spinbox::Invoke to
529 # loop without doing anything
530 set Priv
(outsideElement
) ""
531 $w selection element none
533 } elseif
{[info exists Priv
(outsideElement
)]} {
534 unset Priv
(outsideElement
)
535 $w selection element
$Priv(element
)
539 # ::tk::spinbox::AutoScan --
540 # This procedure is invoked when the mouse leaves an spinbox window
541 # with button 1 down. It scrolls the window left or right,
542 # depending on where the mouse is, and reschedules itself as an
543 # "after" command so that the window continues to scroll until the
544 # mouse moves back into the window or the mouse button is released.
547 # w - The spinbox window.
549 proc ::tk::spinbox::AutoScan {w
} {
553 if {$x >= [winfo width
$w]} {
554 $w xview scroll
2 units
555 ::tk::spinbox::MouseSelect $w $x ignore
557 $w xview scroll
-2 units
558 ::tk::spinbox::MouseSelect $w $x ignore
560 set Priv
(afterId
) [after 50 [list ::tk::spinbox::AutoScan $w]]
563 # ::tk::spinbox::GetSelection --
565 # Returns the selected text of the spinbox. Differs from entry in that
566 # a spinbox has no -show option to obscure contents.
569 # w - The spinbox window from which the text to get
571 proc ::tk::spinbox::GetSelection {w
} {
572 return [string range
[$w get
] [$w index sel.first
] \
573 [expr {[$w index sel.last
] - 1}]]