diff options
author | dkf <dkf@noemail.net> | 2009-10-24 00:12:02 (GMT) |
---|---|---|
committer | dkf <dkf@noemail.net> | 2009-10-24 00:12:02 (GMT) |
commit | 351b052fcf2657f7a82a1cbbb2dc7dddf7556ab2 (patch) | |
tree | e73df86a4ddcc87e6c7b3dd165631037070b225f | |
parent | dacedaa426c648357ad8981ae44e9b8f130fc720 (diff) | |
download | tk-351b052fcf2657f7a82a1cbbb2dc7dddf7556ab2.zip tk-351b052fcf2657f7a82a1cbbb2dc7dddf7556ab2.tar.gz tk-351b052fcf2657f7a82a1cbbb2dc7dddf7556ab2.tar.bz2 |
[Patch 1530276]: Improve no-indicator check/radio buttons on Unix.
FossilOrigin-Name: 11c4a84de4f130f11dc2e4cdc7962469dd5517bd
-rw-r--r-- | ChangeLog | 6 | ||||
-rw-r--r-- | library/button.tcl | 125 | ||||
-rw-r--r-- | unix/tkUnixButton.c | 6 |
3 files changed, 127 insertions, 10 deletions
@@ -1,3 +1,9 @@ +2009-10-24 Donal K. Fellows <dkf@users.sf.net> + + * library/button.tcl, unix/tkUnixButton.c (TkpDisplayButton): + [Patch 1530276]: Make -selectcolor handling work better for both + checkbuttons and radiobuttons when they don't have indicators. + 2009-10-22 Donal K. Fellows <dkf@users.sf.net> * generic/tkText.c (CreateWidget, TextEditUndo, TextEditRedo) diff --git a/library/button.tcl b/library/button.tcl index 28c233b..0d493fb 100644 --- a/library/button.tcl +++ b/library/button.tcl @@ -4,7 +4,7 @@ # checkbutton, and radiobutton widgets and provides procedures # that help in implementing those bindings. # -# RCS: @(#) $Id: button.tcl,v 1.19 2005/07/25 09:06:01 dkf Exp $ +# RCS: @(#) $Id: button.tcl,v 1.19.4.1 2009/10/24 00:12:03 dkf Exp $ # # Copyright (c) 1992-1994 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. @@ -37,6 +37,9 @@ if {[tk windowingsystem] eq "aqua"} { bind Checkbutton <ButtonRelease-1> { tk::ButtonUp %W } + bind Checkbutton <Leave> { + tk::ButtonLeave %W + } } if {"windows" eq $tcl_platform(platform)} { bind Checkbutton <equal> { @@ -57,6 +60,9 @@ if {"windows" eq $tcl_platform(platform)} { bind Checkbutton <Enter> { tk::CheckRadioEnter %W } + bind Checkbutton <Leave> { + tk::ButtonLeave %W + } bind Radiobutton <1> { tk::CheckRadioDown %W @@ -71,7 +77,7 @@ if {"windows" eq $tcl_platform(platform)} { if {"x11" eq [tk windowingsystem]} { bind Checkbutton <Return> { if {!$tk_strictMotif} { - tk::CheckRadioInvoke %W + tk::CheckInvoke %W } } bind Radiobutton <Return> { @@ -80,17 +86,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> { @@ -118,9 +127,6 @@ bind Button <ButtonRelease-1> { } bind Checkbutton <FocusIn> {} -bind Checkbutton <Leave> { - tk::ButtonLeave %W -} bind Radiobutton <FocusIn> {} bind Radiobutton <Leave> { @@ -635,3 +641,108 @@ 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]} { + 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]} { + 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}]] + if {[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) "" +} diff --git a/unix/tkUnixButton.c b/unix/tkUnixButton.c index b8be6b3..0ca30f2 100644 --- a/unix/tkUnixButton.c +++ b/unix/tkUnixButton.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkUnixButton.c,v 1.25 2007/12/13 15:28:50 dgp Exp $ + * RCS: @(#) $Id: tkUnixButton.c,v 1.25.2.1 2009/10/24 00:12:03 dkf Exp $ */ #include "tkInt.h" @@ -389,8 +389,8 @@ TkpDisplayButton( } else { gc = butPtr->normalTextGC; } - if ((butPtr->flags & SELECTED) && (butPtr->state != STATE_ACTIVE) - && (butPtr->selectBorder != NULL) && !butPtr->indicatorOn) { + if ((butPtr->flags & SELECTED) && (butPtr->selectBorder != NULL) + && !butPtr->indicatorOn) { border = butPtr->selectBorder; } |