diff options
Diffstat (limited to 'library/ttk/combobox.tcl')
| -rw-r--r-- | library/ttk/combobox.tcl | 456 |
1 files changed, 456 insertions, 0 deletions
diff --git a/library/ttk/combobox.tcl b/library/ttk/combobox.tcl new file mode 100644 index 0000000..03821a2 --- /dev/null +++ b/library/ttk/combobox.tcl @@ -0,0 +1,456 @@ +# +# Combobox bindings. +# +# <<NOTE-WM-TRANSIENT>>: +# +# Need to set [wm transient] just before mapping the popdown +# instead of when it's created, in case a containing frame +# has been reparented [#1818441]. +# +# On Windows: setting [wm transient] prevents the parent +# toplevel from becoming inactive when the popdown is posted +# (Tk 8.4.8+) +# +# On X11: WM_TRANSIENT_FOR on override-redirect windows +# may be used by compositing managers and by EWMH-aware +# window managers (even though the older ICCCM spec says +# it's meaningless). +# +# On OSX: [wm transient] does utterly the wrong thing. +# Instead, we use [MacWindowStyle "help" "noActivates hideOnSuspend"]. +# The "noActivates" attribute prevents the parent toplevel +# from deactivating when the popdown is posted, and is also +# necessary for "help" windows to receive mouse events. +# "hideOnSuspend" makes the popdown disappear (resp. reappear) +# when the parent toplevel is deactivated (resp. reactivated). +# (see [#1814778]). Also set [wm resizable 0 0], to prevent +# TkAqua from shrinking the scrollbar to make room for a grow box +# that isn't there. +# +# In order to work around other platform quirks in TkAqua, +# [grab] and [focus] are set in <Map> bindings instead of +# immediately after deiconifying the window. +# + +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 <Motion> { ttk::combobox::Motion %W %x %y } + +ttk::bindMouseWheel TCombobox [list ttk::combobox::Scroll %W] + +bind TCombobox <<TraverseIn>> { ttk::combobox::TraverseIn %W } + +### Combobox listbox bindings. +# +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 } +bind ComboboxListbox <Motion> { ttk::combobox::LBHover %W %x %y } +bind ComboboxListbox <Map> { focus -force %W } + +switch -- [tk windowingsystem] { + win32 { + # Dismiss listbox when user switches to a different application. + # NB: *only* do this on Windows (see #1814778) + bind ComboboxListbox <FocusOut> { ttk::combobox::LBCancel %W } + } +} + +### Combobox popdown window bindings. +# +bind ComboboxPopdown <Map> { ttk::combobox::MapPopdown %W } +bind ComboboxPopdown <Unmap> { ttk::combobox::UnmapPopdown %W } +bind ComboboxPopdown <ButtonPress> \ + { ttk::combobox::Unpost [winfo parent %W] } + +### Option database settings. +# + +option add *TCombobox*Listbox.font TkTextFont +option add *TCombobox*Listbox.relief flat +option add *TCombobox*Listbox.highlightThickness 0 + +## Platform-specific settings. +# +switch -- [tk windowingsystem] { + x11 { + option add *TCombobox*Listbox.background white + } + aqua { + option add *TCombobox*Listbox.borderWidth 0 + } +} + +### Binding procedures. +# + +## 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 + + $w instate disabled { return } + + set State(entryPress) [expr { + [$w instate !readonly] + && [string match *textarea [$w identify element $x $y]] + }] + + focus $w + if {$State(entryPress)} { + 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 { + Post $w + } +} + +## 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 + } +} + +## Motion -- +# Set cursor. +# +proc ttk::combobox::Motion {w x y} { + if { [$w identify $x $y] eq "textarea" + && [$w instate {!readonly !disabled}] + } { + ttk::setCursor $w text + } else { + ttk::setCursor $w "" + } +} + +## 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>> -when mark +} + +## 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] + LBSelect $lb + Unpost $cb + focus $cb +} + +## 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 ""} { + LBSelect $lb + Unpost $cb + # The [grab release] call in [Unpost] queues events that later + # re-set the focus (@@@ NOTE: this might not be true anymore). + # Set new focus later: + after 0 [list ttk::traverseTo $newFocus] + } +} + +## LBHover -- <Motion> binding for combobox listbox. +# Follow selection on mouseover. +# +proc ttk::combobox::LBHover {w x y} { + $w selection clear 0 end + $w activate @$x,$y + $w selection set @$x,$y +} + +## MapPopdown -- <Map> binding for ComboboxPopdown +# +proc ttk::combobox::MapPopdown {w} { + [winfo parent $w] state pressed + ttk::globalGrab $w +} + +## UnmapPopdown -- <Unmap> binding for ComboboxPopdown +# +proc ttk::combobox::UnmapPopdown {w} { + [winfo parent $w] state !pressed + ttk::releaseGrab $w +} + +### +# + +namespace eval ::ttk::combobox { + # @@@ Until we have a proper native scrollbar on Aqua, use + # @@@ the regular Tk one. Use ttk::scrollbar on other platforms. + variable scrollbar ttk::scrollbar + if {[tk windowingsystem] eq "aqua"} { + set scrollbar ::scrollbar + } +} + +## PopdownWindow -- +# Returns the popdown widget associated with a combobox, +# creating it if necessary. +# +proc ttk::combobox::PopdownWindow {cb} { + variable scrollbar + + if {![winfo exists $cb.popdown]} { + set poplevel [PopdownToplevel $cb.popdown] + set popdown [ttk::frame $poplevel.f -style ComboboxPopdownFrame] + + $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 \ + -activestyle none \ + ; + + bindtags $popdown.l \ + [list $popdown.l ComboboxListbox Listbox $popdown all] + + grid $popdown.l -row 0 -column 0 -padx {1 0} -pady 1 -sticky nsew + grid $popdown.sb -row 0 -column 1 -padx {0 1} -pady 1 -sticky ns + grid columnconfigure $popdown 0 -weight 1 + grid rowconfigure $popdown 0 -weight 1 + + grid $popdown -sticky news -padx 0 -pady 0 + grid rowconfigure $poplevel 0 -weight 1 + grid columnconfigure $poplevel 0 -weight 1 + } + return $cb.popdown +} + +## PopdownToplevel -- Create toplevel window for the combobox popdown +# +# See also <<NOTE-WM-TRANSIENT>> +# +proc ttk::combobox::PopdownToplevel {w} { + toplevel $w -class ComboboxPopdown + wm withdraw $w + switch -- [tk windowingsystem] { + default - + x11 { + $w configure -relief flat -borderwidth 0 + wm attributes $w -type combo + wm overrideredirect $w true + } + win32 { + $w configure -relief flat -borderwidth 0 + wm overrideredirect $w true + wm attributes $w -topmost 1 + } + aqua { + $w configure -relief solid -borderwidth 0 + tk::unsupported::MacWindowStyle style $w \ + help {noActivates hideOnSuspend} + wm resizable $w 0 0 + } + } + return $w +} + +## ConfigureListbox -- +# Set listbox values, selection, height, and scrollbar visibility +# from current combobox values. +# +proc ttk::combobox::ConfigureListbox {cb} { + variable Values + + set popdown [PopdownWindow $cb].f + 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 + set height [llength $values] + if {$height > [$cb cget -height]} { + set height [$cb cget -height] + grid $popdown.sb + grid configure $popdown.l -padx {1 0} + } else { + grid remove $popdown.sb + grid configure $popdown.l -padx 1 + } + $popdown.l configure -height $height +} + +## PlacePopdown -- +# Set popdown window geometry. +# +# @@@TODO: factor with menubutton::PostPosition +# +proc ttk::combobox::PlacePopdown {cb popdown} { + set x [winfo rootx $cb] + set y [winfo rooty $cb] + set w [winfo width $cb] + set h [winfo height $cb] + set postoffset [ttk::style lookup TCombobox -postoffset {} {0 0 0 0}] + foreach var {x y w h} delta $postoffset { + incr $var $delta + } + + set H [winfo reqheight $popdown] + if {$y + $h + $H > [winfo screenheight $popdown]} { + set Y [expr {$y - $H}] + } else { + set Y [expr {$y + $h}] + } + wm geometry $popdown ${w}x${H}+${x}+${Y} +} + +## Post $cb -- +# Pop down the associated listbox. +# +proc ttk::combobox::Post {cb} { + # Don't do anything if disabled: + # + $cb instate disabled { return } + + # ASSERT: ![$cb instate pressed] + + # Run -postcommand callback: + # + uplevel #0 [$cb cget -postcommand] + + set popdown [PopdownWindow $cb] + ConfigureListbox $cb + update idletasks ;# needed for geometry propagation. + PlacePopdown $cb $popdown + # See <<NOTE-WM-TRANSIENT>> + switch -- [tk windowingsystem] { + x11 - win32 { wm transient $popdown [winfo toplevel $cb] } + } + + # Post the listbox: + # + wm attribute $popdown -topmost 1 + wm deiconify $popdown + raise $popdown +} + +## Unpost $cb -- +# Unpost the listbox. +# +proc ttk::combobox::Unpost {cb} { + if {[winfo exists $cb.popdown]} { + wm withdraw $cb.popdown + } + grab release $cb.popdown ;# in case of stuck or unexpected grab [#1239190] +} + +## LBMaster $lb -- +# Return the combobox main widget that owns the listbox. +# +proc ttk::combobox::LBMaster {lb} { + winfo parent [winfo parent [winfo parent $lb]] +} + +## LBSelect $lb -- +# Transfer listbox selection to combobox value. +# +proc ttk::combobox::LBSelect {lb} { + set cb [LBMaster $lb] + set selection [$lb curselection] + if {[llength $selection] == 1} { + SelectEntry $cb [lindex $selection 0] + } +} + +## 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* |