diff options
Diffstat (limited to 'library/button.tcl')
| -rw-r--r-- | library/button.tcl | 129 |
1 files changed, 121 insertions, 8 deletions
diff --git a/library/button.tcl b/library/button.tcl index 195566e..d095b8a 100644 --- a/library/button.tcl +++ b/library/button.tcl @@ -16,7 +16,7 @@ # The code below creates the default class bindings for buttons. #------------------------------------------------------------------------- -if {[tk windowingsystem] eq "classic" || [tk windowingsystem] eq "aqua"} { +if {[tk windowingsystem] eq "aqua"} { bind Radiobutton <Enter> { tk::ButtonEnter %W } @@ -35,6 +35,9 @@ if {[tk windowingsystem] eq "classic" || [tk windowingsystem] eq "aqua"} { bind Checkbutton <ButtonRelease-1> { tk::ButtonUp %W } + bind Checkbutton <Leave> { + tk::ButtonLeave %W + } } if {"win32" eq [tk windowingsystem]} { bind Checkbutton <equal> { @@ -55,6 +58,9 @@ if {"win32" eq [tk windowingsystem]} { bind Checkbutton <Enter> { tk::CheckRadioEnter %W } + bind Checkbutton <Leave> { + tk::ButtonLeave %W + } bind Radiobutton <1> { tk::CheckRadioDown %W @@ -69,7 +75,7 @@ if {"win32" eq [tk windowingsystem]} { if {"x11" eq [tk windowingsystem]} { bind Checkbutton <Return> { if {!$tk_strictMotif} { - tk::CheckRadioInvoke %W + tk::CheckInvoke %W } } bind Radiobutton <Return> { @@ -78,17 +84,20 @@ if {"x11" eq [tk windowingsystem]} { } } bind Checkbutton <1> { - tk::CheckRadioInvoke %W + tk::CheckInvoke %W } bind Radiobutton <1> { tk::CheckRadioInvoke %W } bind Checkbutton <Enter> { - tk::ButtonEnter %W + tk::CheckEnter %W } bind Radiobutton <Enter> { tk::ButtonEnter %W } + bind Checkbutton <Leave> { + tk::CheckLeave %W + } } bind Button <space> { @@ -116,9 +125,6 @@ bind Button <ButtonRelease-1> { } bind Checkbutton <FocusIn> {} -bind Checkbutton <Leave> { - tk::ButtonLeave %W -} bind Radiobutton <FocusIn> {} bind Radiobutton <Leave> { @@ -442,7 +448,7 @@ proc ::tk::ButtonUp w { } -if {[tk windowingsystem] eq "classic" || [tk windowingsystem] eq "aqua"} { +if {[tk windowingsystem] eq "aqua"} { #################### # Mac implementation @@ -633,3 +639,110 @@ proc ::tk::CheckRadioInvoke {w {cmd invoke}} { uplevel #0 [list $w $cmd] } } + +# Special versions of the handlers for checkbuttons on Unix that do the magic +# to make things work right when the checkbutton indicator is hidden; +# radiobuttons don't need this complexity. + +# ::tk::CheckInvoke -- +# The procedure below invokes the checkbutton, like ButtonInvoke, but handles +# what to do when the checkbutton indicator is missing. Only used on Unix. +# +# Arguments: +# w - The name of the widget. + +proc ::tk::CheckInvoke {w} { + variable ::tk::Priv + if {[$w cget -state] ne "disabled"} { + # Additional logic to switch the "selected" colors around if necessary + # (when we're indicator-less). + + if {![$w cget -indicatoron] && [info exist Priv($w,selectcolor)]} { + if {[$w cget -selectcolor] eq $Priv($w,aselectcolor)} { + $w configure -selectcolor $Priv($w,selectcolor) + } else { + $w configure -selectcolor $Priv($w,aselectcolor) + } + } + uplevel #0 [list $w invoke] + } +} + +# ::tk::CheckEnter -- +# The procedure below enters the checkbutton, like ButtonEnter, but handles +# what to do when the checkbutton indicator is missing. Only used on Unix. +# +# Arguments: +# w - The name of the widget. + +proc ::tk::CheckEnter {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 + } + + # Compute what the "selected and active" color should be. + + if {![$w cget -indicatoron] && [$w cget -selectcolor] ne ""} { + set Priv($w,selectcolor) [$w cget -selectcolor] + lassign [winfo rgb $w [$w cget -selectcolor]] r1 g1 b1 + lassign [winfo rgb $w [$w cget -activebackground]] r2 g2 b2 + set Priv($w,aselectcolor) \ + [format "#%04x%04x%04x" [expr {($r1+$r2)/2}] \ + [expr {($g1+$g2)/2}] [expr {($b1+$b2)/2}]] + # use uplevel to work with other var resolvers + if {[uplevel #0 [list set [$w cget -variable]]] + eq [$w cget -onvalue]} { + $w configure -selectcolor $Priv($w,aselectcolor) + } + } + } + set Priv(window) $w +} + +# ::tk::CheckLeave -- +# The procedure below leaves the checkbutton, like ButtonLeave, but handles +# what to do when the checkbutton indicator is missing. Only used on Unix. +# +# Arguments: +# w - The name of the widget. + +proc ::tk::CheckLeave {w} { + variable ::tk::Priv + if {[$w cget -state] ne "disabled"} { + $w configure -state normal + } + + # Restore the original button "selected" color; assume that the user + # wasn't monkeying around with things too much. + + if {![$w cget -indicatoron] && [info exist Priv($w,selectcolor)]} { + $w configure -selectcolor $Priv($w,selectcolor) + } + unset -nocomplain Priv($w,selectcolor) Priv($w,aselectcolor) + + # 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) "" +} |