summaryrefslogtreecommitdiffstats
path: root/library/ttk
diff options
context:
space:
mode:
authorjenglish <jenglish@flightlab.com>2007-09-17 14:56:52 (GMT)
committerjenglish <jenglish@flightlab.com>2007-09-17 14:56:52 (GMT)
commit9779d2ce0b98c4742ff649b1e6bc5c5037f52870 (patch)
tree5833060563ee272d354db46cf3727b9eb0cba012 /library/ttk
parentadb124ce16ff5f8b8aea8517200354b1c65b7938 (diff)
downloadtk-9779d2ce0b98c4742ff649b1e6bc5c5037f52870.zip
tk-9779d2ce0b98c4742ff649b1e6bc5c5037f52870.tar.gz
tk-9779d2ce0b98c4742ff649b1e6bc5c5037f52870.tar.bz2
Try to improve combobox appearance on OSX + Tk 8.5 [#1780286].
Diffstat (limited to 'library/ttk')
-rw-r--r--library/ttk/combobox.tcl105
1 files changed, 65 insertions, 40 deletions
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} {