summaryrefslogtreecommitdiffstats
path: root/library/ttk/combobox.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'library/ttk/combobox.tcl')
-rw-r--r--library/ttk/combobox.tcl360
1 files changed, 360 insertions, 0 deletions
diff --git a/library/ttk/combobox.tcl b/library/ttk/combobox.tcl
new file mode 100644
index 0000000..7df9f61
--- /dev/null
+++ b/library/ttk/combobox.tcl
@@ -0,0 +1,360 @@
+#
+# $Id: combobox.tcl,v 1.1 2006/10/31 01:42:27 hobbs Exp $
+#
+# Ttk widget set: combobox bindings.
+#
+# Each combobox $cb has a child $cb.popdown, which contains
+# a listbox $cb.popdown.l and a scrollbar. The listbox -listvariable
+# is set to a namespace variable, which is used to synchronize the
+# combobox values with the listbox values.
+#
+
+namespace eval ttk::combobox {
+ variable Values ;# Values($cb) is -listvariable of listbox widget
+
+ variable State
+ set State(entryPress) 0
+}
+
+### Combobox bindings.
+#
+# Duplicate the Entry bindings, override if needed:
+#
+
+ttk::CopyBindings TEntry TCombobox
+
+bind TCombobox <KeyPress-Down> { ttk::combobox::Post %W }
+bind TCombobox <KeyPress-Escape> { ttk::combobox::Unpost %W }
+
+bind TCombobox <ButtonPress-1> { ttk::combobox::Press "" %W %x %y }
+bind TCombobox <Shift-ButtonPress-1> { ttk::combobox::Press "s" %W %x %y }
+bind TCombobox <Double-ButtonPress-1> { ttk::combobox::Press "2" %W %x %y }
+bind TCombobox <Triple-ButtonPress-1> { ttk::combobox::Press "3" %W %x %y }
+bind TCombobox <B1-Motion> { ttk::combobox::Drag %W %x }
+
+bind TCombobox <MouseWheel> { ttk::combobox::Scroll %W [expr {%D/-120}] }
+if {[tk windowingsystem] eq "x11"} {
+ bind TCombobox <ButtonPress-4> { ttk::combobox::Scroll %W -1 }
+ bind TCombobox <ButtonPress-5> { ttk::combobox::Scroll %W 1 }
+}
+
+bind TCombobox <<TraverseIn>> { ttk::combobox::TraverseIn %W }
+
+### Combobox listbox bindings.
+#
+bind ComboboxListbox <ButtonPress-1> { focus %W ; continue }
+bind ComboboxListbox <ButtonRelease-1> { ttk::combobox::LBSelected %W }
+bind ComboboxListbox <KeyPress-Return> { ttk::combobox::LBSelected %W }
+bind ComboboxListbox <KeyPress-Escape> { ttk::combobox::LBCancel %W }
+bind ComboboxListbox <KeyPress-Tab> { ttk::combobox::LBTab %W next }
+bind ComboboxListbox <<PrevWindow>> { ttk::combobox::LBTab %W prev }
+bind ComboboxListbox <Destroy> { ttk::combobox::LBCleanup %W }
+# Default behavior is to follow selection on mouseover
+bind ComboboxListbox <Motion> {
+ %W selection clear 0 end
+ %W activate @%x,%y
+ %W selection set @%x,%y
+}
+
+# The combobox has a global grab active when the listbox is posted,
+# 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 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
+# is posted (see #1349811).
+#
+# The following seems to work:
+#
+
+switch -- [tk windowingsystem] {
+ win32 {
+ bind ComboboxListbox <FocusOut> { ttk::combobox::LBCancel %W }
+ }
+ aqua {
+ bind ComboboxListbox <Deactivate> { ttk::combobox::LBCancel %W }
+ }
+}
+
+### Option database settings.
+#
+
+if {[tk windowingsystem] eq "x11"} {
+ option add *TCombobox*Listbox.background white
+}
+
+# The following ensures that the popdown listbox uses the same font
+# as the combobox entry field (at least for the standard Ttk themes).
+#
+option add *TCombobox*Listbox.font TkTextFont
+
+### Binding procedures.
+#
+
+## combobox::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.
+#
+proc ttk::combobox::Press {mode w x y} {
+ variable State
+ set State(entryPress) [expr {
+ [$w instate {!readonly !disabled}]
+ && [string match *textarea [$w identify $x $y]]
+ }]
+
+ if {$State(entryPress)} {
+ focus $w
+ switch -- $mode {
+ s { ttk::entry::Shift-Press $w $x ; # Shift }
+ 2 { ttk::entry::Select $w $x word ; # Double click}
+ 3 { ttk::entry::Select $w $x line ; # Triple click }
+ "" -
+ default { ttk::entry::Press $w $x }
+ }
+ } else {
+ TogglePost $w
+ }
+}
+
+## combobox::Drag --
+# B1-Motion binding for comboboxes.
+# If the initial ButtonPress event was handled by Entry binding,
+# perform Entry widget drag binding; otherwise nothing.
+#
+proc ttk::combobox::Drag {w x} {
+ variable State
+ if {$State(entryPress)} {
+ ttk::entry::Drag $w $x
+ }
+}
+
+## TraverseIn -- receive focus due to keyboard navigation
+# For editable comboboxes, set the selection and insert cursor.
+#
+proc ttk::combobox::TraverseIn {w} {
+ $w instate {!readonly !disabled} {
+ $w selection range 0 end
+ $w icursor end
+ }
+}
+
+## SelectEntry $cb $index --
+# Set the combobox selection in response to a user action.
+#
+proc ttk::combobox::SelectEntry {cb index} {
+ $cb current $index
+ $cb selection range 0 end
+ $cb icursor end
+ event generate $cb <<ComboboxSelected>>
+}
+
+## Scroll -- Mousewheel binding
+#
+proc ttk::combobox::Scroll {cb dir} {
+ $cb instate disabled { return }
+ set max [llength [$cb cget -values]]
+ set current [$cb current]
+ incr current $dir
+ if {$max != 0 && $current == $current % $max} {
+ SelectEntry $cb $current
+ }
+}
+
+## LBSelected $lb -- Activation binding for listbox
+# Set the combobox value to the currently-selected listbox value
+# and unpost the listbox.
+#
+proc ttk::combobox::LBSelected {lb} {
+ set cb [LBMaster $lb]
+ set selection [$lb curselection]
+ Unpost $cb
+ focus $cb
+ if {[llength $selection] == 1} {
+ SelectEntry $cb [lindex $selection 0]
+ }
+}
+
+## LBCancel --
+# Unpost the listbox.
+#
+proc ttk::combobox::LBCancel {lb} {
+ Unpost [LBMaster $lb]
+}
+
+## LBTab --
+# Tab key binding for combobox listbox:
+# Set the selection, and navigate to next/prev widget.
+#
+proc ttk::combobox::LBTab {lb dir} {
+ set cb [LBMaster $lb]
+ switch -- $dir {
+ next { set newFocus [tk_focusNext $cb] }
+ prev { set newFocus [tk_focusPrev $cb] }
+ }
+
+ if {$newFocus ne ""} {
+ LBSelected $lb
+ # 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,
+# creating it if necessary.
+#
+proc ttk::combobox::PopdownShell {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]
+ }
+ 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 \
+ ;
+
+ bindtags $popdown.l \
+ [list $popdown.l ComboboxListbox Listbox $popdown all]
+
+ grid $popdown.l $popdown.sb -sticky news
+ grid columnconfigure $popdown 0 -weight 1
+ grid rowconfigure $popdown 0 -weight 1
+ }
+ return $cb.popdown
+}
+
+## combobox::Post $cb --
+# Pop down the associated listbox.
+#
+proc ttk::combobox::Post {cb} {
+ variable State
+ variable Values
+
+ # Don't do anything if disabled:
+ #
+ $cb instate disabled { return }
+
+ # Run -postcommand callback:
+ #
+ uplevel #0 [$cb cget -postcommand]
+
+ # Combobox is in 'pressed' state while listbox posted:
+ #
+ $cb state pressed
+
+ set popdown [PopdownShell $cb]
+ set values [$cb cget -values]
+ set current [$cb current]
+ if {$current < 0} {
+ set current 0 ;# no current entry, highlight first one
+ }
+ set Values($cb) $values
+ $popdown.l selection clear 0 end
+ $popdown.l selection set $current
+ $popdown.l activate $current
+ $popdown.l see $current
+ # Should allow user to control listbox height
+ set height [llength $values]
+ if {$height > 10} {
+ set height 10
+ }
+ $popdown.l configure -height $height
+ update idletasks
+
+ # Position listbox (@@@ factor with menubutton::PostPosition
+ #
+ set x [winfo rootx $cb]
+ set y [winfo rooty $cb]
+ set w [winfo width $cb]
+ set h [winfo height $cb]
+ if {[tk windowingsystem] eq "aqua"} {
+ # Adjust for platform-specific bordering to ensure the box is
+ # directly under actual 'entry square'
+ set xoff 3
+ set yoff 2
+ incr x $xoff
+ set w [expr {$w - $xoff*2}]
+ } else {
+ set yoff 0
+ }
+
+ set H [winfo reqheight $popdown]
+ if {$y + $h + $H > [winfo screenheight $popdown]} {
+ set Y [expr {$y - $H - $yoff}]
+ } else {
+ set Y [expr {$y + $h - $yoff}]
+ }
+ wm geometry $popdown ${w}x${H}+${x}+${Y}
+
+ # Post the listbox:
+ #
+ wm deiconify $popdown
+ raise $popdown
+ # @@@ Workaround for TrackElementState bug:
+ event generate $cb <ButtonRelease-1>
+ # /@@@
+ ttk::globalGrab $cb
+ focus $popdown.l
+}
+
+## combobox::Unpost $cb --
+# Unpost the listbox, restore focus to combobox widget.
+#
+proc ttk::combobox::Unpost {cb} {
+ $cb state !pressed
+ ttk::releaseGrab $cb
+ if {[winfo exists $cb.popdown]} {
+ wm withdraw $cb.popdown
+ }
+ focus $cb
+}
+
+## combobox::TogglePost $cb --
+# Post the listbox if unposted, unpost otherwise.
+#
+proc ttk::combobox::TogglePost {cb} {
+ if {[$cb instate pressed]} { Unpost $cb } { Post $cb }
+}
+
+## LBMaster $lb --
+# Return the combobox main widget that owns the listbox.
+#
+proc ttk::combobox::LBMaster {lb} {
+ winfo parent [winfo parent $lb]
+}
+
+## LBCleanup $lb --
+# <Destroy> binding for combobox listboxes.
+# Cleans up by unsetting the linked textvariable.
+#
+# Note: we can't just use { unset [%W cget -listvariable] }
+# because the widget command is already gone when this binding fires).
+# [winfo parent] still works, fortunately.
+#
+
+proc ttk::combobox::LBCleanup {lb} {
+ variable Values
+ unset Values([LBMaster $lb])
+}
+
+#*EOF*