summaryrefslogtreecommitdiffstats
path: root/library/button.tcl
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2009-10-24 00:01:47 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2009-10-24 00:01:47 (GMT)
commit111d9451cc192469f7e9d1224dc30bcebe3e82fd (patch)
tree1588ba220ec9926c5a4063017aa92302ec0b4241 /library/button.tcl
parent1c3b7359656edd8a158c3056d26d732e01c34994 (diff)
downloadtk-111d9451cc192469f7e9d1224dc30bcebe3e82fd.zip
tk-111d9451cc192469f7e9d1224dc30bcebe3e82fd.tar.gz
tk-111d9451cc192469f7e9d1224dc30bcebe3e82fd.tar.bz2
[Patch 1530276]: Improve no-indicator check/radio buttons on Unix.
Diffstat (limited to 'library/button.tcl')
-rw-r--r--library/button.tcl132
1 files changed, 125 insertions, 7 deletions
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: