diff options
Diffstat (limited to 'packages/combobox.tcl')
-rw-r--r-- | packages/combobox.tcl | 764 |
1 files changed, 764 insertions, 0 deletions
diff --git a/packages/combobox.tcl b/packages/combobox.tcl new file mode 100644 index 0000000..247b55f --- /dev/null +++ b/packages/combobox.tcl @@ -0,0 +1,764 @@ +# 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 <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 $::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 <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] + } + + 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 <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 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 <Enter> [list $listb selection set] + $listb bindImage <Enter> [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 <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] \[%W 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 { $::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 + } +} |