path: root/library/ttk/combobox.tcl

#
# 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: The native combobox uses a popup menu to display the
#       combobox choices.  So this implementation does that as well,
#       rather than construc a Tk listbox.  Since the window manager
#       takes care of scrolling and making sure that the menu can be
#       displayed even when the button is close to the bottom of the
#       screen, this actually simplifies the implementation.  The Post
#       and PopupWindow procs have separate implementations for Aqua
#       and other systems.  The configuration of the menu is handled
#       by a different proc than the one which configures the listbox
#       on other platforms -- ConfigureAquaMenu instead of
#       ConfigureListbox.
#

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 <Down> 			{ ttk::combobox::Post %W }
bind TCombobox <Escape> 		{ ttk::combobox::Unpost %W }

bind TCombobox <Button-1> 		{ ttk::combobox::Press "" %W %x %y }
bind TCombobox <Shift-Button-1>		{ ttk::combobox::Press "s" %W %x %y }
bind TCombobox <Double-Button-1> 	{ ttk::combobox::Press "2" %W %x %y }
bind TCombobox <Triple-Button-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 <Return>		{ ttk::combobox::LBSelected %W }
bind ComboboxListbox <Escape>		{ ttk::combobox::LBCancel %W }
bind ComboboxListbox <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 }
    }
    aqua {
	bind TCombobox <Destroy>		{ ttk::combobox::AquaCleanup %W }
    }
}

### Combobox popdown window bindings.
#
bind ComboboxPopdown	<Map>		{ ttk::combobox::MapPopdown %W }
bind ComboboxPopdown	<Unmap>		{ ttk::combobox::UnmapPopdown %W }
bind ComboboxPopdown	<Button> \
			{ ttk::combobox::Unpost [winfo parent %W] }

### Option database settings.
#

option add *TCombobox*Listbox.font TkTextFont widgetDefault
option add *TCombobox*Listbox.relief flat widgetDefault
option add *TCombobox*Listbox.highlightThickness 0 widgetDefault

## Platform-specific settings.
#
switch -- [tk windowingsystem] {
    x11 {
	option add *TCombobox*Listbox.background white widgetDefault
    }
}

### Binding procedures.
#

## Press $mode $x $y -- Button 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 Button 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} {
    variable State
    ttk::saveCursor $w State(userConfCursor) [ttk::cursor text]
    if {   [$w identify $x $y] eq "textarea"
        && [$w instate {!readonly !disabled}]
    } {
	ttk::setCursor $w text
    } else {
	ttk::setCursor $w $State(userConfCursor)
    }
}

## 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 {factor 1.0}} {
    $cb instate disabled { return }
    set max [llength [$cb cget -values]]
    set current [$cb current]
    if {$current < 0} {
	set index 0
    } else {
	set d [expr {$dir/$factor}]
	set index [expr {$current + int($d > 0 ? ceil($d) : floor($d))}]
	if {$index >= $max} {set index [expr {$max - 1}]}
	if {$index < 0} {set index 0}
    }
    if {$max != 0 && $index != $current} {
	SelectEntry $cb $index
    }
}

## 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 [LBMain $lb]
    LBSelect $lb
    Unpost $cb
    focus $cb
}

## LBCancel --
#	Unpost the listbox.
#
proc ttk::combobox::LBCancel {lb} {
    Unpost [LBMain $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 [LBMain $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
}

## PopdownWindow --
#	Returns the popdown widget associated with a combobox,
#	creating it if necessary.
#

if {[tk windowingsystem] ne "aqua"} {
    proc ttk::combobox::PopdownWindow {cb} {
	if {![winfo exists $cb.popdown]} {
	    set poplevel [PopdownToplevel $cb.popdown]
	    set popdown [ttk::frame $poplevel.f -style ComboboxPopdownFrame]

	    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 \
		-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
    }
} else {
    proc ttk::combobox::PopdownWindow {cb} {
	if {![winfo exists $cb.popdown]} {
	    set popdown [menu $cb.popdown -tearoff 0]
	    # The menu should be (at least) the same length as the button.
	    # Since there is no direct way to control the width of a menu
	    # in Tk, we fake it by using an invisible image in a disabled
	    # menu item, adjusting the image size to make the menu be the
	    # correct width.
	    image create nsimage $cb.spacer -source NSStatusNone -as name \
		-alpha 0
	}
	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
	}
    }
    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
}

proc ttk::combobox::ConfigureAquaMenu {cb width} {
    set popdown [PopdownWindow $cb]
    set values [$cb cget -values]
    set current [$cb current]
    if {$current < 0} {
	set current 0 		;# no current entry, highlight first one
    }
    $cb.popdown delete 0 end
    set i 0
    foreach item $values {
	$cb.popdown add command -label $item \
	    -command "ttk::combobox::SelectEntry $cb $i"
	incr i
	}
    $cb.spacer configure -width [expr {$width - 55}] -height 1
    $cb.popdown add command -label {} -image $cb.spacer -state disabled
}

## 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 style [$cb cget -style]
    if { $style eq {} } {
      set style TCombobox
    }
    set postoffset [ttk::style lookup $style -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}
}

proc ttk::combobox::AquaPlacePopdown {cb popdown} {
    set x [winfo rootx $cb]
    set y [winfo rooty $cb]
    set w [winfo width $cb]
    set h [winfo height $cb]
    set style [$cb cget -style]
    set postoffset [ttk::style lookup $style -postoffset {} {0 0 0 0}]
    foreach var {x y w h} delta $postoffset {
    	incr $var $delta
    }
    return [list $x $y $w $h]
}

## Post $cb --
#	Pop down the associated listbox or menu.
#
if {[tk windowingsystem] ne "aqua"} {
    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
    }
} else {
    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]

	# Configure the menu

	foreach {x y width height} [AquaPlacePopdown $cb $popdown] { break }
	ConfigureAquaMenu $cb $width

	# Post the menu.  It will have a disclosure indicator if it is too
	# close to the bottom of the screen, and it may be posted above the
	# button if necessary to be visible.

	$popdown post [expr {$x + 6}] [expr {$y + $height + 2}]
    }
}

## 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]
}

## LBMain $lb --
#	Return the combobox main widget that owns the listbox.
#
proc ttk::combobox::LBMain {lb} {
    winfo parent [winfo parent [winfo parent $lb]]
}

## LBSelect $lb --
#	Transfer listbox selection to combobox value.
#
proc ttk::combobox::LBSelect {lb} {
    set cb [LBMain $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([LBMain $lb])
}

proc ttk::combobox::AquaCleanup {cb} {
    catch {image delete $cb.spacer}
}

#*EOF*