[Patch 1530276]: Improve no-indicator check/radio buttons on Unix.

3 files changed, 137 insertions, 13 deletions

diff --git a/ChangeLog b/ChangeLog
index 4fa8ca5..41a0ad9 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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..a977c49 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.20 2009/10/24 00:01:48 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,115 @@ 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) ""
+}
+
+return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/unix/tkUnixButton.c b/unix/tkUnixButton.c
index 75e4df3..064a2f4 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.26 2008/11/05 22:20:59 nijtmans Exp $
+ * RCS: @(#) $Id: tkUnixButton.c,v 1.27 2009/10/24 00:01:48 dkf Exp $
  */
 
 #include "tkInt.h"
@@ -281,7 +281,7 @@ TkpDrawCheckIndicator(
     for (iy=0 ; iy<dim ; iy++) {
 	for (ix=0 ; ix<dim ; ix++) {
 	    XPutPixel(img, ix, iy,
-		    imgColors[button_images[imgstart+iy][imgsel+ix] - 'A'] );
+		    imgColors[button_images[imgstart+iy][imgsel+ix] - 'A']);
 	}
     }
 
@@ -295,9 +295,9 @@ TkpDrawCheckIndicator(
     copyGC = Tk_GetGC(tkwin, 0, &gcValues);
 
     XPutImage(display, pixmap, copyGC, img, 0, 0, 0, 0,
-	    (unsigned int)dim, (unsigned int)dim);
+	    (unsigned)dim, (unsigned)dim);
     XCopyArea(display, pixmap, d, copyGC, 0, 0,
-	    (unsigned int)dim, (unsigned int)dim, x, y);
+	    (unsigned)dim, (unsigned)dim, x, y);
 
     /*
      * Tidy up.
@@ -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;
     }