# 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]    }}