# 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.

#

# RCS: @(#) $Id: button.tcl,v 1.17 2002/09/04 02:05:52 hobbs Exp $

#

# Copyright (c) 1992-1994 The Regents of the University of California.

# Copyright (c) 1994-1996 Sun Microsystems, Inc.

# Copyright (c) 2002 ActiveState Corporation.

#

# 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 {[string equal [tk windowingsystem] "classic"]

	|| [string equal [tk windowingsystem] "aqua"]} {

    bind Radiobutton <Enter> {

	tk::ButtonEnter %W

    }

    bind Radiobutton <1> {

	tk::ButtonDown %W

    }

    bind Radiobutton <ButtonRelease-1> {

	tk::ButtonUp %W

    }

    bind Checkbutton <Enter> {

	tk::ButtonEnter %W

    }

    bind Checkbutton <1> {

	tk::ButtonDown %W

    }

    bind Checkbutton <ButtonRelease-1> {

	tk::ButtonUp %W

    }

}

if {[string equal "windows" $tcl_platform(platform)]} {

    bind Checkbutton <equal> {

	tk::CheckRadioInvoke %W select

    }

    bind Checkbutton <plus> {

	tk::CheckRadioInvoke %W select

    }

    bind Checkbutton <minus> {

	tk::CheckRadioInvoke %W deselect

    }

    bind Checkbutton <1> {

	tk::CheckRadioDown %W

    }

    bind Checkbutton <ButtonRelease-1> {

	tk::ButtonUp %W

    }

    bind Checkbutton <Enter> {

	tk::CheckRadioEnter %W

    }

    bind Radiobutton <1> {

	tk::CheckRadioDown %W

    }

    bind Radiobutton <ButtonRelease-1> {

	tk::ButtonUp %W

    }

    bind Radiobutton <Enter> {

	tk::CheckRadioEnter %W

    }

}

if {[string equal "x11" [tk windowingsystem]]} {

    bind Checkbutton <Return> {

	if {!$tk_strictMotif} {

	    tk::CheckRadioInvoke %W

	}

    }

    bind Radiobutton <Return> {

	if {!$tk_strictMotif} {

	    tk::CheckRadioInvoke %W

	}

    }

    bind Checkbutton <1> {

	tk::CheckRadioInvoke %W

    }

    bind Radiobutton <1> {

	tk::CheckRadioInvoke %W

    }

    bind Checkbutton <Enter> {

	tk::ButtonEnter %W

    }

    bind Radiobutton <Enter> {

	tk::ButtonEnter %W

    }

}

bind Button <space> {

    tk::ButtonInvoke %W

}

bind Checkbutton <space> {

    tk::CheckRadioInvoke %W

}

bind Radiobutton <space> {

    tk::CheckRadioInvoke %W

}

bind Button <FocusIn> {}

bind Button <Enter> {

    tk::ButtonEnter %W

}

bind Button <Leave> {

    tk::ButtonLeave %W

}

bind Button <1> {

    tk::ButtonDown %W

}

bind Button <ButtonRelease-1> {

    tk::ButtonUp %W

}

bind Checkbutton <FocusIn> {}

bind Checkbutton <Leave> {

    tk::ButtonLeave %W

}

bind Radiobutton <FocusIn> {}

bind Radiobutton <Leave> {

    tk::ButtonLeave %W

}

if {[string equal "windows" $tcl_platform(platform)]} {

#########################

# Windows implementation 

#########################

# ::tk::ButtonEnter --

# 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 ::tk::ButtonEnter w {

    variable ::tk::Priv

    if {[$w cget -state] ne "disabled"} {

	# If the mouse button is down, set the relief to sunken on entry.

	# Overwise, if there's an -overrelief value, set the relief to that.

	set Priv($w,relief) [$w cget -relief]

	if {$Priv(buttonWindow) eq $w} {

	    $w configure -relief sunken -state active

	    set Priv($w,prelief) sunken

	} elseif {[set over [$w cget -overrelief]] ne ""} {

	    $w configure -relief $over

	    set Priv($w,prelief) $over

	}

    }

    set Priv(window) $w

}

# ::tk::ButtonLeave --

# The procedure below is invoked when the mouse pointer leaves a

# button widget.  It changes the state of the button back to inactive.

# Restore any modified relief too.

#

# Arguments:

# w -		The name of the widget.

proc ::tk::ButtonLeave w {

    variable ::tk::Priv

    if {[$w cget -state] ne "disabled"} {

	$w configure -state normal

    }

    # Restore the original button relief if it was changed by Tk.

    # That is signaled by the existence of Priv($w,prelief).

    if {[info exists Priv($w,relief)]} {

	if {[info exists Priv($w,prelief)] && \

		$Priv($w,prelief) eq [$w cget -relief]} {

	    $w configure -relief $Priv($w,relief)

	}

	unset -nocomplain Priv($w,relief) Priv($w,prelief)

    }

    set Priv(window) ""

}

# ::tk::ButtonDown --

# 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 ::tk::ButtonDown w {

    variable ::tk::Priv

    # Only save the button's relief if it does not yet exist.  If there

    # is an overrelief setting, Priv($w,relief) will already have been set,

    # and the current value of the -relief option will be incorrect.

    if {![info exists Priv($w,relief)]} {

	set Priv($w,relief) [$w cget -relief]

    }

    if {[$w cget -state] ne "disabled"} {

	set Priv(buttonWindow) $w

	$w configure -relief sunken -state active

	set Priv($w,prelief) sunken

	# If this button has a repeatdelay set up, get it going with an after

	after cancel $Priv(afterId)

	set delay [$w cget -repeatdelay]

	set Priv(repeated) 0

	if {$delay > 0} {

	    set Priv(afterId) [after $delay [list tk::ButtonAutoInvoke $w]]

	}

    }

}

# ::tk::ButtonUp --

# 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 ::tk::ButtonUp w {

    variable ::tk::Priv

    if {$Priv(buttonWindow) eq $w} {

	set Priv(buttonWindow) ""

	# Restore the button's relief if it was cached.

	if {[info exists Priv($w,relief)]} {

	    if {[info exists Priv($w,prelief)] && \

		    $Priv($w,prelief) eq [$w cget -relief]} {

		$w configure -relief $Priv($w,relief)

	    }

	    unset -nocomplain Priv($w,relief) Priv($w,prelief)

	}

	# Clean up the after event from the auto-repeater

	after cancel $Priv(afterId)

	if {$Priv(window) eq $w && [$w cget -state] ne "disabled"} {

	    $w configure -state normal

	    # Only invoke the command if it wasn't already invoked by the

	    # auto-repeater functionality

	    if { $Priv(repeated) == 0 } {

		uplevel #0 [list $w invoke]

	    }

	}

    }

}

# ::tk::CheckRadioEnter --

# 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 ::tk::CheckRadioEnter w {

    variable ::tk::Priv

    if {[$w cget -state] ne "disabled"} {

	if {$Priv(buttonWindow) eq $w} {

	    $w configure -state active

	}

	if {[set over [$w cget -overrelief]] ne ""} {

	    set Priv($w,relief)  [$w cget -relief]

	    set Priv($w,prelief) $over

	    $w configure -relief $over

	}

    }

    set Priv(window) $w

}

# ::tk::CheckRadioDown --

# 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 ::tk::CheckRadioDown w {

    variable ::tk::Priv

    if {![info exists Priv($w,relief)]} {

	set Priv($w,relief) [$w cget -relief]

    }

    if {[$w cget -state] ne "disabled"} {

	set Priv(buttonWindow) $w

	set Priv(repeated) 0

	$w configure -state active

    }

}

}

if {[string equal "x11" [tk windowingsystem]]} {

#####################

# Unix implementation

#####################

# ::tk::ButtonEnter --

# 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 ::tk::ButtonEnter {w} {

    variable ::tk::Priv

    if {[$w cget -state] ne "disabled"} {

	# On unix the state is active just with mouse-over

	$w configure -state active

	# If the mouse button is down, set the relief to sunken on entry.

	# Overwise, if there's an -overrelief value, set the relief to that.

	set Priv($w,relief) [$w cget -relief]

	if {$Priv(buttonWindow) eq $w} {

	    $w configure -relief sunken

	    set Priv($w,prelief) sunken

	} elseif {[set over [$w cget -overrelief]] ne ""} {

	    $w configure -relief $over

	    set Priv($w,prelief) $over

	}

    }

    set Priv(window) $w

}

# ::tk::ButtonLeave --

# The procedure below is invoked when the mouse pointer leaves a

# button widget.  It changes the state of the button back to inactive.

# Restore any modified relief too.

#

# Arguments:

# w -		The name of the widget.

proc ::tk::ButtonLeave w {

    variable ::tk::Priv

    if {[$w cget -state] ne "disabled"} {

	$w configure -state normal

    }

    # Restore the original button relief if it was changed by Tk.

    # That is signaled by the existence of Priv($w,prelief).

    if {[info exists Priv($w,relief)]} {

	if {[info exists Priv($w,prelief)] && \

		$Priv($w,prelief) eq [$w cget -relief]} {

	    $w configure -relief $Priv($w,relief)

	}

	unset -nocomplain Priv($w,relief) Priv($w,prelief)

    }

    set Priv(window) ""

}

# ::tk::ButtonDown --

# 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 ::tk::ButtonDown w {

    variable ::tk::Priv

    # Only save the button's relief if it does not yet exist.  If there

    # is an overrelief setting, Priv($w,relief) will already have been set,

    # and the current value of the -relief option will be incorrect.

    if {![info exists Priv($w,relief)]} {

	set Priv($w,relief) [$w cget -relief]

    }

    if {[$w cget -state] ne "disabled"} {

	set Priv(buttonWindow) $w

	$w configure -relief sunken

	set Priv($w,prelief) sunken

	# If this button has a repeatdelay set up, get it going with an after

	after cancel $Priv(afterId)

	set delay [$w cget -repeatdelay]

	set Priv(repeated) 0

	if {$delay > 0} {

	    set Priv(afterId) [after $delay [list tk::ButtonAutoInvoke $w]]

	}

    }

}

# ::tk::ButtonUp --

# 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 ::tk::ButtonUp w {

    variable ::tk::Priv

    if {[string equal $w $Priv(buttonWindow)]} {

	set Priv(buttonWindow) ""

	# Restore the button's relief if it was cached.

	if {[info exists Priv($w,relief)]} {

	    if {[info exists Priv($w,prelief)] && \

		    $Priv($w,prelief) eq [$w cget -relief]} {

		$w configure -relief $Priv($w,relief)

	    }

	    unset -nocomplain Priv($w,relief) Priv($w,prelief)

	}

	# Clean up the after event from the auto-repeater

	after cancel $Priv(afterId)

	if {$Priv(window) eq $w && [$w cget -state] ne "disabled"} {

	    # Only invoke the command if it wasn't already invoked by the

	    # auto-repeater functionality

	    if { $Priv(repeated) == 0 } {

		uplevel #0 [list $w invoke]

	    }

	}

    }

}

}

if {[string equal [tk windowingsystem] "classic"]

	|| [string equal [tk windowingsystem] "aqua"]} {

####################

# Mac implementation

####################

# ::tk::ButtonEnter --

# 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 ::tk::ButtonEnter {w} {

    variable ::tk::Priv

    if {[$w cget -state] ne "disabled"} {

	# If there's an -overrelief value, set the relief to that.

	if {$Priv(buttonWindow) eq $w} {

	    $w configure -state active

	} elseif {[set over [$w cget -overrelief]] ne ""} {

	    set Priv($w,relief)  [$w cget -relief]

	    set Priv($w,prelief) $over

	    $w configure -relief $over

	}

    }

    set Priv(window) $w

}

# ::tk::ButtonLeave --

# 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 (Priv(buttonWindow) == $w), restore the relief of the

# button too.

#

# Arguments:

# w -		The name of the widget.

proc ::tk::ButtonLeave w {

    variable ::tk::Priv

    if {$w eq $Priv(buttonWindow)} {

	$w configure -state normal

    }

    # Restore the original button relief if it was changed by Tk.

    # That is signaled by the existence of Priv($w,prelief).

    if {[info exists Priv($w,relief)]} {

	if {[info exists Priv($w,prelief)] && \

		$Priv($w,prelief) eq [$w cget -relief]} {

	    $w configure -relief $Priv($w,relief)

	}

	unset -nocomplain Priv($w,relief) Priv($w,prelief)

    }

    set Priv(window) ""

}

# ::tk::ButtonDown --

# 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 ::tk::ButtonDown w {

    variable ::tk::Priv

    if {[$w cget -state] ne "disabled"} {

	set Priv(buttonWindow) $w

	$w configure -state active

	# If this button has a repeatdelay set up, get it going with an after

	after cancel $Priv(afterId)

	set Priv(repeated) 0