# this file was taken from BWidget 1.8 release namespace eval ComboBox { 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} } } # 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] set entry [eval [list Entry::create $path.e] $maps(.e) \ [list -relief flat -borderwidth 0 -takefocus 1]] ::bind $path.e [list $path _focus_out] ::bind $path <> [list $path _traverse_in] if {[Widget::cget $path -autocomplete]} { ::bind $path.e [list $path _auto_complete %K] } if {[Widget::cget $path -autopost]} { ::bind $path.e +[list $path _auto_post %K] } else { ::bind $entry [list ComboBox::_unmapliste $path] ::bind $entry [list ComboBox::_mapliste $path] } if {[string equal $::tcl_platform(platform) "unix"]} { 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 [list ComboBox::_unmapliste $path] } else { ::bind $entry [list ArrowButton::invoke $path.a] if { ![string equal [Widget::cget $path -state] "disabled"] } { Entry::configure $path.e -takefocus 1 } } ::bind $path [list ComboBox::_unmapliste $path] ::bind $entry [list ComboBox::_modify_value $path previous] ::bind $entry [list ComboBox::_modify_value $path next] ::bind $entry [list ComboBox::_modify_value $path first] ::bind $entry [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 "[list ComboBox::_expand $path]; break" } elseif {[string equal "auto" $expand]} { # Expand entry value anytime (from -values) #::bind $entry "[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] } 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] foreach {ci cv cb ch} [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] } } 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 [list ComboBox::_unmapliste $path] Entry::configure $entry -editable true } else { ::bind $entry [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 {} 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 "[list ComboBox::_expand $path]; break" } elseif {[string equal "auto" $expand]} { # Expand entry value anytime (from -values) #::bind $entry "[list ComboBox::_expand $path]; break" } } } # 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 [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 } { 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] 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 } { set values [Widget::getMegawidgetOption $path -values] set value [Entry::cget $path.e -text] 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::_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 { $::tcl_platform(platform) == "unix" } { set sbwidth 11 } else { set sbwidth 15 } toplevel $shell -relief solid -bd 1 wm withdraw $shell update idle wm overrideredirect $shell 1 wm transient $shell [winfo toplevel $path] catch { wm attributes $shell -topmost 1 } set sw [ScrolledWindow $shell.sw -managed 0 -size $sbwidth -ipad 0] if {$bw} { 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 [list $listb selection set] $listb bindImage [list $listb selection set] } } 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 [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 "ComboBox::_select [list $path] \[%W curselection\]" ::bind $listb [list ComboBox::_unmapliste $path] ::bind $listb [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 { $::tcl_platform(platform) == "unix" } { 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 0 -size $sbwidth -ipad 0] $listb configure \ -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] 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 BWidget::grab global $path } # ---------------------------------------------------------------------------- # Command ComboBox::_unmapliste # ---------------------------------------------------------------------------- proc ComboBox::_unmapliste { path {refocus 1} } { if {[winfo exists $path.shell] && \ [string equal [wm state $path.shell] "normal"]} { 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 $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 } }