Attachment "combobox.patch" to
ticket [6c6704e40f]
added by
oehhar
2013-10-15 18:49:04.
--- U:/elmicron/tech/tcl/bwidget/checkout_bwidget/combobox.tcl Mon Oct 14 17:16:57 2013
+++ U:/elmicron/tech/tcl/bwidget/checkout_bwidget/combobox_kech2.tcl Tue Oct 15 13:30:12 2013
@@ -1,944 +1,973 @@
-# ----------------------------------------------------------------------------
-# combobox.tcl
-# This file is part of Unifix BWidget Toolkit
-# $Id: combobox.tcl,v 1.42.2.3 2012/04/02 09:53:41 oehhar Exp $
-# ----------------------------------------------------------------------------
-# Index of commands:
-# - ComboBox::create
-# - ComboBox::configure
-# - ComboBox::cget
-# - ComboBox::setvalue
-# - ComboBox::getvalue
-# - ComboBox::clearvalue
-# - ComboBox::getentry
-# - ComboBox::_create_popup
-# - ComboBox::_mapliste
-# - ComboBox::_unmapliste
-# - ComboBox::_select
-# - ComboBox::_modify_value
-# ----------------------------------------------------------------------------
-
-# ComboBox uses the 8.3 -listvariable listbox option
-package require Tk 8.3
-
-namespace eval ComboBox {
- Widget::define ComboBox combobox ArrowButton Entry ListBox
-
- Widget::tkinclude ComboBox frame :cmd \
- include {-relief -borderwidth -bd -background} \
- initialize {-relief sunken -borderwidth 2}
-
- if {[Widget::theme]} {
- Widget::bwinclude ComboBox Entry .e
- } else {
- Widget::bwinclude ComboBox Entry .e \
- remove {-relief -bd -borderwidth -bg} \
- rename {-background -entrybg}
- }
-
- Widget::declare ComboBox {
- {-height TkResource 0 0 listbox}
- {-values String "" 0}
- {-images String "" 0}
- {-indents String "" 0}
- {-modifycmd String "" 0}
- {-postcommand String "" 0}
- {-expand Enum none 0 {none tab}}
- {-autocomplete Boolean 0 0}
- {-autopost Boolean 0 0}
- {-bwlistbox Boolean 0 0}
- {-listboxwidth Int 0 0}
- {-hottrack Boolean 0 0}
- }
-
- if {[Widget::theme]} {
- Widget::addmap ComboBox ArrowButton .a {
- -background {} -state {}
- }
- } else {
- Widget::addmap ComboBox ArrowButton .a {
- -background {} -foreground {} -disabledforeground {} -state {}
- }
- }
-
- Widget::syncoptions ComboBox Entry .e {-text {}}
-
- ::bind BwComboBox <FocusIn> [list after idle {BWidget::refocus %W %W.e}]
- ::bind BwComboBox <Destroy> [list ComboBox::_destroy %W]
-
- ::bind ListBoxHotTrack <Motion> {
- %W selection clear 0 end
- %W activate @%x,%y
- %W selection set @%x,%y
- }
-
- variable _index
-}
-
-
-# ComboBox::create --
-#
-# Create a combobox widget with the given options.
-#
-# Arguments:
-# path name of the new widget.
-# args optional arguments to the widget.
-#
-# Results:
-# path name of the new widget.
-
-proc ComboBox::create { path args } {
- array set maps [list ComboBox {} :cmd {} .e {} .a {}]
- array set maps [Widget::parseArgs ComboBox $args]
-
- eval [list frame $path] $maps(:cmd) \
- [list -highlightthickness 0 -takefocus 0 -class ComboBox]
- Widget::initFromODB ComboBox $path $maps(ComboBox)
-
- bindtags $path [list $path BwComboBox [winfo toplevel $path] all]
-
- if {[Widget::theme]} {
- set entry [eval [list Entry::create $path.e] $maps(.e) \
- [list -takefocus 1]]
- } else {
- set entry [eval [list Entry::create $path.e] $maps(.e) \
- [list -relief flat -borderwidth 0 -takefocus 1]]
- }
-
- ::bind $path.e <FocusOut> [list $path _focus_out]
- ::bind $path <<TraverseIn>> [list $path _traverse_in]
-
- if {[Widget::cget $path -autocomplete]} {
- ::bind $path.e <KeyRelease> [list $path _auto_complete %K]
- }
-
- if {[Widget::cget $path -autopost]} {
- ::bind $path.e <KeyRelease> +[list $path _auto_post %K]
- } else {
- ::bind $entry <Key-Up> [list ComboBox::_unmapliste $path]
- ::bind $entry <Key-Down> [list ComboBox::_mapliste $path]
- }
-
- if {[string equal [tk windowingsystem] "x11"]} {
- set ipadx 0
- set width 11
- } else {
- set ipadx 2
- set width 15
- }
- set height [winfo reqheight $entry]
- set arrow [eval [list ArrowButton::create $path.a] $maps(.a) \
- [list -width $width -height $height \
- -highlightthickness 0 -borderwidth 1 -takefocus 0 \
- -dir bottom -type button -ipadx $ipadx \
- -command [list ComboBox::_mapliste $path] \
- ]]
-
- pack $arrow -side right -fill y
- pack $entry -side left -fill both -expand yes
-
- set editable [Widget::cget $path -editable]
- Entry::configure $path.e -editable $editable
- if {$editable} {
- ::bind $entry <ButtonPress-1> [list ComboBox::_unmapliste $path]
- } else {
- ::bind $entry <ButtonPress-1> [list ArrowButton::invoke $path.a]
- if { ![string equal [Widget::cget $path -state] "disabled"] } {
- Entry::configure $path.e -takefocus 1
- }
- }
-
- ::bind $path <ButtonPress-1> [list ComboBox::_unmapliste $path]
- ::bind $entry <Control-Up> [list ComboBox::_modify_value $path previous]
- ::bind $entry <Control-Down> [list ComboBox::_modify_value $path next]
- ::bind $entry <Control-Prior> [list ComboBox::_modify_value $path first]
- ::bind $entry <Control-Next> [list ComboBox::_modify_value $path last]
-
- if {$editable} {
- set expand [Widget::cget $path -expand]
- if {[string equal "tab" $expand]} {
- # Expand entry value on Tab (from -values)
- ::bind $entry <Tab> "[list ComboBox::_expand $path]; break"
- } elseif {[string equal "auto" $expand]} {
- # Expand entry value anytime (from -values)
- #::bind $entry <Key> "[list ComboBox::_expand $path]; break"
- }
- }
-
- ## If we have images, we have to use a BWidget ListBox.
- set bw [Widget::cget $path -bwlistbox]
- if {[llength [Widget::cget $path -images]]} {
- Widget::configure $path [list -bwlistbox 1]
- } else {
- Widget::configure $path [list -bwlistbox $bw]
- }
-
- set ComboBox::_index($path) -1
-
- return [Widget::create ComboBox $path]
-}
-
-
-# ComboBox::configure --
-#
-# Configure subcommand for ComboBox widgets. Works like regular
-# widget configure command.
-#
-# Arguments:
-# path Name of the ComboBox widget.
-# args Additional optional arguments:
-# ?-option?
-# ?-option value ...?
-#
-# Results:
-# Depends on arguments. If no arguments are given, returns a complete
-# list of configuration information. If one argument is given, returns
-# the configuration information for that option. If more than one
-# argument is given, returns nothing.
-
-proc ComboBox::configure { path args } {
- set res [Widget::configure $path $args]
- set entry $path.e
-
-
- set list [list -images -values -bwlistbox -hottrack -autocomplete -autopost]
- foreach {ci cv cb ch cac cap} [eval [linsert $list 0 Widget::hasChangedX $path]] { break }
-
- if { $ci } {
- set images [Widget::cget $path -images]
- if {[llength $images]} {
- Widget::configure $path [list -bwlistbox 1]
- } else {
- Widget::configure $path [list -bwlistbox 0]
- }
- }
-
- ## If autocomplete toggled, turn bindings on/off
- if { $cac } {
- if {[Widget::cget $path -autocomplete]} {
- ::bind $entry <KeyRelease> +[list $path _auto_complete %K]
- } else {
- set bindings [split [::bind $entry <KeyRelease>] \n]
- if {[set idx [lsearch $bindings [list $path _auto_complete %K]]] != -1} {
- ::bind $entry <KeyRelease> [join [lreplace $bindings $idx $idx] \n]
- }
- }
- }
-
- ## If autopost toggled, turn bindings on/off
- if { $cap } {
- if {[Widget::cget $path -autopost]} {
- ::bind $entry <KeyRelease> +[list $path _auto_post %K]
- set bindings [split [::bind $entry <Key-Up>] \n]
- if {[set idx [lsearch $bindings [list ComboBox::_unmapliste $path]]] != -1} {
- ::bind $entry <Key-Up> [join [lreplace $bindings $idx $idx] \n]
- }
- set bindings [split [::bind $entry <Key-Down>] \n]
- if {[set idx [lsearch $bindings [list ComboBox::_mapliste $path]]] != -1} {
- ::bind $entry <Key-Down> [join [lreplace $bindings $idx $idx] \n]
- }
- } else {
- set bindings [split [::bind $entry <KeyRelease>] \n]
- if {[set idx [lsearch $bindings [list $path _auto_post %K]]] != -1} {
- ::bind $entry <KeyRelease> [join [lreplace $bindings $idx $idx] \n]
- }
- ::bind $entry <Key-Up> +[list ComboBox::_unmapliste $path]
- ::bind $entry <Key-Down> +[list ComboBox::_mapliste $path]
- }
- }
-
- set bw [Widget::cget $path -bwlistbox]
-
- ## If the images, bwlistbox, hottrack or values have changed,
- ## destroy the shell so that it will re-create itself the next
- ## time around.
- if { $ci || $cb || $ch || ($bw && $cv) } {
- destroy $path.shell
- }
-
- set chgedit [Widget::hasChangedX $path -editable]
- if {$chgedit} {
- if {[Widget::cget $path -editable]} {
- ::bind $entry <ButtonPress-1> [list ComboBox::_unmapliste $path]
- Entry::configure $entry -editable true
- } else {
- ::bind $entry <ButtonPress-1> [list ArrowButton::invoke $path.a]
- Entry::configure $entry -editable false
-
- # Make sure that non-editable comboboxes can still be tabbed to.
-
- if { ![string equal [Widget::cget $path -state] "disabled"] } {
- Entry::configure $entry -takefocus 1
- }
- }
- }
-
- if {$chgedit || [Widget::hasChangedX $path -expand]} {
- # Unset what we may have created.
- ::bind $entry <Tab> {}
- if {[Widget::cget $path -editable]} {
- set expand [Widget::cget $path -expand]
- if {[string equal "tab" $expand]} {
- # Expand entry value on Tab (from -values)
- ::bind $entry <Tab> "[list ComboBox::_expand $path]; break"
- } elseif {[string equal "auto" $expand]} {
- # Expand entry value anytime (from -values)
- #::bind $entry <Key> "[list ComboBox::_expand $path]; break"
- }
- }
- }
-
- # if state changed to normal and -editable false, the edit must take focus
- if { [Widget::hasChangedX $path -state] \
- && ![string equal [Widget::cget $path -state] "disabled"] \
- && ![Widget::cget $path -editable] } {
- Entry::configure $entry -takefocus 1
- }
-
- # if the dropdown listbox is shown, simply force the actual entry
- # colors into it. If it is not shown, the next time the dropdown
- # is shown it'll get the actual colors anyway
- if {[winfo exists $path.shell.listb]} {
- if {[Widget::theme]} {
- $path.shell.listb configure \
- -fg [_getfg $path]
- } else {
- $path.shell.listb configure \
- -bg [Widget::cget $path -entrybg] \
- -fg [Widget::cget $path -foreground] \
- -selectbackground [Widget::cget $path -selectbackground] \
- -selectforeground [Widget::cget $path -selectforeground]
- }
- }
-
- return $res
-}
-
-
-# ----------------------------------------------------------------------------
-# Command ComboBox::cget
-# ----------------------------------------------------------------------------
-proc ComboBox::cget { path option } {
- return [Widget::cget $path $option]
-}
-
-
-# ----------------------------------------------------------------------------
-# Command ComboBox::setvalue
-# ----------------------------------------------------------------------------
-proc ComboBox::setvalue { path index } {
- variable _index
-
- set values [Widget::getMegawidgetOption $path -values]
- set value [Entry::cget $path.e -text]
- switch -- $index {
- next {
- if { [set idx [lsearch -exact $values $value]] != -1 } {
- incr idx
- } else {
- set idx [lsearch -exact $values "$value*"]
- }
- }
- previous {
- if { [set idx [lsearch -exact $values $value]] != -1 } {
- incr idx -1
- } else {
- set idx [lsearch -exact $values "$value*"]
- }
- }
- first {
- set idx 0
- }
- last {
- set idx [expr {[llength $values]-1}]
- }
- default {
- if { [string index $index 0] == "@" } {
- set idx [string range $index 1 end]
- if { ![string is integer -strict $idx] } {
- return -code error "bad index \"$index\""
- }
- } else {
- return -code error "bad index \"$index\""
- }
- }
- }
- if { $idx >= 0 && $idx < [llength $values] } {
- set newval [lindex $values $idx]
- set _index($path) $idx
- Entry::configure $path.e -text $newval
- return 1
- }
- return 0
-}
-
-
-proc ComboBox::icursor { path idx } {
- return [$path.e icursor $idx]
-}
-
-
-proc ComboBox::get { path } {
- return [$path.e get]
-}
-
-
-# ----------------------------------------------------------------------------
-# Command ComboBox::getvalue
-# ----------------------------------------------------------------------------
-proc ComboBox::getvalue { path } {
- variable _index
- set values [Widget::getMegawidgetOption $path -values]
- set value [Entry::cget $path.e -text]
- # Check if an index was saved by the last setvalue operation
- # If this index still matches it is returned
- # This is necessary for the case when values is not unique
- if { $_index($path) >= 0 \
- && $_index($path) < [llength $values] \
- && $value eq [lindex $values $_index($path)]} {
- return $_index($path)
- }
-
- return [lsearch -exact $values $value]
-}
-
-
-proc ComboBox::getlistbox { path } {
- _create_popup $path
- return $path.shell.listb
-}
-
-
-# ----------------------------------------------------------------------------
-# Command ComboBox::post
-# ----------------------------------------------------------------------------
-proc ComboBox::post { path } {
- _mapliste $path
- return
-}
-
-
-proc ComboBox::unpost { path } {
- _unmapliste $path
- return
-}
-
-
-# ----------------------------------------------------------------------------
-# Command ComboBox::bind
-# ----------------------------------------------------------------------------
-proc ComboBox::bind { path args } {
- return [eval [list ::bind $path.e] $args]
-}
-
-
-proc ComboBox::insert { path idx args } {
- upvar #0 [Widget::varForOption $path -values] values
-
- if {[Widget::cget $path -bwlistbox]} {
- set l [$path getlistbox]
- set i [eval [linsert $args 0 $l insert $idx #auto]]
- set text [$l itemcget $i -text]
- if {$idx == "end"} {
- lappend values $text
- } else {
- set values [linsert $values $idx $text]
- }
- } else {
- set values [eval [list linsert $values $idx] $args]
- }
-}
-
-# ----------------------------------------------------------------------------
-# Command ComboBox::clearvalue
-# ----------------------------------------------------------------------------
-proc ComboBox::clearvalue { path } {
- Entry::configure $path.e -text ""
-}
-
-# ----------------------------------------------------------------------------
-# Command ComboBox::getentry
-# ----------------------------------------------------------------------------
-proc ComboBox::getentry { path } {
- return $path.e
-}
-
-proc ComboBox::_getfg {path} {
- # First try to retrieve option
- set fg [Widget::cget $path -foreground];
- if { 0 == [string length $fg] && [Widget::theme] } {
- # fall back to style settings when not configured for widget
- return [::ttk::style lookup TEntry -foreground];
- }
- return $fg;
-}
-# ----------------------------------------------------------------------------
-# Command ComboBox::_create_popup
-# ----------------------------------------------------------------------------
-proc ComboBox::_create_popup { path } {
- set shell $path.shell
-
- if {[winfo exists $shell]} { return }
-
- set lval [Widget::cget $path -values]
- set h [Widget::cget $path -height]
- set bw [Widget::cget $path -bwlistbox]
-
- if { $h <= 0 } {
- set len [llength $lval]
- if { $len < 3 } {
- set h 3
- } elseif { $len > 10 } {
- set h 10
- } else {
- set h $len
- }
- }
-
- if {[string equal [tk windowingsystem] "x11"]} {
- set sbwidth 11
- } else {
- set sbwidth 15
- }
-
- toplevel $shell -relief solid -bd 1
- wm withdraw $shell
- wm overrideredirect $shell 1
- # these commands cause the combobox to behave strangely on OS X
- if {! $Widget::_aqua } {
- update idle
- wm transient $shell [winfo toplevel $path]
- catch { wm attributes $shell -topmost 1 }
- }
-
- set sw [ScrolledWindow $shell.sw -managed 1 -size $sbwidth -ipad 0]
-
- if {$bw} {
- if {[Widget::theme]} {
- set listb [ListBox $shell.listb \
- -relief flat -borderwidth 0 -highlightthickness 0 \
- -selectmode single -selectfill 1 -autofocus 0 -height $h \
- -font [Widget::cget $path -font] \
- -bg [Widget::cget $path -entrybg] \
- -fg [_getfg $path]]
- } else {
- set listb [ListBox $shell.listb \
- -relief flat -borderwidth 0 -highlightthickness 0 \
- -selectmode single -selectfill 1 -autofocus 0 -height $h \
- -font [Widget::cget $path -font] \
- -bg [Widget::cget $path -entrybg] \
- -fg [Widget::cget $path -foreground] \
- -selectbackground [Widget::cget $path -selectbackground] \
- -selectforeground [Widget::cget $path -selectforeground]]
- }
-
- set values [Widget::cget $path -values]
- set images [Widget::cget $path -images]
- foreach value $values image $images {
- $listb insert end #auto -text $value -image $image
- }
- $listb bindText <1> [list ComboBox::_select $path]
- $listb bindImage <1> [list ComboBox::_select $path]
- if {[Widget::cget $path -hottrack]} {
- $listb bindText <Enter> [list $listb selection set]
- $listb bindImage <Enter> [list $listb selection set]
- }
- } else {
- if {[Widget::theme]} {
- set listb [listbox $shell.listb \
- -relief flat -borderwidth 0 -highlightthickness 0 \
- -exportselection false \
- -font [Widget::cget $path -font] \
- -height $h \
- -fg [_getfg $path] \
- -listvariable [Widget::varForOption $path -values]]
- } else {
- set listb [listbox $shell.listb \
- -relief flat -borderwidth 0 -highlightthickness 0 \
- -exportselection false \
- -font [Widget::cget $path -font] \
- -height $h \
- -bg [Widget::cget $path -entrybg] \
- -fg [Widget::cget $path -foreground] \
- -selectbackground [Widget::cget $path -selectbackground] \
- -selectforeground [Widget::cget $path -selectforeground] \
- -listvariable [Widget::varForOption $path -values]]
- }
- ::bind $listb <ButtonRelease-1> [list ComboBox::_select $path @%x,%y]
-
- if {[Widget::cget $path -hottrack]} {
- bindtags $listb [concat [bindtags $listb] ListBoxHotTrack]
- }
- }
- pack $sw -fill both -expand yes
- $sw setwidget $listb
-
- ::bind $listb <Return> "ComboBox::_select [list $path] \[$listb curselection\]"
- ::bind $listb <Escape> [list ComboBox::_unmapliste $path]
- ::bind $listb <FocusOut> [list ComboBox::_focus_out $path]
-}
-
-
-proc ComboBox::_recreate_popup { path } {
- variable background
- variable foreground
-
- set shell $path.shell
- set lval [Widget::cget $path -values]
- set h [Widget::cget $path -height]
- set bw [Widget::cget $path -bwlistbox]
-
- if { $h <= 0 } {
- set len [llength $lval]
- if { $len < 3 } {
- set h 3
- } elseif { $len > 10 } {
- set h 10
- } else {
- set h $len
- }
- }
-
- if { [string equal [tk windowingsystem] "x11"] } {
- set sbwidth 11
- } else {
- set sbwidth 15
- }
-
- _create_popup $path
-
- if {![Widget::cget $path -editable]} {
- if {[info exists background]} {
- $path.e configure -bg $background
- $path.e configure -fg $foreground
- unset background
- unset foreground
- }
- }
-
- set listb $shell.listb
- destroy $shell.sw
- set sw [ScrolledWindow $shell.sw -managed 1 -size $sbwidth -ipad 0]
- $listb configure \
- -height $h \
- -font [Widget::cget $path -font] \
- -fg [_getfg $path]
- if {![Widget::theme]} {
- $listb configure \
- -bg [Widget::cget $path -entrybg] \
- -selectbackground [Widget::cget $path -selectbackground] \
- -selectforeground [Widget::cget $path -selectforeground]
- }
- pack $sw -fill both -expand yes
- $sw setwidget $listb
- raise $listb
-}
-
-
-# ----------------------------------------------------------------------------
-# Command ComboBox::_mapliste
-# ----------------------------------------------------------------------------
-proc ComboBox::_mapliste { path } {
- set listb $path.shell.listb
- if {[winfo exists $path.shell] &&
- [string equal [wm state $path.shell] "normal"]} {
- _unmapliste $path
- return
- }
-
- if { [Widget::cget $path -state] == "disabled" } {
- return
- }
- if {[llength [set cmd [Widget::getMegawidgetOption $path -postcommand]]]} {
- uplevel \#0 $cmd
- }
- if { ![llength [Widget::getMegawidgetOption $path -values]] } {
- return
- }
-
- _recreate_popup $path
-
- ArrowButton::configure $path.a -relief sunken
- update
-
- set bw [Widget::cget $path -bwlistbox]
-
- $listb selection clear 0 end
- set values [Widget::getMegawidgetOption $path -values]
- set curval [Entry::cget $path.e -text]
- if { [set idx [lsearch -exact $values $curval]] != -1 ||
- [set idx [lsearch -exact $values "$curval*"]] != -1 } {
- if {$bw} {
- set idx [$listb items $idx]
- } else {
- $listb activate $idx
- }
- $listb selection set $idx
- $listb see $idx
- } else {
- set idx 0
- if {$bw} {
- set idx [$listb items 0]
- } else {
- $listb activate $idx
- }
- $listb selection set $idx
- $listb see $idx
- }
-
- set width [Widget::cget $path -listboxwidth]
- if {!$width} { set width [winfo width $path] }
- BWidget::place $path.shell $width 0 below $path
- wm deiconify $path.shell
- raise $path.shell
- BWidget::focus set $listb
- if {! $Widget::_aqua } {
- BWidget::grab global $path
- }
-}
-
-
-# ----------------------------------------------------------------------------
-# Command ComboBox::_unmapliste
-# ----------------------------------------------------------------------------
-proc ComboBox::_unmapliste { path {refocus 1} } {
- # On aqua, state is zoomed, otherwise normal
- if {[winfo exists $path.shell] && \
- ( [string equal [wm state $path.shell] "normal"] ||
- [string equal [wm state $path.shell] "zoomed"] ) } {
- if {! $Widget::_aqua } {
- BWidget::grab release $path
- BWidget::focus release $path.shell.listb $refocus
- # Update now because otherwise [focus -force...] makes the app hang!
- if {$refocus} {
- update
- focus -force $path.e
- }
- }
- wm withdraw $path.shell
- ArrowButton::configure $path.a -relief raised
- }
-}
-
-
-# ----------------------------------------------------------------------------
-# Command ComboBox::_select
-# ----------------------------------------------------------------------------
-proc ComboBox::_select { path index } {
- set index [$path.shell.listb index $index]
- _unmapliste $path
- if { $index != -1 } {
- if { [setvalue $path @$index] } {
- set cmd [Widget::getMegawidgetOption $path -modifycmd]
- if {[llength $cmd]} {
- uplevel \#0 $cmd
- }
- }
- }
- $path.e selection clear
- if {[$path.e cget -exportselection]} {
- $path.e selection range 0 end
- }
-}
-
-
-# ----------------------------------------------------------------------------
-# Command ComboBox::_modify_value
-# ----------------------------------------------------------------------------
-proc ComboBox::_modify_value { path direction } {
- if {[setvalue $path $direction]
- && [llength [set cmd [Widget::getMegawidgetOption $path -modifycmd]]]} {
- uplevel \#0 $cmd
- }
-}
-
-# ----------------------------------------------------------------------------
-# Command ComboBox::_expand
-# ----------------------------------------------------------------------------
-proc ComboBox::_expand {path} {
- set values [Widget::getMegawidgetOption $path -values]
- if {![llength $values]} {
- bell
- return 0
- }
-
- set found {}
- set curval [Entry::cget $path.e -text]
- set curlen [$path.e index insert]
- if {$curlen < [string length $curval]} {
- # we are somewhere in the middle of a string.
- # if the full value matches some string in the listbox,
- # reorder values to start matching after that string.
- set idx [lsearch -exact $values $curval]
- if {$idx >= 0} {
- set values [concat [lrange $values [expr {$idx+1}] end] \
- [lrange $values 0 $idx]]
- }
- }
- if {$curlen == 0} {
- set found $values
- } else {
- foreach val $values {
- if {[string equal -length $curlen $curval $val]} {
- lappend found $val
- }
- }
- }
- if {[llength $found]} {
- Entry::configure $path.e -text [lindex $found 0]
- if {[llength $found] > 1} {
- set best [_best_match $found [string range $curval 0 $curlen]]
- set blen [string length $best]
- $path.e icursor $blen
- $path.e selection range $blen end
- }
- } else {
- bell
- }
- return [llength $found]
-}
-
-# best_match --
-# finds the best unique match in a list of names
-# The extra $e in this argument allows us to limit the innermost loop a
-# little further.
-# Arguments:
-# l list to find best unique match in
-# e currently best known unique match
-# Returns:
-# longest unique match in the list
-#
-proc ComboBox::_best_match {l {e {}}} {
- set ec [lindex $l 0]
- if {[llength $l]>1} {
- set e [string length $e]; incr e -1
- set ei [string length $ec]; incr ei -1
- foreach l $l {
- while {$ei>=$e && [string first $ec $l]} {
- set ec [string range $ec 0 [incr ei -1]]
- }
- }
- }
- return $ec
-}
-# possibly faster
-#proc match {string1 string2} {
-# set i 1
-# while {[string equal -length $i $string1 $string2]} { incr i }
-# return [string range $string1 0 [expr {$i-2}]]
-#}
-#proc matchlist {list} {
-# set list [lsort $list]
-# return [match [lindex $list 0] [lindex $list end]]
-#}
-
-
-# ----------------------------------------------------------------------------
-# Command ComboBox::_traverse_in
-# Called when widget receives keyboard focus due to keyboard traversal.
-# ----------------------------------------------------------------------------
-proc ComboBox::_traverse_in { path } {
- if {[$path.e selection present] != 1} {
- # Autohighlight the selection, but not if one existed
- $path.e selection range 0 end
- }
-}
-
-
-# ----------------------------------------------------------------------------
-# Command ComboBox::_focus_out
-# ----------------------------------------------------------------------------
-proc ComboBox::_focus_out { path } {
- if {[string first $path [focus]] != 0} {
- # we lost focus to some other app or window, so remove the listbox
- return [_unmapliste $path 0]
- }
-}
-
-proc ComboBox::_auto_complete { path key } {
- ## Any key string with more than one character and is not entirely
- ## lower-case is considered a function key and is thus ignored.
- if {[string length $key] > 1 && [string tolower $key] != $key} { return }
-
- set text [string map [list {[} {\[} {]} {\]}] [$path.e get]]
- if {[string equal $text ""]} { return }
- set values [Widget::cget $path -values]
- set x [lsearch $values $text*]
- if {$x < 0} { return }
-
- set idx [$path.e index insert]
- $path.e configure -text [lindex $values $x]
- $path.e icursor $idx
- $path.e select range insert end
-}
-
-proc ComboBox::_auto_post { path key } {
- if {[string equal $key "Escape"] || [string equal $key "Return"]} {
- _unmapliste $path
- return
- }
- if {[catch {$path.shell.listb curselection} x] || $x == ""} {
- if {[string equal $key "Up"]} {
- _unmapliste $path
- return
- }
- set x -1
- }
- if {([string length $key] > 1 && [string tolower $key] != $key) && \
- [string equal $key "BackSpace"] != 0 && \
- [string equal $key "Up"] != 0 && \
- [string equal $key "Down"] != 0} {
- return
- }
-
- # post the listbox
- _create_popup $path
- set width [Widget::cget $path -listboxwidth]
- if {!$width} { set width [winfo width $path] }
- BWidget::place $path.shell $width 0 below $path
- wm deiconify $path.shell
- BWidget::grab release $path
- BWidget::focus release $path.shell.listb 1
- focus -force $path.e
-
- set values [Widget::cget $path -values]
- switch -- $key {
- Up {
- if {[incr x -1] < 0} {
- set x 0
- } else {
- Entry::configure $path.e -text [lindex $values $x]
- }
- }
- Down {
- if {[incr x] >= [llength $values]} {
- set x [expr {[llength $values] - 1}]
- } else {
- Entry::configure $path.e -text [lindex $values $x]
- }
- }
- default {
- # auto-select within the listbox the item closest to the entry's value
- set text [string map [list {[} {\[} {]} {\]}] [$path.e get]]
- if {[string equal $text ""]} {
- set x 0
- } else {
- set x [lsearch $values $text*]
- }
- }
- }
-
- if {$x >= 0} {
- $path.shell.listb selection clear 0 end
- $path.shell.listb selection set $x
- $path.shell.listb see $x
- }
-}
-# ------------------------------------------------------------------------------
-# Command ComboBox::_destroy
-# ------------------------------------------------------------------------------
-proc ComboBox::_destroy { path } {
- variable _index
- Widget::destroy $path
- unset _index($path)
-}
+# ----------------------------------------------------------------------------
+# combobox.tcl
+# This file is part of Unifix BWidget Toolkit
+# $Id: combobox.tcl,v 1.42.2.3 2012/04/02 09:53:41 oehhar Exp $
+# ----------------------------------------------------------------------------
+# Index of commands:
+# - ComboBox::create
+# - ComboBox::configure
+# - ComboBox::cget
+# - ComboBox::setvalue
+# - ComboBox::getvalue
+# - ComboBox::clearvalue
+# - ComboBox::getentry
+# - ComboBox::_create_popup
+# - ComboBox::_mapliste
+# - ComboBox::_unmapliste
+# - ComboBox::_select
+# - ComboBox::_modify_value
+# ----------------------------------------------------------------------------
+
+# ComboBox uses the 8.3 -listvariable listbox option
+package require Tk 8.3
+
+namespace eval ComboBox {
+ Widget::define ComboBox combobox ArrowButton Entry ListBox
+
+ Widget::tkinclude ComboBox frame :cmd \
+ include {-relief -borderwidth -bd -background} \
+ initialize {-relief sunken -borderwidth 2}
+
+ if {[Widget::theme]} {
+ Widget::bwinclude ComboBox Entry .e
+ } else {
+ Widget::bwinclude ComboBox Entry .e \
+ remove {-relief -bd -borderwidth -bg} \
+ rename {-background -entrybg}
+ }
+
+ Widget::declare ComboBox {
+ {-height TkResource 0 0 listbox}
+ {-values String "" 0}
+ {-images String "" 0}
+ {-indents String "" 0}
+ {-modifycmd String "" 0}
+ {-postcommand String "" 0}
+ {-expand Enum none 0 {none tab}}
+ {-autocomplete Boolean 0 0}
+ {-autopost Boolean 0 0}
+ {-bwlistbox Boolean 0 0}
+ {-listboxwidth Int 0 0}
+ {-hottrack Boolean 0 0}
+ }
+
+ if {[Widget::theme]} {
+ Widget::addmap ComboBox ArrowButton .a {
+ -background {} -state {}
+ }
+ } else {
+ Widget::addmap ComboBox ArrowButton .a {
+ -background {} -foreground {} -disabledforeground {} -state {}
+ }
+ }
+
+ Widget::syncoptions ComboBox Entry .e {-text {}}
+
+ ::bind BwComboBox <FocusIn> [list after idle {BWidget::refocus %W %W.e}]
+ ::bind BwComboBox <Destroy> [list ComboBox::_destroy %W]
+
+ ::bind ListBoxHotTrack <Motion> {
+ %W selection clear 0 end
+ %W activate @%x,%y
+ %W selection set @%x,%y
+ }
+
+ variable _index
+}
+
+
+# ComboBox::create --
+#
+# Create a combobox widget with the given options.
+#
+# Arguments:
+# path name of the new widget.
+# args optional arguments to the widget.
+#
+# Results:
+# path name of the new widget.
+
+proc ComboBox::create { path args } {
+ array set maps [list ComboBox {} :cmd {} .e {} .a {}]
+ array set maps [Widget::parseArgs ComboBox $args]
+
+ eval [list frame $path] $maps(:cmd) \
+ [list -highlightthickness 0 -takefocus 0 -class ComboBox]
+ Widget::initFromODB ComboBox $path $maps(ComboBox)
+
+ bindtags $path [list $path BwComboBox [winfo toplevel $path] all]
+
+ if {[Widget::theme]} {
+ set entry [eval [list Entry::create $path.e] $maps(.e) \
+ [list -takefocus 1]]
+ } else {
+ set entry [eval [list Entry::create $path.e] $maps(.e) \
+ [list -relief flat -borderwidth 0 -takefocus 1]]
+ }
+
+ ::bind $path.e <FocusOut> [list $path _focus_out]
+ ::bind $path <<TraverseIn>> [list $path _traverse_in]
+
+ if {[Widget::cget $path -autocomplete]} {
+ ::bind $path.e <KeyRelease> [list $path _auto_complete %K]
+ }
+
+ if {[Widget::cget $path -autopost]} {
+ ::bind $path.e <KeyRelease> +[list $path _auto_post %K]
+ } else {
+ ::bind $entry <Key-Up> [list ComboBox::_unmapliste $path]
+ ::bind $entry <Key-Down> [list ComboBox::_mapliste $path]
+ }
+
+ if {[string equal [tk windowingsystem] "x11"]} {
+ set ipadx 0
+ set width 11
+ } else {
+ set ipadx 2
+ set width 15
+ }
+ set height [winfo reqheight $entry]
+ set arrow [eval [list ArrowButton::create $path.a] $maps(.a) \
+ [list -width $width -height $height \
+ -highlightthickness 0 -borderwidth 1 -takefocus 0 \
+ -dir bottom -type button -ipadx $ipadx \
+ -command [list ComboBox::_mapliste $path] \
+ ]]
+
+ pack $arrow -side right -fill y
+ pack $entry -side left -fill both -expand yes
+
+ set editable [Widget::cget $path -editable]
+ Entry::configure $path.e -editable $editable
+ if {$editable} {
+ ::bind $entry <ButtonPress-1> [list ComboBox::_unmapliste $path]
+ } else {
+ ::bind $entry <ButtonPress-1> [list ArrowButton::invoke $path.a]
+ if { ![string equal [Widget::cget $path -state] "disabled"] } {
+ Entry::configure $path.e -takefocus 1
+ }
+ }
+
+ ::bind $path <ButtonPress-1> [list ComboBox::_unmapliste $path]
+ ::bind $entry <Control-Up> [list ComboBox::_modify_value $path previous]
+ ::bind $entry <Control-Down> [list ComboBox::_modify_value $path next]
+ ::bind $entry <Control-Prior> [list ComboBox::_modify_value $path first]
+ ::bind $entry <Control-Next> [list ComboBox::_modify_value $path last]
+
+ if {$editable} {
+ set expand [Widget::cget $path -expand]
+ if {[string equal "tab" $expand]} {
+ # Expand entry value on Tab (from -values)
+ ::bind $entry <Tab> "[list ComboBox::_expand $path]; break"
+ } elseif {[string equal "auto" $expand]} {
+ # Expand entry value anytime (from -values)
+ #::bind $entry <Key> "[list ComboBox::_expand $path]; break"
+ }
+ }
+
+ ## If we have images, we have to use a BWidget ListBox.
+ set bw [Widget::cget $path -bwlistbox]
+ if {[llength [Widget::cget $path -images]]} {
+ Widget::configure $path [list -bwlistbox 1]
+ } else {
+ Widget::configure $path [list -bwlistbox $bw]
+ }
+
+ set ComboBox::_index($path) -1
+
+ return [Widget::create ComboBox $path]
+}
+
+
+# ComboBox::configure --
+#
+# Configure subcommand for ComboBox widgets. Works like regular
+# widget configure command.
+#
+# Arguments:
+# path Name of the ComboBox widget.
+# args Additional optional arguments:
+# ?-option?
+# ?-option value ...?
+#
+# Results:
+# Depends on arguments. If no arguments are given, returns a complete
+# list of configuration information. If one argument is given, returns
+# the configuration information for that option. If more than one
+# argument is given, returns nothing.
+
+proc ComboBox::configure { path args } {
+ set res [Widget::configure $path $args]
+ set entry $path.e
+
+
+ set list [list -images -values -bwlistbox -hottrack -autocomplete -autopost]
+ foreach {ci cv cb ch cac cap} [eval [linsert $list 0 Widget::hasChangedX $path]] { break }
+
+ if { $ci } {
+ set images [Widget::cget $path -images]
+ if {[llength $images]} {
+ Widget::configure $path [list -bwlistbox 1]
+ } else {
+ Widget::configure $path [list -bwlistbox 0]
+ }
+ }
+
+ ## If autocomplete toggled, turn bindings on/off
+ if { $cac } {
+ if {[Widget::cget $path -autocomplete]} {
+ ::bind $entry <KeyRelease> +[list $path _auto_complete %K]
+ } else {
+ set bindings [split [::bind $entry <KeyRelease>] \n]
+ if {[set idx [lsearch $bindings [list $path _auto_complete %K]]] != -1} {
+ ::bind $entry <KeyRelease> [join [lreplace $bindings $idx $idx] \n]
+ }
+ }
+ }
+
+ ## If autopost toggled, turn bindings on/off
+ if { $cap } {
+ if {[Widget::cget $path -autopost]} {
+ ::bind $entry <KeyRelease> +[list $path _auto_post %K]
+ set bindings [split [::bind $entry <Key-Up>] \n]
+ if {[set idx [lsearch $bindings [list ComboBox::_unmapliste $path]]] != -1} {
+ ::bind $entry <Key-Up> [join [lreplace $bindings $idx $idx] \n]
+ }
+ set bindings [split [::bind $entry <Key-Down>] \n]
+ if {[set idx [lsearch $bindings [list ComboBox::_mapliste $path]]] != -1} {
+ ::bind $entry <Key-Down> [join [lreplace $bindings $idx $idx] \n]
+ }
+ } else {
+ set bindings [split [::bind $entry <KeyRelease>] \n]
+ if {[set idx [lsearch $bindings [list $path _auto_post %K]]] != -1} {
+ ::bind $entry <KeyRelease> [join [lreplace $bindings $idx $idx] \n]
+ }
+ ::bind $entry <Key-Up> +[list ComboBox::_unmapliste $path]
+ ::bind $entry <Key-Down> +[list ComboBox::_mapliste $path]
+ }
+ }
+
+ set bw [Widget::cget $path -bwlistbox]
+
+ ## If the images, bwlistbox, hottrack or values have changed,
+ ## destroy the shell so that it will re-create itself the next
+ ## time around.
+ if { $ci || $cb || $ch || ($bw && $cv) } {
+ destroy $path.shell
+ }
+
+ set chgedit [Widget::hasChangedX $path -editable]
+ if {$chgedit} {
+ if {[Widget::cget $path -editable]} {
+ ::bind $entry <ButtonPress-1> [list ComboBox::_unmapliste $path]
+ Entry::configure $entry -editable true
+ } else {
+ ::bind $entry <ButtonPress-1> [list ArrowButton::invoke $path.a]
+ Entry::configure $entry -editable false
+
+ # Make sure that non-editable comboboxes can still be tabbed to.
+
+ if { ![string equal [Widget::cget $path -state] "disabled"] } {
+ Entry::configure $entry -takefocus 1
+ }
+ }
+ }
+
+ if {$chgedit || [Widget::hasChangedX $path -expand]} {
+ # Unset what we may have created.
+ ::bind $entry <Tab> {}
+ if {[Widget::cget $path -editable]} {
+ set expand [Widget::cget $path -expand]
+ if {[string equal "tab" $expand]} {
+ # Expand entry value on Tab (from -values)
+ ::bind $entry <Tab> "[list ComboBox::_expand $path]; break"
+ } elseif {[string equal "auto" $expand]} {
+ # Expand entry value anytime (from -values)
+ #::bind $entry <Key> "[list ComboBox::_expand $path]; break"
+ }
+ }
+ }
+
+ # if state changed to normal and -editable false, the edit must take focus
+ if { [Widget::hasChangedX $path -state] \
+ && ![string equal [Widget::cget $path -state] "disabled"] \
+ && ![Widget::cget $path -editable] } {
+ Entry::configure $entry -takefocus 1
+ }
+
+ # if the dropdown listbox is shown, simply force the actual entry
+ # colors into it. If it is not shown, the next time the dropdown
+ # is shown it'll get the actual colors anyway
+ if {[winfo exists $path.shell.listb]} {
+ $path.shell.listb configure \
+ -bg [_getbg $path] \
+ -fg [_getfg $path]
+ if {![Widget::theme]} {
+ $path.shell.listb configure \
+ -selectbackground [Widget::cget $path -selectbackground] \
+ -selectforeground [Widget::cget $path -selectforeground]
+ }
+ }
+
+ return $res
+}
+
+
+# ----------------------------------------------------------------------------
+# Command ComboBox::cget
+# ----------------------------------------------------------------------------
+proc ComboBox::cget { path option } {
+ return [Widget::cget $path $option]
+}
+
+
+# ----------------------------------------------------------------------------
+# Command ComboBox::setvalue
+# ----------------------------------------------------------------------------
+proc ComboBox::setvalue { path index } {
+ variable _index
+
+ set values [Widget::getMegawidgetOption $path -values]
+ set value [Entry::cget $path.e -text]
+ switch -- $index {
+ next {
+ if { [set idx [lsearch -exact $values $value]] != -1 } {
+ incr idx
+ } else {
+ set idx [lsearch -exact $values "$value*"]
+ }
+ }
+ previous {
+ if { [set idx [lsearch -exact $values $value]] != -1 } {
+ incr idx -1
+ } else {
+ set idx [lsearch -exact $values "$value*"]
+ }
+ }
+ first {
+ set idx 0
+ }
+ last {
+ set idx [expr {[llength $values]-1}]
+ }
+ default {
+ if { [string index $index 0] == "@" } {
+ set idx [string range $index 1 end]
+ if { ![string is integer -strict $idx] } {
+ return -code error "bad index \"$index\""
+ }
+ } else {
+ return -code error "bad index \"$index\""
+ }
+ }
+ }
+ if { $idx >= 0 && $idx < [llength $values] } {
+ set newval [lindex $values $idx]
+ set _index($path) $idx
+ Entry::configure $path.e -text $newval
+ return 1
+ }
+ return 0
+}
+
+
+proc ComboBox::icursor { path idx } {
+ return [$path.e icursor $idx]
+}
+
+
+proc ComboBox::get { path } {
+ return [$path.e get]
+}
+
+
+# ----------------------------------------------------------------------------
+# Command ComboBox::getvalue
+# ----------------------------------------------------------------------------
+proc ComboBox::getvalue { path } {
+ variable _index
+ set values [Widget::getMegawidgetOption $path -values]
+ set value [Entry::cget $path.e -text]
+ # Check if an index was saved by the last setvalue operation
+ # If this index still matches it is returned
+ # This is necessary for the case when values is not unique
+ if { $_index($path) >= 0 \
+ && $_index($path) < [llength $values] \
+ && $value eq [lindex $values $_index($path)]} {
+ return $_index($path)
+ }
+
+ return [lsearch -exact $values $value]
+}
+
+
+proc ComboBox::getlistbox { path } {
+ _create_popup $path
+ return $path.shell.listb
+}
+
+
+# ----------------------------------------------------------------------------
+# Command ComboBox::post
+# ----------------------------------------------------------------------------
+proc ComboBox::post { path } {
+ _mapliste $path
+ return
+}
+
+
+proc ComboBox::unpost { path } {
+ _unmapliste $path
+ return
+}
+
+
+# ----------------------------------------------------------------------------
+# Command ComboBox::bind
+# ----------------------------------------------------------------------------
+proc ComboBox::bind { path args } {
+ return [eval [list ::bind $path.e] $args]
+}
+
+
+proc ComboBox::insert { path idx args } {
+ upvar #0 [Widget::varForOption $path -values] values
+
+ if {[Widget::cget $path -bwlistbox]} {
+ set l [$path getlistbox]
+ set i [eval [linsert $args 0 $l insert $idx #auto]]
+ set text [$l itemcget $i -text]
+ if {$idx == "end"} {
+ lappend values $text
+ } else {
+ set values [linsert $values $idx $text]
+ }
+ } else {
+ set values [eval [list linsert $values $idx] $args]
+ }
+}
+
+# ----------------------------------------------------------------------------
+# Command ComboBox::clearvalue
+# ----------------------------------------------------------------------------
+proc ComboBox::clearvalue { path } {
+ Entry::configure $path.e -text ""
+}
+
+# ----------------------------------------------------------------------------
+# Command ComboBox::getentry
+# ----------------------------------------------------------------------------
+proc ComboBox::getentry { path } {
+ return $path.e
+}
+
+proc ComboBox::_getfg {path} {
+ set res "";
+ if {[Widget::theme]} {
+ # First try to retrieve option
+ set fg [Widget::cget $path -foreground];
+ if {[string length $fg]} {
+ set res $fg;
+ } else {
+ # fall back to style settings when not configured for widget
+ set res [::ttk::style lookup TEntry -foreground];
+ }
+ } else {
+ set res [Widget::cget $path -foreground]
+ }
+ return $res;
+}
+
+proc ComboBox::_getbg {path} {
+ set res "";
+ if {[Widget::theme]} {
+ # First try to retrieve option
+ set bg [Widget::cget $path -background];
+ if {[string length $bg]} {
+ set res $bg;
+ } else {
+ # fall back to style settings when not configured for widget
+ set res [::ttk::style lookup TEntry -backround];
+ }
+ } else {
+ # fetch the entrybg resource value
+ set res [Widget::cget $path -entrybg]
+ }
+ return $res;
+}
+
+# ----------------------------------------------------------------------------
+# Command ComboBox::_create_popup
+# ----------------------------------------------------------------------------
+proc ComboBox::_create_popup { path } {
+ set shell $path.shell
+
+ if {[winfo exists $shell]} { return }
+
+ set lval [Widget::cget $path -values]
+ set h [Widget::cget $path -height]
+ set bw [Widget::cget $path -bwlistbox]
+
+ if { $h <= 0 } {
+ set len [llength $lval]
+ if { $len < 3 } {
+ set h 3
+ } elseif { $len > 10 } {
+ set h 10
+ } else {
+ set h $len
+ }
+ }
+
+ if {[string equal [tk windowingsystem] "x11"]} {
+ set sbwidth 11
+ } else {
+ set sbwidth 15
+ }
+
+ toplevel $shell -relief solid -bd 1
+ wm withdraw $shell
+ wm overrideredirect $shell 1
+ # these commands cause the combobox to behave strangely on OS X
+ if {! $Widget::_aqua } {
+ update idle
+ wm transient $shell [winfo toplevel $path]
+ catch { wm attributes $shell -topmost 1 }
+ }
+
+ set sw [ScrolledWindow $shell.sw -managed 1 -size $sbwidth -ipad 0]
+
+ if {$bw} {
+ if {[Widget::theme]} {
+ set listb \
+ [ListBox $shell.listb \
+ -relief flat -borderwidth 0 -highlightthickness 0 \
+ -selectmode single -selectfill 1 -autofocus 0 -height $h \
+ -font [Widget::cget $path -font] \
+ -bg [_getbg $path] \
+ -fg [_getfg $path]]
+ } else {
+ set listb \
+ [ListBox $shell.listb \
+ -relief flat -borderwidth 0 -highlightthickness 0 \
+ -selectmode single -selectfill 1 -autofocus 0 -height $h \
+ -font [Widget::cget $path -font] \
+ -bg [_getbg $path] \
+ -fg [_getfg $path] \
+ -selectbackground [Widget::cget $path -selectbackground] \
+ -selectforeground [Widget::cget $path -selectforeground]]
+ }
+
+ set values [Widget::cget $path -values]
+ set images [Widget::cget $path -images]
+ foreach value $values image $images {
+ $listb insert end #auto -text $value -image $image
+ }
+ $listb bindText <1> [list ComboBox::_select $path]
+ $listb bindImage <1> [list ComboBox::_select $path]
+ if {[Widget::cget $path -hottrack]} {
+ $listb bindText <Enter> [list $listb selection set]
+ $listb bindImage <Enter> [list $listb selection set]
+ }
+ } else {
+ if {[Widget::theme]} {
+ set listb \
+ [listbox $shell.listb \
+ -relief flat -borderwidth 0 -highlightthickness 0 \
+ -exportselection false \
+ -font [Widget::cget $path -font] \
+ -height $h \
+ -bg [_getbg $path] \
+ -fg [_getfg $path] \
+ -listvariable [Widget::varForOption $path -values]]
+ } else {
+ set listb \
+ [listbox $shell.listb \
+ -relief flat -borderwidth 0 -highlightthickness 0 \
+ -exportselection false \
+ -font [Widget::cget $path -font] \
+ -height $h \
+ -bg [_getbg $path] \
+ -fg [_getfg $path] \
+ -selectbackground [Widget::cget $path -selectbackground] \
+ -selectforeground [Widget::cget $path -selectforeground] \
+ -listvariable [Widget::varForOption $path -values]]
+ }
+ ::bind $listb <ButtonRelease-1> [list ComboBox::_select $path @%x,%y]
+
+ if {[Widget::cget $path -hottrack]} {
+ bindtags $listb [concat [bindtags $listb] ListBoxHotTrack]
+ }
+ }
+ pack $sw -fill both -expand yes
+ $sw setwidget $listb
+
+ ::bind $listb <Return> "ComboBox::_select [list $path] \[$listb curselection\]"
+ ::bind $listb <Escape> [list ComboBox::_unmapliste $path]
+ ::bind $listb <FocusOut> [list ComboBox::_focus_out $path]
+}
+
+
+proc ComboBox::_recreate_popup { path } {
+ variable background
+ variable foreground
+
+ set shell $path.shell
+ set lval [Widget::cget $path -values]
+ set h [Widget::cget $path -height]
+ set bw [Widget::cget $path -bwlistbox]
+
+ if { $h <= 0 } {
+ set len [llength $lval]
+ if { $len < 3 } {
+ set h 3
+ } elseif { $len > 10 } {
+ set h 10
+ } else {
+ set h $len
+ }
+ }
+
+ if { [string equal [tk windowingsystem] "x11"] } {
+ set sbwidth 11
+ } else {
+ set sbwidth 15
+ }
+
+ _create_popup $path
+
+ if {![Widget::cget $path -editable]} {
+ if {[info exists background]} {
+ $path.e configure -bg $background
+ $path.e configure -fg $foreground
+ unset background
+ unset foreground
+ }
+ }
+
+ set listb $shell.listb
+ destroy $shell.sw
+ set sw [ScrolledWindow $shell.sw -managed 1 -size $sbwidth -ipad 0]
+ $listb configure \
+ -height $h \
+ -font [Widget::cget $path -font] \
+ -bg [_getbg $path] \
+ -fg [_getfg $path]
+ if {![Widget::theme]} {
+ $listb configure \
+ -selectbackground [Widget::cget $path -selectbackground] \
+ -selectforeground [Widget::cget $path -selectforeground]
+ }
+ pack $sw -fill both -expand yes
+ $sw setwidget $listb
+ raise $listb
+}
+
+
+# ----------------------------------------------------------------------------
+# Command ComboBox::_mapliste
+# ----------------------------------------------------------------------------
+proc ComboBox::_mapliste { path } {
+ set listb $path.shell.listb
+ if {[winfo exists $path.shell] &&
+ [string equal [wm state $path.shell] "normal"]} {
+ _unmapliste $path
+ return
+ }
+
+ if { [Widget::cget $path -state] == "disabled" } {
+ return
+ }
+ if {[llength [set cmd [Widget::getMegawidgetOption $path -postcommand]]]} {
+ uplevel \#0 $cmd
+ }
+ if { ![llength [Widget::getMegawidgetOption $path -values]] } {
+ return
+ }
+
+ _recreate_popup $path
+
+ ArrowButton::configure $path.a -relief sunken
+ update
+
+ set bw [Widget::cget $path -bwlistbox]
+
+ $listb selection clear 0 end
+ set values [Widget::getMegawidgetOption $path -values]
+ set curval [Entry::cget $path.e -text]
+ if { [set idx [lsearch -exact $values $curval]] != -1 ||
+ [set idx [lsearch -exact $values "$curval*"]] != -1 } {
+ if {$bw} {
+ set idx [$listb items $idx]
+ } else {
+ $listb activate $idx
+ }
+ $listb selection set $idx
+ $listb see $idx
+ } else {
+ set idx 0
+ if {$bw} {
+ set idx [$listb items 0]
+ } else {
+ $listb activate $idx
+ }
+ $listb selection set $idx
+ $listb see $idx
+ }
+
+ set width [Widget::cget $path -listboxwidth]
+ if {!$width} { set width [winfo width $path] }
+ BWidget::place $path.shell $width 0 below $path
+ wm deiconify $path.shell
+ raise $path.shell
+ BWidget::focus set $listb
+ if {! $Widget::_aqua } {
+ BWidget::grab global $path
+ }
+}
+
+
+# ----------------------------------------------------------------------------
+# Command ComboBox::_unmapliste
+# ----------------------------------------------------------------------------
+proc ComboBox::_unmapliste { path {refocus 1} } {
+ # On aqua, state is zoomed, otherwise normal
+ if {[winfo exists $path.shell] && \
+ ( [string equal [wm state $path.shell] "normal"] ||
+ [string equal [wm state $path.shell] "zoomed"] ) } {
+ if {! $Widget::_aqua } {
+ BWidget::grab release $path
+ BWidget::focus release $path.shell.listb $refocus
+ # Update now because otherwise [focus -force...] makes the app hang!
+ if {$refocus} {
+ update
+ focus -force $path.e
+ }
+ }
+ wm withdraw $path.shell
+ ArrowButton::configure $path.a -relief raised
+ }
+}
+
+
+# ----------------------------------------------------------------------------
+# Command ComboBox::_select
+# ----------------------------------------------------------------------------
+proc ComboBox::_select { path index } {
+ set index [$path.shell.listb index $index]
+ _unmapliste $path
+ if { $index != -1 } {
+ if { [setvalue $path @$index] } {
+ set cmd [Widget::getMegawidgetOption $path -modifycmd]
+ if {[llength $cmd]} {
+ uplevel \#0 $cmd
+ }
+ }
+ }
+ $path.e selection clear
+ if {[$path.e cget -exportselection]} {
+ $path.e selection range 0 end
+ }
+}
+
+
+# ----------------------------------------------------------------------------
+# Command ComboBox::_modify_value
+# ----------------------------------------------------------------------------
+proc ComboBox::_modify_value { path direction } {
+ if {[setvalue $path $direction]
+ && [llength [set cmd [Widget::getMegawidgetOption $path -modifycmd]]]} {
+ uplevel \#0 $cmd
+ }
+}
+
+# ----------------------------------------------------------------------------
+# Command ComboBox::_expand
+# ----------------------------------------------------------------------------
+proc ComboBox::_expand {path} {
+ set values [Widget::getMegawidgetOption $path -values]
+ if {![llength $values]} {
+ bell
+ return 0
+ }
+
+ set found {}
+ set curval [Entry::cget $path.e -text]
+ set curlen [$path.e index insert]
+ if {$curlen < [string length $curval]} {
+ # we are somewhere in the middle of a string.
+ # if the full value matches some string in the listbox,
+ # reorder values to start matching after that string.
+ set idx [lsearch -exact $values $curval]
+ if {$idx >= 0} {
+ set values [concat [lrange $values [expr {$idx+1}] end] \
+ [lrange $values 0 $idx]]
+ }
+ }
+ if {$curlen == 0} {
+ set found $values
+ } else {
+ foreach val $values {
+ if {[string equal -length $curlen $curval $val]} {
+ lappend found $val
+ }
+ }
+ }
+ if {[llength $found]} {
+ Entry::configure $path.e -text [lindex $found 0]
+ if {[llength $found] > 1} {
+ set best [_best_match $found [string range $curval 0 $curlen]]
+ set blen [string length $best]
+ $path.e icursor $blen
+ $path.e selection range $blen end
+ }
+ } else {
+ bell
+ }
+ return [llength $found]
+}
+
+# best_match --
+# finds the best unique match in a list of names
+# The extra $e in this argument allows us to limit the innermost loop a
+# little further.
+# Arguments:
+# l list to find best unique match in
+# e currently best known unique match
+# Returns:
+# longest unique match in the list
+#
+proc ComboBox::_best_match {l {e {}}} {
+ set ec [lindex $l 0]
+ if {[llength $l]>1} {
+ set e [string length $e]; incr e -1
+ set ei [string length $ec]; incr ei -1
+ foreach l $l {
+ while {$ei>=$e && [string first $ec $l]} {
+ set ec [string range $ec 0 [incr ei -1]]
+ }
+ }
+ }
+ return $ec
+}
+# possibly faster
+#proc match {string1 string2} {
+# set i 1
+# while {[string equal -length $i $string1 $string2]} { incr i }
+# return [string range $string1 0 [expr {$i-2}]]
+#}
+#proc matchlist {list} {
+# set list [lsort $list]
+# return [match [lindex $list 0] [lindex $list end]]
+#}
+
+
+# ----------------------------------------------------------------------------
+# Command ComboBox::_traverse_in
+# Called when widget receives keyboard focus due to keyboard traversal.
+# ----------------------------------------------------------------------------
+proc ComboBox::_traverse_in { path } {
+ if {[$path.e selection present] != 1} {
+ # Autohighlight the selection, but not if one existed
+ $path.e selection range 0 end
+ }
+}
+
+
+# ----------------------------------------------------------------------------
+# Command ComboBox::_focus_out
+# ----------------------------------------------------------------------------
+proc ComboBox::_focus_out { path } {
+ if {[string first $path [focus]] != 0} {
+ # we lost focus to some other app or window, so remove the listbox
+ return [_unmapliste $path 0]
+ }
+}
+
+proc ComboBox::_auto_complete { path key } {
+ ## Any key string with more than one character and is not entirely
+ ## lower-case is considered a function key and is thus ignored.
+ if {[string length $key] > 1 && [string tolower $key] != $key} { return }
+
+ set text [string map [list {[} {\[} {]} {\]}] [$path.e get]]
+ if {[string equal $text ""]} { return }
+ set values [Widget::cget $path -values]
+ set x [lsearch $values $text*]
+ if {$x < 0} { return }
+
+ set idx [$path.e index insert]
+ $path.e configure -text [lindex $values $x]
+ $path.e icursor $idx
+ $path.e select range insert end
+}
+
+proc ComboBox::_auto_post { path key } {
+ if {[string equal $key "Escape"] || [string equal $key "Return"]} {
+ _unmapliste $path
+ return
+ }
+ if {[catch {$path.shell.listb curselection} x] || $x == ""} {
+ if {[string equal $key "Up"]} {
+ _unmapliste $path
+ return
+ }
+ set x -1
+ }
+ if {([string length $key] > 1 && [string tolower $key] != $key) && \
+ [string equal $key "BackSpace"] != 0 && \
+ [string equal $key "Up"] != 0 && \
+ [string equal $key "Down"] != 0} {
+ return
+ }
+
+ # post the listbox
+ _create_popup $path
+ set width [Widget::cget $path -listboxwidth]
+ if {!$width} { set width [winfo width $path] }
+ BWidget::place $path.shell $width 0 below $path
+ wm deiconify $path.shell
+ BWidget::grab release $path
+ BWidget::focus release $path.shell.listb 1
+ focus -force $path.e
+
+ set values [Widget::cget $path -values]
+ switch -- $key {
+ Up {
+ if {[incr x -1] < 0} {
+ set x 0
+ } else {
+ Entry::configure $path.e -text [lindex $values $x]
+ }
+ }
+ Down {
+ if {[incr x] >= [llength $values]} {
+ set x [expr {[llength $values] - 1}]
+ } else {
+ Entry::configure $path.e -text [lindex $values $x]
+ }
+ }
+ default {
+ # auto-select within the listbox the item closest to the entry's value
+ set text [string map [list {[} {\[} {]} {\]}] [$path.e get]]
+ if {[string equal $text ""]} {
+ set x 0
+ } else {
+ set x [lsearch $values $text*]
+ }
+ }
+ }
+
+ if {$x >= 0} {
+ $path.shell.listb selection clear 0 end
+ $path.shell.listb selection set $x
+ $path.shell.listb see $x
+ }
+}
+# ------------------------------------------------------------------------------
+# Command ComboBox::_destroy
+# ------------------------------------------------------------------------------
+proc ComboBox::_destroy { path } {
+ variable _index
+ Widget::destroy $path
+ unset _index($path)
+}
