Try to improve combobox appearance on OSX + Tk 8.5 [#1780286].

2 files changed, 70 insertions, 40 deletions

diff --git a/ChangeLog b/ChangeLog
index dc68847..ad0f1ed 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2007-09-17  Joe English  <jenglish@users.sourceforge.net>
+
+	* library/ttk/combobox.tcl:  Try to improve combobox appearance
+	on OSX + Tk 8.5 [#1780286].
+
 2007-09-15  Daniel Steffen  <das@users.sourceforge.net>
 
 	* unix/tcl.m4: 	replace all direct references to compiler by ${CC} to
diff --git a/library/ttk/combobox.tcl b/library/ttk/combobox.tcl
index 5af7a2d..e9d8d3f 100644
--- a/library/ttk/combobox.tcl
+++ b/library/ttk/combobox.tcl
@@ -1,7 +1,7 @@
 #
-# $Id: combobox.tcl,v 1.3 2006/12/17 21:09:46 jenglish Exp $
+# $Id: combobox.tcl,v 1.4 2007/09/17 14:56:56 jenglish Exp $
 #
-# Ttk widget set: combobox bindings.
+# Combobox bindings.
 #
 # Each combobox $cb has a child $cb.popdown, which contains
 # a listbox $cb.popdown.l and a scrollbar.  The listbox -listvariable
@@ -60,9 +60,9 @@ bind ComboboxListbox <Motion> {
 # but on Windows and OSX that doesn't prevent the user from interacting
 # with other applications.  We need to popdown the listbox when this happens.
 #
-# On OSX, the listbox gets a <Deactivate> event.  This doesn't happen 
+# On OSX, the listbox gets a <Deactivate> event.  This doesn't happen
 # on Windows or X11, but it does get a <FocusOut> event.  However on OSX
-# in Tk 8.5, the listbox gets spurious <FocusOut> events when the listbox 
+# in Tk 8.5, the listbox gets spurious <FocusOut> events when the listbox
 # is posted (see #1349811).
 #
 # The following seems to work:
@@ -80,19 +80,25 @@ switch -- [tk windowingsystem] {
 ### Option database settings.
 #
 
-if {[tk windowingsystem] eq "x11"} {
-    option add *TCombobox*Listbox.background white
-}
+option add *TCombobox*Listbox.font TkTextFont
+option add *TCombobox*Listbox.relief flat
+option add *TCombobox*Listbox.highlightThickness 0
 
-# The following ensures that the popdown listbox uses the same font 
-# as the combobox entry field (at least for the standard Ttk themes).
+## Platform-specific settings.
 #
-option add *TCombobox*Listbox.font TkTextFont
+switch -- [tk windowingsystem] {
+    x11 {
+	option add *TCombobox*Listbox.background white
+    }
+    aqua {
+	option add *TCombobox*Listbox.borderWidth 0
+    }
+}
 
 ### Binding procedures.
 #
 
-## combobox::Press $mode $x $y --
+## Press $mode $x $y --
 #	ButtonPress binding for comboboxes.
 #	Either post/unpost the listbox, or perform Entry widget binding,
 #	depending on widget state and location of button press.
@@ -104,8 +110,8 @@ proc ttk::combobox::Press {mode w x y} {
 	&& [string match *textarea [$w identify $x $y]]
     }]
 
+    focus $w
     if {$State(entryPress)} {
-	focus $w
 	switch -- $mode {
 	    s 	{ ttk::entry::Shift-Press $w $x 	; # Shift }
 	    2	{ ttk::entry::Select $w $x word 	; # Double click}
@@ -118,7 +124,7 @@ proc ttk::combobox::Press {mode w x y} {
     }
 }
 
-## combobox::Drag --
+## Drag --
 #	B1-Motion binding for comboboxes.
 #	If the initial ButtonPress event was handled by Entry binding,
 #	perform Entry widget drag binding; otherwise nothing.
@@ -134,13 +140,13 @@ proc ttk::combobox::Drag {w x}  {
 #	For editable comboboxes, set the selection and insert cursor.
 #
 proc ttk::combobox::TraverseIn {w} {
-    $w instate {!readonly !disabled} { 
+    $w instate {!readonly !disabled} {
 	$w selection range 0 end
 	$w icursor end
     }
 }
 
-## SelectEntry $cb $index -- 
+## SelectEntry $cb $index --
 #	Set the combobox selection in response to a user action.
 #
 proc ttk::combobox::SelectEntry {cb index} {
@@ -184,7 +190,7 @@ proc ttk::combobox::LBCancel {lb} {
 }
 
 ## LBTab --
-#	Tab key binding for combobox listbox:  
+#	Tab key binding for combobox listbox:
 #	Set the selection, and navigate to next/prev widget.
 #
 proc ttk::combobox::LBTab {lb dir} {
@@ -196,40 +202,36 @@ proc ttk::combobox::LBTab {lb dir} {
 
     if {$newFocus ne ""} {
 	LBSelected $lb
-	# The [grab release] call in [Unpost] queues events that later 
+	# The [grab release] call in [Unpost] queues events that later
 	# re-set the focus.  [update] to make sure these get processed first:
 	update
 	tk::TabToWindow $newFocus
     }
 }
 
-## PopdownShell --
-#	Returns the popdown shell widget associated with a combobox,
+namespace eval ::ttk::combobox {
+    # @@@ Until we have a proper native scrollbar on Aqua, use
+    # @@@ the regular Tk one.  Use ttk::scrollbar on other platforms.
+    if {[tk windowingsystem] ne "aqua"} {
+	namespace import -force ::ttk::scrollbar
+    }
+}
+
+## PopdownWindow --
+#	Returns the popdown widget associated with a combobox,
 #	creating it if necessary.
 #
-proc ttk::combobox::PopdownShell {cb} {
+proc ttk::combobox::PopdownWindow {cb} {
     if {![winfo exists $cb.popdown]} {
-	set popdown [toplevel $cb.popdown -relief solid -bd 1]
-	wm withdraw $popdown
-	wm overrideredirect $popdown 1
-	wm transient $popdown [winfo toplevel $cb]
-
-	# XXX Until we have a proper native scrollbar on Aqua, use
-	# XXX the regular Tk one
-	if {[tk windowingsystem] eq "aqua"} {
-	    scrollbar $popdown.sb -orient vertical \
-		-command [list $popdown.l yview]
-	} else {
-	    ttk::scrollbar $popdown.sb -orient vertical \
-		-command [list $popdown.l yview]
-	}
+	set popdown [PopdownToplevel $cb.popdown]
+
+	scrollbar $popdown.sb \
+	    -orient vertical -command [list $popdown.l yview]
 	listbox $popdown.l \
 	    -listvariable ttk::combobox::Values($cb) \
 	    -yscrollcommand [list $popdown.sb set] \
 	    -exportselection false \
 	    -selectmode browse \
-	    -borderwidth 2 -relief flat \
-	    -highlightthickness 0 \
 	    -activestyle none \
 	    ;
 
@@ -243,7 +245,30 @@ proc ttk::combobox::PopdownShell {cb} {
     return $cb.popdown
 }
 
-## combobox::Post $cb --
+## PopdownToplevel -- Create toplevel window for the combobox popdown
+#
+proc ttk::combobox::PopdownToplevel {w} {
+    toplevel $w -class Popdown
+    wm withdraw $w
+    wm overrideredirect $w true
+    wm transient $w [winfo toplevel [winfo parent $w]]
+    switch -- [tk windowingsystem] {
+	default -
+	x11 {
+	    $w configure -relief solid -borderwidth 1
+	}
+	win32 {
+	    $w configure -relief solid -borderwidth 1
+	}
+	aqua {
+	    $w configure -relief solid -borderwidth 0
+	    # @@@ tk::unsupported::MacWindowStyle style $w help none
+	}
+    }
+    return $w
+}
+
+## Post $cb --
 #	Pop down the associated listbox.
 #
 proc ttk::combobox::Post {cb} {
@@ -262,7 +287,7 @@ proc ttk::combobox::Post {cb} {
     #
     $cb state pressed
 
-    set popdown [PopdownShell $cb]
+    set popdown [PopdownWindow $cb]
     set values [$cb cget -values]
     set current [$cb current]
     if {$current < 0} {
@@ -320,7 +345,7 @@ proc ttk::combobox::Post {cb} {
     focus $popdown.l
 }
 
-## combobox::Unpost $cb --
+## Unpost $cb --
 #	Unpost the listbox, restore focus to combobox widget.
 #
 proc ttk::combobox::Unpost {cb} {
@@ -332,7 +357,7 @@ proc ttk::combobox::Unpost {cb} {
     focus $cb
 }
 
-## combobox::TogglePost $cb --
+## TogglePost $cb --
 #	Post the listbox if unposted, unpost otherwise.
 #
 proc ttk::combobox::TogglePost {cb} {