summaryrefslogtreecommitdiffstats
path: root/library/button.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'library/button.tcl')
-rw-r--r--library/button.tcl456
1 files changed, 456 insertions, 0 deletions
diff --git a/library/button.tcl b/library/button.tcl
new file mode 100644
index 0000000..b017b80
--- /dev/null
+++ b/library/button.tcl
@@ -0,0 +1,456 @@
+# button.tcl --
+#
+# This file defines the default bindings for Tk label, button,
+# checkbutton, and radiobutton widgets and provides procedures
+# that help in implementing those bindings.
+#
+# SCCS: @(#) button.tcl 1.22 96/11/14 14:49:11
+#
+# Copyright (c) 1992-1994 The Regents of the University of California.
+# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+#-------------------------------------------------------------------------
+# The code below creates the default class bindings for buttons.
+#-------------------------------------------------------------------------
+
+if {$tcl_platform(platform) == "macintosh"} {
+ bind Radiobutton <Enter> {
+ tkButtonEnter %W
+ }
+ bind Radiobutton <1> {
+ tkButtonDown %W
+ }
+ bind Radiobutton <ButtonRelease-1> {
+ tkButtonUp %W
+ }
+ bind Checkbutton <Enter> {
+ tkButtonEnter %W
+ }
+ bind Checkbutton <1> {
+ tkButtonDown %W
+ }
+ bind Checkbutton <ButtonRelease-1> {
+ tkButtonUp %W
+ }
+}
+if {$tcl_platform(platform) == "windows"} {
+ bind Checkbutton <equal> {
+ tkCheckRadioInvoke %W select
+ }
+ bind Checkbutton <plus> {
+ tkCheckRadioInvoke %W select
+ }
+ bind Checkbutton <minus> {
+ tkCheckRadioInvoke %W deselect
+ }
+ bind Checkbutton <1> {
+ tkCheckRadioDown %W
+ }
+ bind Checkbutton <ButtonRelease-1> {
+ tkButtonUp %W
+ }
+ bind Checkbutton <Enter> {
+ tkCheckRadioEnter %W
+ }
+
+ bind Radiobutton <1> {
+ tkCheckRadioDown %W
+ }
+ bind Radiobutton <ButtonRelease-1> {
+ tkButtonUp %W
+ }
+ bind Radiobutton <Enter> {
+ tkCheckRadioEnter %W
+ }
+}
+if {$tcl_platform(platform) == "unix"} {
+ bind Checkbutton <Return> {
+ if !$tk_strictMotif {
+ tkCheckRadioInvoke %W
+ }
+ }
+ bind Radiobutton <Return> {
+ if !$tk_strictMotif {
+ tkCheckRadioInvoke %W
+ }
+ }
+ bind Checkbutton <1> {
+ tkCheckRadioInvoke %W
+ }
+ bind Radiobutton <1> {
+ tkCheckRadioInvoke %W
+ }
+ bind Checkbutton <Enter> {
+ tkButtonEnter %W
+ }
+ bind Radiobutton <Enter> {
+ tkButtonEnter %W
+ }
+}
+
+bind Button <space> {
+ tkButtonInvoke %W
+}
+bind Checkbutton <space> {
+ tkCheckRadioInvoke %W
+}
+bind Radiobutton <space> {
+ tkCheckRadioInvoke %W
+}
+
+bind Button <FocusIn> {}
+bind Button <Enter> {
+ tkButtonEnter %W
+}
+bind Button <Leave> {
+ tkButtonLeave %W
+}
+bind Button <1> {
+ tkButtonDown %W
+}
+bind Button <ButtonRelease-1> {
+ tkButtonUp %W
+}
+
+bind Checkbutton <FocusIn> {}
+bind Checkbutton <Leave> {
+ tkButtonLeave %W
+}
+
+bind Radiobutton <FocusIn> {}
+bind Radiobutton <Leave> {
+ tkButtonLeave %W
+}
+
+if {$tcl_platform(platform) == "windows"} {
+
+#########################
+# Windows implementation
+#########################
+
+# tkButtonEnter --
+# The procedure below is invoked when the mouse pointer enters a
+# button widget. It records the button we're in and changes the
+# state of the button to active unless the button is disabled.
+#
+# Arguments:
+# w - The name of the widget.
+
+proc tkButtonEnter w {
+ global tkPriv
+ if {[$w cget -state] != "disabled"} {
+ if {$tkPriv(buttonWindow) == $w} {
+ $w configure -state active -relief sunken
+ }
+ }
+ set tkPriv(window) $w
+}
+
+# tkButtonLeave --
+# The procedure below is invoked when the mouse pointer leaves a
+# button widget. It changes the state of the button back to
+# inactive. If we're leaving the button window with a mouse button
+# pressed (tkPriv(buttonWindow) == $w), restore the relief of the
+# button too.
+#
+# Arguments:
+# w - The name of the widget.
+
+proc tkButtonLeave w {
+ global tkPriv
+ if {[$w cget -state] != "disabled"} {
+ $w config -state normal
+ }
+ if {$w == $tkPriv(buttonWindow)} {
+ $w configure -relief $tkPriv(relief)
+ }
+ set tkPriv(window) ""
+}
+
+# tkCheckRadioEnter --
+# The procedure below is invoked when the mouse pointer enters a
+# checkbutton or radiobutton widget. It records the button we're in
+# and changes the state of the button to active unless the button is
+# disabled.
+#
+# Arguments:
+# w - The name of the widget.
+
+proc tkCheckRadioEnter w {
+ global tkPriv
+ if {[$w cget -state] != "disabled"} {
+ if {$tkPriv(buttonWindow) == $w} {
+ $w configure -state active
+ }
+ }
+ set tkPriv(window) $w
+}
+
+# tkButtonDown --
+# The procedure below is invoked when the mouse button is pressed in
+# a button widget. It records the fact that the mouse is in the button,
+# saves the button's relief so it can be restored later, and changes
+# the relief to sunken.
+#
+# Arguments:
+# w - The name of the widget.
+
+proc tkButtonDown w {
+ global tkPriv
+ set tkPriv(relief) [lindex [$w conf -relief] 4]
+ if {[$w cget -state] != "disabled"} {
+ set tkPriv(buttonWindow) $w
+ $w config -relief sunken -state active
+ }
+}
+
+# tkCheckRadioDown --
+# The procedure below is invoked when the mouse button is pressed in
+# a button widget. It records the fact that the mouse is in the button,
+# saves the button's relief so it can be restored later, and changes
+# the relief to sunken.
+#
+# Arguments:
+# w - The name of the widget.
+
+proc tkCheckRadioDown w {
+ global tkPriv
+ set tkPriv(relief) [lindex [$w conf -relief] 4]
+ if {[$w cget -state] != "disabled"} {
+ set tkPriv(buttonWindow) $w
+ $w config -state active
+ }
+}
+
+# tkButtonUp --
+# The procedure below is invoked when the mouse button is released
+# in a button widget. It restores the button's relief and invokes
+# the command as long as the mouse hasn't left the button.
+#
+# Arguments:
+# w - The name of the widget.
+
+proc tkButtonUp w {
+ global tkPriv
+ if {$w == $tkPriv(buttonWindow)} {
+ set tkPriv(buttonWindow) ""
+ if {($w == $tkPriv(window))
+ && ([$w cget -state] != "disabled")} {
+ $w config -relief $tkPriv(relief) -state normal
+ uplevel #0 [list $w invoke]
+ }
+ }
+}
+
+}
+
+if {$tcl_platform(platform) == "unix"} {
+
+#####################
+# Unix implementation
+#####################
+
+# tkButtonEnter --
+# The procedure below is invoked when the mouse pointer enters a
+# button widget. It records the button we're in and changes the
+# state of the button to active unless the button is disabled.
+#
+# Arguments:
+# w - The name of the widget.
+
+proc tkButtonEnter {w} {
+ global tkPriv
+ if {[$w cget -state] != "disabled"} {
+ $w config -state active
+ if {$tkPriv(buttonWindow) == $w} {
+ $w configure -state active -relief sunken
+ }
+ }
+ set tkPriv(window) $w
+}
+
+# tkButtonLeave --
+# The procedure below is invoked when the mouse pointer leaves a
+# button widget. It changes the state of the button back to
+# inactive. If we're leaving the button window with a mouse button
+# pressed (tkPriv(buttonWindow) == $w), restore the relief of the
+# button too.
+#
+# Arguments:
+# w - The name of the widget.
+
+proc tkButtonLeave w {
+ global tkPriv
+ if {[$w cget -state] != "disabled"} {
+ $w config -state normal
+ }
+ if {$w == $tkPriv(buttonWindow)} {
+ $w configure -relief $tkPriv(relief)
+ }
+ set tkPriv(window) ""
+}
+
+# tkButtonDown --
+# The procedure below is invoked when the mouse button is pressed in
+# a button widget. It records the fact that the mouse is in the button,
+# saves the button's relief so it can be restored later, and changes
+# the relief to sunken.
+#
+# Arguments:
+# w - The name of the widget.
+
+proc tkButtonDown w {
+ global tkPriv
+ set tkPriv(relief) [lindex [$w config -relief] 4]
+ if {[$w cget -state] != "disabled"} {
+ set tkPriv(buttonWindow) $w
+ $w config -relief sunken
+ }
+}
+
+# tkButtonUp --
+# The procedure below is invoked when the mouse button is released
+# in a button widget. It restores the button's relief and invokes
+# the command as long as the mouse hasn't left the button.
+#
+# Arguments:
+# w - The name of the widget.
+
+proc tkButtonUp w {
+ global tkPriv
+ if {$w == $tkPriv(buttonWindow)} {
+ set tkPriv(buttonWindow) ""
+ $w config -relief $tkPriv(relief)
+ if {($w == $tkPriv(window))
+ && ([$w cget -state] != "disabled")} {
+ uplevel #0 [list $w invoke]
+ }
+ }
+}
+
+}
+
+if {$tcl_platform(platform) == "macintosh"} {
+
+####################
+# Mac implementation
+####################
+
+# tkButtonEnter --
+# The procedure below is invoked when the mouse pointer enters a
+# button widget. It records the button we're in and changes the
+# state of the button to active unless the button is disabled.
+#
+# Arguments:
+# w - The name of the widget.
+
+proc tkButtonEnter {w} {
+ global tkPriv
+ if {[$w cget -state] != "disabled"} {
+ if {$tkPriv(buttonWindow) == $w} {
+ $w configure -state active
+ }
+ }
+ set tkPriv(window) $w
+}
+
+# tkButtonLeave --
+# The procedure below is invoked when the mouse pointer leaves a
+# button widget. It changes the state of the button back to
+# inactive. If we're leaving the button window with a mouse button
+# pressed (tkPriv(buttonWindow) == $w), restore the relief of the
+# button too.
+#
+# Arguments:
+# w - The name of the widget.
+
+proc tkButtonLeave w {
+ global tkPriv
+ if {$w == $tkPriv(buttonWindow)} {
+ $w configure -state normal
+ }
+ set tkPriv(window) ""
+}
+
+# tkButtonDown --
+# The procedure below is invoked when the mouse button is pressed in
+# a button widget. It records the fact that the mouse is in the button,
+# saves the button's relief so it can be restored later, and changes
+# the relief to sunken.
+#
+# Arguments:
+# w - The name of the widget.
+
+proc tkButtonDown w {
+ global tkPriv
+ if {[$w cget -state] != "disabled"} {
+ set tkPriv(buttonWindow) $w
+ $w config -state active
+ }
+}
+
+# tkButtonUp --
+# The procedure below is invoked when the mouse button is released
+# in a button widget. It restores the button's relief and invokes
+# the command as long as the mouse hasn't left the button.
+#
+# Arguments:
+# w - The name of the widget.
+
+proc tkButtonUp w {
+ global tkPriv
+ if {$w == $tkPriv(buttonWindow)} {
+ $w config -state normal
+ set tkPriv(buttonWindow) ""
+ if {($w == $tkPriv(window))
+ && ([$w cget -state] != "disabled")} {
+ uplevel #0 [list $w invoke]
+ }
+ }
+}
+
+}
+
+##################
+# Shared routines
+##################
+
+# tkButtonInvoke --
+# The procedure below is called when a button is invoked through
+# the keyboard. It simulate a press of the button via the mouse.
+#
+# Arguments:
+# w - The name of the widget.
+
+proc tkButtonInvoke w {
+ if {[$w cget -state] != "disabled"} {
+ set oldRelief [$w cget -relief]
+ set oldState [$w cget -state]
+ $w configure -state active -relief sunken
+ update idletasks
+ after 100
+ $w configure -state $oldState -relief $oldRelief
+ uplevel #0 [list $w invoke]
+ }
+}
+
+# tkCheckRadioInvoke --
+# The procedure below is invoked when the mouse button is pressed in
+# a checkbutton or radiobutton widget, or when the widget is invoked
+# through the keyboard. It invokes the widget if it
+# isn't disabled.
+#
+# Arguments:
+# w - The name of the widget.
+# cmd - The subcommand to invoke (one of invoke, select, or deselect).
+
+proc tkCheckRadioInvoke {w {cmd invoke}} {
+ if {[$w cget -state] != "disabled"} {
+ uplevel #0 [list $w $cmd]
+ }
+}
+