Fix [4566e2b83d]: wrong background colors in Aqua

2 files changed, 47 insertions, 22 deletions

diff --git a/library/demos/twind.tcl b/library/demos/twind.tcl
index 39e5110..df879e3 100644
--- a/library/demos/twind.tcl
+++ b/library/demos/twind.tcl
@@ -9,6 +9,14 @@ if {![info exists widgetDemo]} {
 
 package require Tk
 
+# Make an Aqua button's fill color match its parent's background
+proc blend {bt} {
+    if {[tk windowingsystem] eq "aqua"} {
+	$bt configure -highlightbackground [[winfo parent $bt] cget -background]
+    }
+    return $bt
+}
+
 set w .twind
 catch {destroy $w}
 toplevel $w
@@ -53,17 +61,19 @@ $t insert end "it.  These are called \"embedded windows\", "
 $t insert end "and they can consist of arbitrary widgets.  "
 $t insert end "For example, here are two embedded button "
 $t insert end "widgets.  You can click on the first button to "
-$t window create end -window $t.on
+$t window create end -window [blend $t.on]
 $t insert end " horizontal scrolling, which also turns off "
 $t insert end "word wrapping.  Or, you can click on the second "
 $t insert end "button to\n"
-$t window create end -window $t.off
+$t window create end -window [blend $t.off]
 $t insert end " horizontal scrolling and turn back on word wrapping.\n\n"
 
 $t insert end "Or, here is another example.  If you "
 $t window create end -create {
     button %W.click -text "Click Here" -command "textWindPlot %W" \
-	    -cursor top_left_arrow}
+	-cursor top_left_arrow
+    blend %W.click
+}
 
 $t insert end " a canvas displaying an x-y plot will appear right here."
 $t mark set plot insert
@@ -72,7 +82,8 @@ $t insert end "  You can drag the data points around with the mouse, "
 $t insert end "or you can click here to "
 $t window create end -create {
     button %W.delete -text "Delete" -command "textWindDel %W" \
-	    -cursor top_left_arrow
+	-cursor top_left_arrow
+    blend %W.delete
 }
 $t insert end " the plot again.\n\n"
 
@@ -80,7 +91,8 @@ $t insert end "You can also create multiple text widgets each of which "
 $t insert end "display the same underlying text. Click this button to "
 $t window create end \
   -create {button %W.peer -text "Make A Peer" -command "textMakePeer %W" \
-  -cursor top_left_arrow} -padx 3
+	       -cursor top_left_arrow
+      blend %W.peer} -padx 3
 $t insert end " widget.  Notice how peer widgets can have different "
 $t insert end "font settings, and by default contain all the images "
 $t insert end "of the 'parent', but that the embedded windows, "
@@ -92,7 +104,8 @@ $t insert end "designed to show up in all peers.)  A good use of "
 $t insert end "peers is for "
 $t window create end \
   -create {button %W.split -text "Split Windows" -command "textSplitWindow %W" \
-  -cursor top_left_arrow} -padx 3
+	       -cursor top_left_arrow
+      blend %W.split} -padx 3
 $t insert end " \n\n"
 
 $t insert end "Users of previous versions of Tk will also be interested "
@@ -128,11 +141,11 @@ foreach color {AntiqueWhite3 Bisque1 Bisque2 Bisque3 Bisque4
 	DarkSlateGray1 Aquamarine2 DarkSeaGreen2 SeaGreen1
 	Yellow1 IndianRed1 IndianRed2 Tan1 Tan4} {
     button $t.color$i -text $color -cursor top_left_arrow -command \
-	    "$t configure -bg $color"
-    $t window create end -window $t.color$i -padx 3 -pady 2
+	    "changeBg $t $color"
+    $t window create end -window [blend $t.color$i] -padx 3 -pady 2
     incr i
 }
-$t tag add buttons $t.default end
+$t tag add buttons [blend $t.default] end
 
 button $t.bigB -text "Big borders" -command "textWindBigB $t" \
   -cursor top_left_arrow
@@ -153,12 +166,12 @@ set text_normal(pad) [$t cget -padx]
 
 $t insert end "\nYou can also change the usual border width and "
 $t insert end "highlightthickness and padding.\n"
-$t window create end -window $t.bigB
-$t window create end -window $t.smallB
-$t window create end -window $t.bigH
-$t window create end -window $t.smallH
-$t window create end -window $t.bigP
-$t window create end -window $t.smallP
+$t window create end -window [blend $t.bigB]
+$t window create end -window [blend $t.smallB]
+$t window create end -window [blend $t.bigH]
+$t window create end -window [blend $t.smallH]
+$t window create end -window [blend $t.bigP]
+$t window create end -window [blend $t.smallP]
 
 $t insert end "\n\nFinally, images fit comfortably in text widgets too:"
 
@@ -189,7 +202,6 @@ proc textWindSmallP w {
     $w configure -padx $::text_normal(pad) -pady $::text_normal(pad)
 }
 
-
 proc textWindOn w {
     catch {destroy $w.scroll2}
     set t $w.f.text
@@ -290,8 +302,20 @@ proc textWindDel t {
     }
 }
 
+proc changeBg {t c} {
+    $t configure -background $c
+    if {[tk windowingsystem] eq "aqua"} {
+	foreach b [$t window names] {
+	    if {[winfo class $b] eq "Button"} {
+		$b configure -highlightbackground $c
+	    }
+	}
+    }
+}
+
 proc embDefBg t {
-    $t configure -background [lindex [$t configure -background] 3]
+    set bg [lindex [$t configure -background] 3]
+    changeBg $t $bg 
 }
 
 proc textMakePeer {parent} {
diff --git a/macosx/tkMacOSXDefault.h b/macosx/tkMacOSXDefault.h
index 6bc9bdc..4cdae53 100644
--- a/macosx/tkMacOSXDefault.h
+++ b/macosx/tkMacOSXDefault.h
@@ -35,9 +35,10 @@
 
 #define BLACK			"Black"
 #define WHITE			"White"
-#define NORMAL_BG		"systemTextBackgroundColor"
+#define NORMAL_BG		"systemWindowBackgroundColor"
+#define TEXT_BG                 "systemTextBackgroundColor"
 #define NORMAL_FG		"systemTextColor"
-#define ACTIVE_BG		"systemTextBackgroundColor"
+#define ACTIVE_BG		"systemWindowBackgroundColor"
 #define ACTIVE_FG		"systemTextColor"
 #define SELECT_BG		"systemSelectedTextBackgroundColor"
 #define SELECT_FG		"systemSelectedTextColor"
@@ -171,7 +172,7 @@
 #define MAC_OSX_ENTRY_RELIEF		TK_RELIEF_SUNKEN
 #define MAC_OSX_ENTRY_SELECT_RELIEF	TK_RELIEF_FLAT
 
-#define DEF_ENTRY_BG_COLOR		NORMAL_BG
+#define DEF_ENTRY_BG_COLOR		TEXT_BG
 #define DEF_ENTRY_BG_MONO		WHITE
 #define DEF_ENTRY_BORDER_WIDTH		"2"
 #define DEF_ENTRY_CURSOR		"xterm"
@@ -250,7 +251,7 @@
  */
 
 #define DEF_LISTBOX_ACTIVE_STYLE	"dotbox"
-#define DEF_LISTBOX_BG_COLOR		NORMAL_BG
+#define DEF_LISTBOX_BG_COLOR		TEXT_BG
 #define DEF_LISTBOX_BG_MONO		WHITE
 #define DEF_LISTBOX_BORDER_WIDTH	"1"
 #define DEF_LISTBOX_CURSOR		""
@@ -504,7 +505,7 @@
  */
 
 #define DEF_TEXT_AUTO_SEPARATORS	"1"
-#define DEF_TEXT_BG_COLOR		NORMAL_BG
+#define DEF_TEXT_BG_COLOR		TEXT_BG
 #define DEF_TEXT_BG_MONO		WHITE
 #define DEF_TEXT_BLOCK_CURSOR		"0"
 #define DEF_TEXT_BORDER_WIDTH		"0"