diff -r 000000000000 -r ae805ac0140d python-2.5.2/win32/tcl/tk8.4/button.tcl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/python-2.5.2/win32/tcl/tk8.4/button.tcl Fri Apr 03 17:19:34 2009 +0100 @@ -0,0 +1,639 @@ +# 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 { + tk::ButtonEnter %W + } + bind Radiobutton <1> { + tk::ButtonDown %W + } + bind Radiobutton { + tk::ButtonUp %W + } + bind Checkbutton { + tk::ButtonEnter %W + } + bind Checkbutton <1> { + tk::ButtonDown %W + } + bind Checkbutton { + tk::ButtonUp %W + } +} +if {[string equal "windows" $tcl_platform(platform)]} { + bind Checkbutton { + tk::CheckRadioInvoke %W select + } + bind Checkbutton { + tk::CheckRadioInvoke %W select + } + bind Checkbutton { + tk::CheckRadioInvoke %W deselect + } + bind Checkbutton <1> { + tk::CheckRadioDown %W + } + bind Checkbutton { + tk::ButtonUp %W + } + bind Checkbutton { + tk::CheckRadioEnter %W + } + + bind Radiobutton <1> { + tk::CheckRadioDown %W + } + bind Radiobutton { + tk::ButtonUp %W + } + bind Radiobutton { + tk::CheckRadioEnter %W + } +} +if {[string equal "x11" [tk windowingsystem]]} { + bind Checkbutton { + if {!$tk_strictMotif} { + tk::CheckRadioInvoke %W + } + } + bind Radiobutton { + if {!$tk_strictMotif} { + tk::CheckRadioInvoke %W + } + } + bind Checkbutton <1> { + tk::CheckRadioInvoke %W + } + bind Radiobutton <1> { + tk::CheckRadioInvoke %W + } + bind Checkbutton { + tk::ButtonEnter %W + } + bind Radiobutton { + tk::ButtonEnter %W + } +} + +bind Button { + tk::ButtonInvoke %W +} +bind Checkbutton { + tk::CheckRadioInvoke %W +} +bind Radiobutton { + tk::CheckRadioInvoke %W +} + +bind Button {} +bind Button { + tk::ButtonEnter %W +} +bind Button { + tk::ButtonLeave %W +} +bind Button <1> { + tk::ButtonDown %W +} +bind Button { + tk::ButtonUp %W +} + +bind Checkbutton {} +bind Checkbutton { + tk::ButtonLeave %W +} + +bind Radiobutton {} +bind Radiobutton { + 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 + if { ![catch {$w cget -repeatdelay} delay] } { + 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) "" + $w configure -state normal + + # 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] + } + } + } +} + +} + +################## +# Shared routines +################## + +# ::tk::ButtonInvoke -- +# 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 ::tk::ButtonInvoke w { + if {[$w cget -state] ne "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] + } +} + +# ::tk::ButtonAutoInvoke -- +# +# Invoke an auto-repeating button, and set it up to continue to repeat. +# +# Arguments: +# w button to invoke. +# +# Results: +# None. +# +# Side effects: +# May create an after event to call ::tk::ButtonAutoInvoke. + +proc ::tk::ButtonAutoInvoke {w} { + variable ::tk::Priv + after cancel $Priv(afterId) + set delay [$w cget -repeatinterval] + if {$Priv(window) eq $w} { + incr Priv(repeated) + uplevel #0 [list $w invoke] + } + if {$delay > 0} { + set Priv(afterId) [after $delay [list tk::ButtonAutoInvoke $w]] + } +} + +# ::tk::CheckRadioInvoke -- +# 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 ::tk::CheckRadioInvoke {w {cmd invoke}} { + if {[$w cget -state] ne "disabled"} { + uplevel #0 [list $w $cmd] + } +}