3 # This file defines the default bindings for Tk label, button,
4 # checkbutton, and radiobutton widgets and provides procedures
5 # that help in implementing those bindings.
7 # Copyright (c) 1992-1994 The Regents of the University of California.
8 # Copyright (c) 1994-1996 Sun Microsystems, Inc.
9 # Copyright (c) 2002 ActiveState Corporation.
11 # See the file "license.terms" for information on usage and redistribution
12 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
15 #-------------------------------------------------------------------------
16 # The code below creates the default class bindings for buttons.
17 #-------------------------------------------------------------------------
19 if {[tk windowingsystem
] eq
"aqua"} {
20 bind Radiobutton
<Enter
> {
23 bind Radiobutton
<1> {
26 bind Radiobutton
<ButtonRelease-1
> {
29 bind Checkbutton
<Enter
> {
32 bind Checkbutton
<1> {
35 bind Checkbutton
<ButtonRelease-1
> {
38 bind Checkbutton
<Leave
> {
42 if {"win32" eq
[tk windowingsystem
]} {
43 bind Checkbutton
<equal
> {
44 tk::CheckRadioInvoke %W select
46 bind Checkbutton
<plus
> {
47 tk::CheckRadioInvoke %W select
49 bind Checkbutton
<minus
> {
50 tk::CheckRadioInvoke %W deselect
52 bind Checkbutton
<1> {
55 bind Checkbutton
<ButtonRelease-1
> {
58 bind Checkbutton
<Enter
> {
59 tk::CheckRadioEnter %W
61 bind Checkbutton
<Leave
> {
65 bind Radiobutton
<1> {
68 bind Radiobutton
<ButtonRelease-1
> {
71 bind Radiobutton
<Enter
> {
72 tk::CheckRadioEnter %W
75 if {"x11" eq
[tk windowingsystem
]} {
76 bind Checkbutton
<Return
> {
77 if {!$tk_strictMotif} {
81 bind Radiobutton
<Return
> {
82 if {!$tk_strictMotif} {
83 tk::CheckRadioInvoke %W
86 bind Checkbutton
<1> {
89 bind Radiobutton
<1> {
90 tk::CheckRadioInvoke %W
92 bind Checkbutton
<Enter
> {
95 bind Radiobutton
<Enter
> {
98 bind Checkbutton
<Leave
> {
103 bind Button
<space
> {
106 bind Checkbutton
<space
> {
107 tk::CheckRadioInvoke %W
109 bind Radiobutton
<space
> {
110 tk::CheckRadioInvoke %W
113 bind Button
<FocusIn
> {}
114 bind Button
<Enter
> {
117 bind Button
<Leave
> {
123 bind Button
<ButtonRelease-1
> {
127 bind Checkbutton
<FocusIn
> {}
129 bind Radiobutton
<FocusIn
> {}
130 bind Radiobutton
<Leave
> {
134 if {"win32" eq
[tk windowingsystem
]} {
136 #########################
137 # Windows implementation
138 #########################
140 # ::tk::ButtonEnter --
141 # The procedure below is invoked when the mouse pointer enters a
142 # button widget. It records the button we're in and changes the
143 # state of the button to active unless the button is disabled.
146 # w - The name of the widget.
148 proc ::tk::ButtonEnter w
{
150 if {[$w cget
-state] ne
"disabled"} {
152 # If the mouse button is down, set the relief to sunken on entry.
153 # Overwise, if there's an -overrelief value, set the relief to that.
155 set Priv
($w,relief
) [$w cget
-relief]
156 if {$Priv(buttonWindow
) eq
$w} {
157 $w configure
-relief sunken
-state active
158 set Priv
($w,prelief
) sunken
159 } elseif
{[set over
[$w cget
-overrelief]] ne
""} {
160 $w configure
-relief $over
161 set Priv
($w,prelief
) $over
167 # ::tk::ButtonLeave --
168 # The procedure below is invoked when the mouse pointer leaves a
169 # button widget. It changes the state of the button back to inactive.
170 # Restore any modified relief too.
173 # w - The name of the widget.
175 proc ::tk::ButtonLeave w
{
177 if {[$w cget
-state] ne
"disabled"} {
178 $w configure
-state normal
181 # Restore the original button relief if it was changed by Tk.
182 # That is signaled by the existence of Priv($w,prelief).
184 if {[info exists Priv
($w,relief
)]} {
185 if {[info exists Priv
($w,prelief
)] && \
186 $Priv($w,prelief
) eq
[$w cget
-relief]} {
187 $w configure
-relief $Priv($w,relief
)
189 unset -nocomplain Priv
($w,relief
) Priv
($w,prelief
)
195 # ::tk::ButtonDown --
196 # The procedure below is invoked when the mouse button is pressed in
197 # a button widget. It records the fact that the mouse is in the button,
198 # saves the button's relief so it can be restored later, and changes
199 # the relief to sunken.
202 # w - The name of the widget.
204 proc ::tk::ButtonDown w
{
207 # Only save the button's relief if it does not yet exist. If there
208 # is an overrelief setting, Priv($w,relief) will already have been set,
209 # and the current value of the -relief option will be incorrect.
211 if {![info exists Priv
($w,relief
)]} {
212 set Priv
($w,relief
) [$w cget
-relief]
215 if {[$w cget
-state] ne
"disabled"} {
216 set Priv
(buttonWindow
) $w
217 $w configure
-relief sunken
-state active
218 set Priv
($w,prelief
) sunken
220 # If this button has a repeatdelay set up, get it going with an after
221 after cancel
$Priv(afterId
)
222 set delay
[$w cget
-repeatdelay]
225 set Priv
(afterId
) [after $delay [list tk::ButtonAutoInvoke $w]]
231 # The procedure below is invoked when the mouse button is released
232 # in a button widget. It restores the button's relief and invokes
233 # the command as long as the mouse hasn't left the button.
236 # w - The name of the widget.
238 proc ::tk::ButtonUp w
{
240 if {$Priv(buttonWindow
) eq
$w} {
241 set Priv
(buttonWindow
) ""
243 # Restore the button's relief if it was cached.
245 if {[info exists Priv
($w,relief
)]} {
246 if {[info exists Priv
($w,prelief
)] && \
247 $Priv($w,prelief
) eq
[$w cget
-relief]} {
248 $w configure
-relief $Priv($w,relief
)
250 unset -nocomplain Priv
($w,relief
) Priv
($w,prelief
)
253 # Clean up the after event from the auto-repeater
254 after cancel
$Priv(afterId
)
256 if {$Priv(window
) eq
$w && [$w cget
-state] ne
"disabled"} {
257 $w configure
-state normal
259 # Only invoke the command if it wasn't already invoked by the
260 # auto-repeater functionality
261 if { $Priv(repeated
) == 0 } {
262 uplevel #0 [list $w invoke]
268 # ::tk::CheckRadioEnter --
269 # The procedure below is invoked when the mouse pointer enters a
270 # checkbutton or radiobutton widget. It records the button we're in
271 # and changes the state of the button to active unless the button is
275 # w - The name of the widget.
277 proc ::tk::CheckRadioEnter w
{
279 if {[$w cget
-state] ne
"disabled"} {
280 if {$Priv(buttonWindow
) eq
$w} {
281 $w configure
-state active
283 if {[set over
[$w cget
-overrelief]] ne
""} {
284 set Priv
($w,relief
) [$w cget
-relief]
285 set Priv
($w,prelief
) $over
286 $w configure
-relief $over
292 # ::tk::CheckRadioDown --
293 # The procedure below is invoked when the mouse button is pressed in
294 # a button widget. It records the fact that the mouse is in the button,
295 # saves the button's relief so it can be restored later, and changes
296 # the relief to sunken.
299 # w - The name of the widget.
301 proc ::tk::CheckRadioDown w
{
303 if {![info exists Priv
($w,relief
)]} {
304 set Priv
($w,relief
) [$w cget
-relief]
306 if {[$w cget
-state] ne
"disabled"} {
307 set Priv
(buttonWindow
) $w
309 $w configure
-state active
315 if {"x11" eq
[tk windowingsystem
]} {
317 #####################
318 # Unix implementation
319 #####################
321 # ::tk::ButtonEnter --
322 # The procedure below is invoked when the mouse pointer enters a
323 # button widget. It records the button we're in and changes the
324 # state of the button to active unless the button is disabled.
327 # w - The name of the widget.
329 proc ::tk::ButtonEnter {w
} {
331 if {[$w cget
-state] ne
"disabled"} {
332 # On unix the state is active just with mouse-over
333 $w configure
-state active
335 # If the mouse button is down, set the relief to sunken on entry.
336 # Overwise, if there's an -overrelief value, set the relief to that.
338 set Priv
($w,relief
) [$w cget
-relief]
339 if {$Priv(buttonWindow
) eq
$w} {
340 $w configure
-relief sunken
341 set Priv
($w,prelief
) sunken
342 } elseif
{[set over
[$w cget
-overrelief]] ne
""} {
343 $w configure
-relief $over
344 set Priv
($w,prelief
) $over
350 # ::tk::ButtonLeave --
351 # The procedure below is invoked when the mouse pointer leaves a
352 # button widget. It changes the state of the button back to inactive.
353 # Restore any modified relief too.
356 # w - The name of the widget.
358 proc ::tk::ButtonLeave w
{
360 if {[$w cget
-state] ne
"disabled"} {
361 $w configure
-state normal
364 # Restore the original button relief if it was changed by Tk.
365 # That is signaled by the existence of Priv($w,prelief).
367 if {[info exists Priv
($w,relief
)]} {
368 if {[info exists Priv
($w,prelief
)] && \
369 $Priv($w,prelief
) eq
[$w cget
-relief]} {
370 $w configure
-relief $Priv($w,relief
)
372 unset -nocomplain Priv
($w,relief
) Priv
($w,prelief
)
378 # ::tk::ButtonDown --
379 # The procedure below is invoked when the mouse button is pressed in
380 # a button widget. It records the fact that the mouse is in the button,
381 # saves the button's relief so it can be restored later, and changes
382 # the relief to sunken.
385 # w - The name of the widget.
387 proc ::tk::ButtonDown w
{
390 # Only save the button's relief if it does not yet exist. If there
391 # is an overrelief setting, Priv($w,relief) will already have been set,
392 # and the current value of the -relief option will be incorrect.
394 if {![info exists Priv
($w,relief
)]} {
395 set Priv
($w,relief
) [$w cget
-relief]
398 if {[$w cget
-state] ne
"disabled"} {
399 set Priv
(buttonWindow
) $w
400 $w configure
-relief sunken
401 set Priv
($w,prelief
) sunken
403 # If this button has a repeatdelay set up, get it going with an after
404 after cancel
$Priv(afterId
)
405 set delay
[$w cget
-repeatdelay]
408 set Priv
(afterId
) [after $delay [list tk::ButtonAutoInvoke $w]]
414 # The procedure below is invoked when the mouse button is released
415 # in a button widget. It restores the button's relief and invokes
416 # the command as long as the mouse hasn't left the button.
419 # w - The name of the widget.
421 proc ::tk::ButtonUp w
{
423 if {$w eq
$Priv(buttonWindow
)} {
424 set Priv
(buttonWindow
) ""
426 # Restore the button's relief if it was cached.
428 if {[info exists Priv
($w,relief
)]} {
429 if {[info exists Priv
($w,prelief
)] && \
430 $Priv($w,prelief
) eq
[$w cget
-relief]} {
431 $w configure
-relief $Priv($w,relief
)
433 unset -nocomplain Priv
($w,relief
) Priv
($w,prelief
)
436 # Clean up the after event from the auto-repeater
437 after cancel
$Priv(afterId
)
439 if {$Priv(window
) eq
$w && [$w cget
-state] ne
"disabled"} {
440 # Only invoke the command if it wasn't already invoked by the
441 # auto-repeater functionality
442 if { $Priv(repeated
) == 0 } {
443 uplevel #0 [list $w invoke]
451 if {[tk windowingsystem
] eq
"aqua"} {
457 # ::tk::ButtonEnter --
458 # The procedure below is invoked when the mouse pointer enters a
459 # button widget. It records the button we're in and changes the
460 # state of the button to active unless the button is disabled.
463 # w - The name of the widget.
465 proc ::tk::ButtonEnter {w
} {
467 if {[$w cget
-state] ne
"disabled"} {
469 # If there's an -overrelief value, set the relief to that.
471 if {$Priv(buttonWindow
) eq
$w} {
472 $w configure
-state active
473 } elseif
{[set over
[$w cget
-overrelief]] ne
""} {
474 set Priv
($w,relief
) [$w cget
-relief]
475 set Priv
($w,prelief
) $over
476 $w configure
-relief $over
482 # ::tk::ButtonLeave --
483 # The procedure below is invoked when the mouse pointer leaves a
484 # button widget. It changes the state of the button back to
485 # inactive. If we're leaving the button window with a mouse button
486 # pressed (Priv(buttonWindow) == $w), restore the relief of the
490 # w - The name of the widget.
492 proc ::tk::ButtonLeave w
{
494 if {$w eq
$Priv(buttonWindow
)} {
495 $w configure
-state normal
498 # Restore the original button relief if it was changed by Tk.
499 # That is signaled by the existence of Priv($w,prelief).
501 if {[info exists Priv
($w,relief
)]} {
502 if {[info exists Priv
($w,prelief
)] && \
503 $Priv($w,prelief
) eq
[$w cget
-relief]} {
504 $w configure
-relief $Priv($w,relief
)
506 unset -nocomplain Priv
($w,relief
) Priv
($w,prelief
)
512 # ::tk::ButtonDown --
513 # The procedure below is invoked when the mouse button is pressed in
514 # a button widget. It records the fact that the mouse is in the button,
515 # saves the button's relief so it can be restored later, and changes
516 # the relief to sunken.
519 # w - The name of the widget.
521 proc ::tk::ButtonDown w
{
524 if {[$w cget
-state] ne
"disabled"} {
525 set Priv
(buttonWindow
) $w
526 $w configure
-state active
528 # If this button has a repeatdelay set up, get it going with an after
529 after cancel
$Priv(afterId
)
531 if { ![catch {$w cget
-repeatdelay} delay
] } {
533 set Priv
(afterId
) [after $delay [list tk::ButtonAutoInvoke $w]]
540 # The procedure below is invoked when the mouse button is released
541 # in a button widget. It restores the button's relief and invokes
542 # the command as long as the mouse hasn't left the button.
545 # w - The name of the widget.
547 proc ::tk::ButtonUp w
{
549 if {$Priv(buttonWindow
) eq
$w} {
550 set Priv
(buttonWindow
) ""
551 $w configure
-state normal
553 # Restore the button's relief if it was cached.
555 if {[info exists Priv
($w,relief
)]} {
556 if {[info exists Priv
($w,prelief
)] && \
557 $Priv($w,prelief
) eq
[$w cget
-relief]} {
558 $w configure
-relief $Priv($w,relief
)
560 unset -nocomplain Priv
($w,relief
) Priv
($w,prelief
)
563 # Clean up the after event from the auto-repeater
564 after cancel
$Priv(afterId
)
566 if {$Priv(window
) eq
$w && [$w cget
-state] ne
"disabled"} {
567 # Only invoke the command if it wasn't already invoked by the
568 # auto-repeater functionality
569 if { $Priv(repeated
) == 0 } {
570 uplevel #0 [list $w invoke]
582 # ::tk::ButtonInvoke --
583 # The procedure below is called when a button is invoked through
584 # the keyboard. It simulate a press of the button via the mouse.
587 # w - The name of the widget.
589 proc ::tk::ButtonInvoke w
{
590 if {[$w cget
-state] ne
"disabled"} {
591 set oldRelief
[$w cget
-relief]
592 set oldState
[$w cget
-state]
593 $w configure
-state active
-relief sunken
596 $w configure
-state $oldState -relief $oldRelief
597 uplevel #0 [list $w invoke]
601 # ::tk::ButtonAutoInvoke --
603 # Invoke an auto-repeating button, and set it up to continue to repeat.
606 # w button to invoke.
612 # May create an after event to call ::tk::ButtonAutoInvoke.
614 proc ::tk::ButtonAutoInvoke {w
} {
616 after cancel
$Priv(afterId
)
617 set delay
[$w cget
-repeatinterval]
618 if {$Priv(window
) eq
$w} {
620 uplevel #0 [list $w invoke]
623 set Priv
(afterId
) [after $delay [list tk::ButtonAutoInvoke $w]]
627 # ::tk::CheckRadioInvoke --
628 # The procedure below is invoked when the mouse button is pressed in
629 # a checkbutton or radiobutton widget, or when the widget is invoked
630 # through the keyboard. It invokes the widget if it
634 # w - The name of the widget.
635 # cmd - The subcommand to invoke (one of invoke, select, or deselect).
637 proc ::tk::CheckRadioInvoke {w
{cmd invoke
}} {
638 if {[$w cget
-state] ne
"disabled"} {
639 uplevel #0 [list $w $cmd]
643 # Special versions of the handlers for checkbuttons on Unix that do the magic
644 # to make things work right when the checkbutton indicator is hidden;
645 # radiobuttons don't need this complexity.
647 # ::tk::CheckInvoke --
648 # The procedure below invokes the checkbutton, like ButtonInvoke, but handles
649 # what to do when the checkbutton indicator is missing. Only used on Unix.
652 # w - The name of the widget.
654 proc ::tk::CheckInvoke {w
} {
656 if {[$w cget
-state] ne
"disabled"} {
657 # Additional logic to switch the "selected" colors around if necessary
658 # (when we're indicator-less).
660 if {![$w cget
-indicatoron] && [info exist Priv
($w,selectcolor
)]} {
661 if {[$w cget
-selectcolor] eq
$Priv($w,aselectcolor
)} {
662 $w configure
-selectcolor $Priv($w,selectcolor
)
664 $w configure
-selectcolor $Priv($w,aselectcolor
)
667 uplevel #0 [list $w invoke]
671 # ::tk::CheckEnter --
672 # The procedure below enters the checkbutton, like ButtonEnter, but handles
673 # what to do when the checkbutton indicator is missing. Only used on Unix.
676 # w - The name of the widget.
678 proc ::tk::CheckEnter {w
} {
680 if {[$w cget
-state] ne
"disabled"} {
681 # On unix the state is active just with mouse-over
682 $w configure
-state active
684 # If the mouse button is down, set the relief to sunken on entry.
685 # Overwise, if there's an -overrelief value, set the relief to that.
687 set Priv
($w,relief
) [$w cget
-relief]
688 if {$Priv(buttonWindow
) eq
$w} {
689 $w configure
-relief sunken
690 set Priv
($w,prelief
) sunken
691 } elseif
{[set over
[$w cget
-overrelief]] ne
""} {
692 $w configure
-relief $over
693 set Priv
($w,prelief
) $over
696 # Compute what the "selected and active" color should be.
698 if {![$w cget
-indicatoron] && [$w cget
-selectcolor] ne
""} {
699 set Priv
($w,selectcolor
) [$w cget
-selectcolor]
700 lassign
[winfo rgb
$w [$w cget
-selectcolor]] r1 g1 b1
701 lassign
[winfo rgb
$w [$w cget
-activebackground]] r2 g2 b2
702 set Priv
($w,aselectcolor
) \
703 [format "#%04x%04x%04x" [expr {($r1+$r2)/2}] \
704 [expr {($g1+$g2)/2}] [expr {($b1+$b2)/2}]]
705 # use uplevel to work with other var resolvers
706 if {[uplevel #0 [list set [$w cget -variable]]]
707 eq
[$w cget
-onvalue]} {
708 $w configure
-selectcolor $Priv($w,aselectcolor
)
715 # ::tk::CheckLeave --
716 # The procedure below leaves the checkbutton, like ButtonLeave, but handles
717 # what to do when the checkbutton indicator is missing. Only used on Unix.
720 # w - The name of the widget.
722 proc ::tk::CheckLeave {w
} {
724 if {[$w cget
-state] ne
"disabled"} {
725 $w configure
-state normal
728 # Restore the original button "selected" color; assume that the user
729 # wasn't monkeying around with things too much.
731 if {![$w cget
-indicatoron] && [info exist Priv
($w,selectcolor
)]} {
732 $w configure
-selectcolor $Priv($w,selectcolor
)
734 unset -nocomplain Priv
($w,selectcolor
) Priv
($w,aselectcolor
)
736 # Restore the original button relief if it was changed by Tk. That is
737 # signaled by the existence of Priv($w,prelief).
739 if {[info exists Priv
($w,relief
)]} {
740 if {[info exists Priv
($w,prelief
)] && \
741 $Priv($w,prelief
) eq
[$w cget
-relief]} {
742 $w configure
-relief $Priv($w,relief
)
744 unset -nocomplain Priv
($w,relief
) Priv
($w,prelief
)