1# ---------------------------------------------------------------------------- 2# combobox.tcl 3# This file is part of Unifix BWidget Toolkit 4# $Id: combobox.tcl,v 1.46 2009/09/10 19:23:15 oberdorfer Exp $ 5# ---------------------------------------------------------------------------- 6# Index of commands: 7# - ComboBox::create 8# - ComboBox::configure 9# - ComboBox::cget 10# - ComboBox::setvalue 11# - ComboBox::getvalue 12# - ComboBox::clearvalue 13# - ComboBox::hottrackMotion 14# - ComboBox::_create_popup 15# - ComboBox::_mapliste 16# - ComboBox::_unmapliste 17# - ComboBox::_select 18# - ComboBox::_modify_value 19# - ComboBox::_themechanged 20# ---------------------------------------------------------------------------- 21 22# ComboBox uses the 8.3 -listvariable listbox option 23package require Tk 8.3 24 25namespace eval ComboBox { 26 Widget::define ComboBox combobox ArrowButton Entry ListBox 27 28 Widget::tkinclude ComboBox frame :cmd \ 29 include {-relief -borderwidth -bd -background} \ 30 initialize {-relief sunken -borderwidth 2} 31 32 Widget::bwinclude ComboBox Entry .e \ 33 remove {-relief -bd -borderwidth -bg} \ 34 rename {-background -entrybg} 35 36 Widget::declare ComboBox { 37 {-background Color "SystemWindow" 0} 38 {-height TkResource 0 0 listbox} 39 {-values String "" 0} 40 {-images String "" 0} 41 {-indents String "" 0} 42 {-modifycmd String "" 0} 43 {-postcommand String "" 0} 44 {-expand Enum none 0 {none tab}} 45 {-autocomplete Boolean 0 0} 46 {-autopost Boolean 0 0} 47 {-bwlistbox Boolean 0 0} 48 {-listboxwidth Int 0 0} 49 {-hottrack Boolean 0 0} 50 } 51 52 Widget::addmap ComboBox ArrowButton .a { 53 -background {} -foreground {} -disabledforeground {} -state {} 54 } 55 56 Widget::syncoptions ComboBox Entry .e {-text {}} 57 58 ::bind BwComboBox <FocusIn> [list after idle {BWidget::refocus %W %W.e}] 59 ::bind BwComboBox <Destroy> [list ComboBox::_destroy %W] 60 61 ::bind ListBoxHotTrack <Motion> \ 62 [list after idle {ComboBox::hottrackMotion %W %x %y}] 63 64 if {[lsearch [bindtags .] ComboBoxThemeChanged] < 0} { 65 bindtags . [linsert [bindtags .] 1 ComboBoxThemeChanged] 66 } 67 68 variable _index 69} 70 71 72# johann: -bug fixed- 73# after idle should fix the problem with very long listbox text items 74# which causes under certain circumstances the hole desktop to crash 75# happens under AIX5.3 and CDE, running under tcl/Tk 8.4.7, 76 77proc ComboBox::hottrackMotion { w x y } { 78 $w selection clear 0 end 79 $w activate @$x,$y 80 $w selection set @$x,$y 81} 82 83 84# ComboBox::create -- 85# 86# Create a combobox widget with the given options. 87# 88# Arguments: 89# path name of the new widget. 90# args optional arguments to the widget. 91# 92# Results: 93# path name of the new widget. 94 95proc ComboBox::create { path args } { 96 array set maps [list ComboBox {} :cmd {} .e {} .a {}] 97 array set maps [Widget::parseArgs ComboBox $args] 98 99 eval [list frame $path] $maps(:cmd) \ 100 [list -highlightthickness 0 -takefocus 0 -class ComboBox] 101 Widget::initFromODB ComboBox $path $maps(ComboBox) 102 103 bindtags $path [list $path BwComboBox [winfo toplevel $path] all] 104 105 set entry [eval [list Entry::create $path.e] $maps(.e) \ 106 [list -relief flat -borderwidth 0 -takefocus 1]] 107 108 ::bind $path.e <FocusOut> [list $path _focus_out] 109 ::bind $path <<TraverseIn>> [list $path _traverse_in] 110 111 if {[Widget::cget $path -autocomplete]} { 112 ::bind $path.e <KeyRelease> [list $path _auto_complete %K] 113 } 114 115 if {[Widget::cget $path -autopost]} { 116 ::bind $path.e <KeyRelease> +[list $path _auto_post %K] 117 } else { 118 ::bind $entry <Key-Up> [list ComboBox::_unmapliste $path] 119 ::bind $entry <Key-Down> [list ComboBox::_mapliste $path] 120 } 121 122 if {[string equal [tk windowingsystem] "x11"]} { 123 set ipadx 0 124 set width 11 125 } else { 126 set ipadx 2 127 set width 15 128 } 129 set height [winfo reqheight $entry] 130 set arrow [eval [list ArrowButton::create $path.a] $maps(.a) \ 131 [list -width $width -height $height \ 132 -highlightthickness 0 -borderwidth 1 -takefocus 0 \ 133 -dir bottom -type button -ipadx $ipadx \ 134 -command [list ComboBox::_mapliste $path] \ 135 ]] 136 137 pack $arrow -side right -fill y 138 pack $entry -side left -fill both -expand yes 139 140 set editable [Widget::cget $path -editable] 141 Entry::configure $path.e -editable $editable 142 if {$editable} { 143 ::bind $entry <ButtonPress-1> [list ComboBox::_unmapliste $path] 144 } else { 145 ::bind $entry <ButtonPress-1> [list ArrowButton::invoke $path.a] 146 if { ![string equal [Widget::cget $path -state] "disabled"] } { 147 Entry::configure $path.e -takefocus 1 148 } 149 } 150 151 ::bind $path <ButtonPress-1> [list ComboBox::_unmapliste $path] 152 ::bind $entry <Control-Up> [list ComboBox::_modify_value $path previous] 153 ::bind $entry <Control-Down> [list ComboBox::_modify_value $path next] 154 ::bind $entry <Control-Prior> [list ComboBox::_modify_value $path first] 155 ::bind $entry <Control-Next> [list ComboBox::_modify_value $path last] 156 157 ::bind ComboBoxThemeChanged <<ThemeChanged>> \ 158 "+ [namespace current]::_themechanged $path" 159 160 if {$editable} { 161 set expand [Widget::cget $path -expand] 162 if {[string equal "tab" $expand]} { 163 # Expand entry value on Tab (from -values) 164 ::bind $entry <Tab> "[list ComboBox::_expand $path]; break" 165 } elseif {[string equal "auto" $expand]} { 166 # Expand entry value anytime (from -values) 167 #::bind $entry <Key> "[list ComboBox::_expand $path]; break" 168 } 169 } 170 171 ## If we have images, we have to use a BWidget ListBox. 172 set bw [Widget::cget $path -bwlistbox] 173 if {[llength [Widget::cget $path -images]]} { 174 Widget::configure $path [list -bwlistbox 1] 175 } else { 176 Widget::configure $path [list -bwlistbox $bw] 177 } 178 179 set ComboBox::_index($path) -1 180 181 return [Widget::create ComboBox $path] 182} 183 184 185# ComboBox::configure -- 186# 187# Configure subcommand for ComboBox widgets. Works like regular 188# widget configure command. 189# 190# Arguments: 191# path Name of the ComboBox widget. 192# args Additional optional arguments: 193# ?-option? 194# ?-option value ...? 195# 196# Results: 197# Depends on arguments. If no arguments are given, returns a complete 198# list of configuration information. If one argument is given, returns 199# the configuration information for that option. If more than one 200# argument is given, returns nothing. 201 202proc ComboBox::configure { path args } { 203 set res [Widget::configure $path $args] 204 set entry $path.e 205 206 if { [Widget::hasChanged $path -background bg] } { 207 $path:cmd configure -background $bg 208 } 209 210 set list [list -images -values -bwlistbox -hottrack -autocomplete -autopost] 211 foreach {ci cv cb ch cac cap} [eval [linsert $list 0 Widget::hasChangedX $path]] { break } 212 213 if { $ci } { 214 set images [Widget::cget $path -images] 215 if {[llength $images]} { 216 Widget::configure $path [list -bwlistbox 1] 217 } else { 218 Widget::configure $path [list -bwlistbox 0] 219 } 220 } 221 222 ## If autocomplete toggled, turn bindings on/off 223 if { $cac } { 224 if {[Widget::cget $path -autocomplete]} { 225 ::bind $entry <KeyRelease> +[list $path _auto_complete %K] 226 } else { 227 set bindings [split [::bind $entry <KeyRelease>] \n] 228 if {[set idx [lsearch $bindings [list $path _auto_complete %K]]] != -1} { 229 ::bind $entry <KeyRelease> [join [lreplace $bindings $idx $idx] \n] 230 } 231 } 232 } 233 234 ## If autopost toggled, turn bindings on/off 235 if { $cap } { 236 if {[Widget::cget $path -autopost]} { 237 ::bind $entry <KeyRelease> +[list $path _auto_post %K] 238 set bindings [split [::bind $entry <Key-Up>] \n] 239 if {[set idx [lsearch $bindings [list ComboBox::_unmapliste $path]]] != -1} { 240 ::bind $entry <Key-Up> [join [lreplace $bindings $idx $idx] \n] 241 } 242 set bindings [split [::bind $entry <Key-Down>] \n] 243 if {[set idx [lsearch $bindings [list ComboBox::_mapliste $path]]] != -1} { 244 ::bind $entry <Key-Down> [join [lreplace $bindings $idx $idx] \n] 245 } 246 } else { 247 set bindings [split [::bind $entry <KeyRelease>] \n] 248 if {[set idx [lsearch $bindings [list $path _auto_post %K]]] != -1} { 249 ::bind $entry <KeyRelease> [join [lreplace $bindings $idx $idx] \n] 250 } 251 ::bind $entry <Key-Up> +[list ComboBox::_unmapliste $path] 252 ::bind $entry <Key-Down> +[list ComboBox::_mapliste $path] 253 } 254 } 255 256 set bw [Widget::cget $path -bwlistbox] 257 258 ## If the images, bwlistbox, hottrack or values have changed, 259 ## destroy the shell so that it will re-create itself the next 260 ## time around. 261 if { $ci || $cb || $ch || ($bw && $cv) } { 262 destroy $path.shell 263 } 264 265 set chgedit [Widget::hasChangedX $path -editable] 266 if {$chgedit} { 267 if {[Widget::cget $path -editable]} { 268 ::bind $entry <ButtonPress-1> [list ComboBox::_unmapliste $path] 269 Entry::configure $entry -editable true 270 } else { 271 ::bind $entry <ButtonPress-1> [list ArrowButton::invoke $path.a] 272 Entry::configure $entry -editable false 273 274 # Make sure that non-editable comboboxes can still be tabbed to. 275 276 if { ![string equal [Widget::cget $path -state] "disabled"] } { 277 Entry::configure $entry -takefocus 1 278 } 279 } 280 } 281 282 if {$chgedit || [Widget::hasChangedX $path -expand]} { 283 # Unset what we may have created. 284 ::bind $entry <Tab> {} 285 if {[Widget::cget $path -editable]} { 286 set expand [Widget::cget $path -expand] 287 if {[string equal "tab" $expand]} { 288 # Expand entry value on Tab (from -values) 289 ::bind $entry <Tab> "[list ComboBox::_expand $path]; break" 290 } elseif {[string equal "auto" $expand]} { 291 # Expand entry value anytime (from -values) 292 #::bind $entry <Key> "[list ComboBox::_expand $path]; break" 293 } 294 } 295 } 296 297 # if state changed to normal and -editable false, the edit must take focus 298 if { [Widget::hasChangedX $path -state] \ 299 && ![string equal [Widget::cget $path -state] "disabled"] \ 300 && ![Widget::cget $path -editable] } { 301 Entry::configure $entry -takefocus 1 302 } 303 304 # if the dropdown listbox is shown, simply force the actual entry 305 # colors into it. If it is not shown, the next time the dropdown 306 # is shown it'll get the actual colors anyway 307 if {[winfo exists $path.shell.listb]} { 308 $path.shell.listb configure \ 309 -bg [Widget::cget $path -entrybg] \ 310 -fg [Widget::cget $path -foreground] \ 311 -selectbackground [Widget::cget $path -selectbackground] \ 312 -selectforeground [Widget::cget $path -selectforeground] 313 } 314 315 return $res 316} 317 318 319# ---------------------------------------------------------------------------- 320# Command ComboBox::cget 321# ---------------------------------------------------------------------------- 322proc ComboBox::cget { path option } { 323 return [Widget::cget $path $option] 324} 325 326 327# ---------------------------------------------------------------------------- 328# Command ComboBox::setvalue 329# ---------------------------------------------------------------------------- 330proc ComboBox::setvalue { path index } { 331 variable _index 332 333 set values [Widget::getMegawidgetOption $path -values] 334 set value [Entry::cget $path.e -text] 335 switch -- $index { 336 next { 337 if { [set idx [lsearch -exact $values $value]] != -1 } { 338 incr idx 339 } else { 340 set idx [lsearch -exact $values "$value*"] 341 } 342 } 343 previous { 344 if { [set idx [lsearch -exact $values $value]] != -1 } { 345 incr idx -1 346 } else { 347 set idx [lsearch -exact $values "$value*"] 348 } 349 } 350 first { 351 set idx 0 352 } 353 last { 354 set idx [expr {[llength $values]-1}] 355 } 356 default { 357 if { [string index $index 0] == "@" } { 358 set idx [string range $index 1 end] 359 if { ![string is integer -strict $idx] } { 360 return -code error "bad index \"$index\"" 361 } 362 } else { 363 return -code error "bad index \"$index\"" 364 } 365 } 366 } 367 if { $idx >= 0 && $idx < [llength $values] } { 368 set newval [lindex $values $idx] 369 set _index($path) $idx 370 Entry::configure $path.e -text $newval 371 return 1 372 } 373 return 0 374} 375 376 377proc ComboBox::icursor { path idx } { 378 return [$path.e icursor $idx] 379} 380 381 382proc ComboBox::get { path } { 383 return [$path.e get] 384} 385 386 387# ---------------------------------------------------------------------------- 388# Command ComboBox::getvalue 389# ---------------------------------------------------------------------------- 390proc ComboBox::getvalue { path } { 391 variable _index 392 set values [Widget::getMegawidgetOption $path -values] 393 set value [Entry::cget $path.e -text] 394 # Check if an index was saved by the last setvalue operation 395 # If this index still matches it is returned 396 # This is necessary for the case when values is not unique 397 if { $_index($path) >= 0 \ 398 && $_index($path) < [llength $values] \ 399 && $value eq [lindex $values $_index($path)]} { 400 return $_index($path) 401 } 402 403 return [lsearch -exact $values $value] 404} 405 406 407proc ComboBox::getlistbox { path } { 408 _create_popup $path 409 return $path.shell.listb 410} 411 412 413# ---------------------------------------------------------------------------- 414# Command ComboBox::post 415# ---------------------------------------------------------------------------- 416proc ComboBox::post { path } { 417 _mapliste $path 418 return 419} 420 421 422proc ComboBox::unpost { path } { 423 _unmapliste $path 424 return 425} 426 427 428# ---------------------------------------------------------------------------- 429# Command ComboBox::bind 430# ---------------------------------------------------------------------------- 431proc ComboBox::bind { path args } { 432 return [eval [list ::bind $path.e] $args] 433} 434 435 436proc ComboBox::insert { path idx args } { 437 upvar #0 [Widget::varForOption $path -values] values 438 439 if {[Widget::cget $path -bwlistbox]} { 440 set l [$path getlistbox] 441 set i [eval [linsert $args 0 $l insert $idx #auto]] 442 set text [$l itemcget $i -text] 443 if {$idx == "end"} { 444 lappend values $text 445 } else { 446 set values [linsert $values $idx $text] 447 } 448 } else { 449 set values [eval [list linsert $values $idx] $args] 450 } 451} 452 453# ---------------------------------------------------------------------------- 454# Command ComboBox::clearvalue 455# ---------------------------------------------------------------------------- 456proc ComboBox::clearvalue { path } { 457 Entry::configure $path.e -text "" 458} 459 460# ---------------------------------------------------------------------------- 461# Command ComboBox::_create_popup 462# ---------------------------------------------------------------------------- 463proc ComboBox::_create_popup { path } { 464 set shell $path.shell 465 466 if {[winfo exists $shell]} { return } 467 468 set lval [Widget::cget $path -values] 469 set h [Widget::cget $path -height] 470 set bw [Widget::cget $path -bwlistbox] 471 472 if { $h <= 0 } { 473 set len [llength $lval] 474 if { $len < 3 } { 475 set h 3 476 } elseif { $len > 10 } { 477 set h 10 478 } else { 479 set h $len 480 } 481 } 482 483 if {[string equal [tk windowingsystem] "x11"]} { 484 set sbwidth 11 485 } else { 486 set sbwidth 15 487 } 488 489 toplevel $shell -relief solid -bd 1 490 wm withdraw $shell 491 wm overrideredirect $shell 1 492 # these commands cause the combobox to behave strangely on OS X 493 if {! $Widget::_aqua } { 494 update idle 495 wm transient $shell [winfo toplevel $path] 496 catch { wm attributes $shell -topmost 1 } 497 } 498 499 set sw [ScrolledWindow $shell.sw -managed 1 -size $sbwidth -ipad 0] 500 501 if {$bw} { 502 set listb [ListBox $shell.listb \ 503 -relief flat -borderwidth 0 -highlightthickness 0 \ 504 -selectmode single -selectfill 1 -autofocus 0 -height $h \ 505 -font [Widget::cget $path -font] \ 506 -bg [Widget::cget $path -entrybg] \ 507 -fg [Widget::cget $path -foreground] \ 508 -selectbackground [Widget::cget $path -selectbackground] \ 509 -selectforeground [Widget::cget $path -selectforeground]] 510 511 set values [Widget::cget $path -values] 512 set images [Widget::cget $path -images] 513 foreach value $values image $images { 514 $listb insert end #auto -text $value -image $image 515 } 516 $listb bindText <1> [list ComboBox::_select $path] 517 $listb bindImage <1> [list ComboBox::_select $path] 518 if {[Widget::cget $path -hottrack]} { 519 $listb bindText <Enter> [list $listb selection set] 520 $listb bindImage <Enter> [list $listb selection set] 521 } 522 } else { 523 set listb [listbox $shell.listb \ 524 -relief flat -borderwidth 0 -highlightthickness 0 \ 525 -exportselection false \ 526 -font [Widget::cget $path -font] \ 527 -height $h \ 528 -bg [Widget::cget $path -entrybg] \ 529 -fg [Widget::cget $path -foreground] \ 530 -selectbackground [Widget::cget $path -selectbackground] \ 531 -selectforeground [Widget::cget $path -selectforeground] \ 532 -listvariable [Widget::varForOption $path -values]] 533 ::bind $listb <ButtonRelease-1> [list ComboBox::_select $path @%x,%y] 534 535 if {[Widget::cget $path -hottrack]} { 536 bindtags $listb [concat [bindtags $listb] ListBoxHotTrack] 537 } 538 } 539 pack $sw -fill both -expand yes 540 $sw setwidget $listb 541 542 ::bind $listb <Return> "ComboBox::_select [list $path] \[$listb curselection\]" 543 ::bind $listb <Escape> [list ComboBox::_unmapliste $path] 544 ::bind $listb <FocusOut> [list ComboBox::_focus_out $path] 545} 546 547 548proc ComboBox::_recreate_popup { path } { 549 variable background 550 variable foreground 551 552 set shell $path.shell 553 set lval [Widget::cget $path -values] 554 set h [Widget::cget $path -height] 555 set bw [Widget::cget $path -bwlistbox] 556 557 if { $h <= 0 } { 558 set len [llength $lval] 559 if { $len < 3 } { 560 set h 3 561 } elseif { $len > 10 } { 562 set h 10 563 } else { 564 set h $len 565 } 566 } 567 568 if { [string equal [tk windowingsystem] "x11"] } { 569 set sbwidth 11 570 } else { 571 set sbwidth 15 572 } 573 574 _create_popup $path 575 576 if {![Widget::cget $path -editable]} { 577 if {[info exists background]} { 578 $path.e configure -bg $background 579 $path.e configure -fg $foreground 580 unset background 581 unset foreground 582 } 583 } 584 585 set listb $shell.listb 586 destroy $shell.sw 587 set sw [ScrolledWindow $shell.sw -managed 1 -size $sbwidth -ipad 0] 588 $listb configure \ 589 -height $h \ 590 -font [Widget::cget $path -font] \ 591 -bg [Widget::cget $path -entrybg] \ 592 -fg [Widget::cget $path -foreground] \ 593 -selectbackground [Widget::cget $path -selectbackground] \ 594 -selectforeground [Widget::cget $path -selectforeground] 595 pack $sw -fill both -expand yes 596 $sw setwidget $listb 597 raise $listb 598} 599 600 601# ---------------------------------------------------------------------------- 602# Command ComboBox::_mapliste 603# ---------------------------------------------------------------------------- 604proc ComboBox::_mapliste { path } { 605 set listb $path.shell.listb 606 if {[winfo exists $path.shell] && 607 [string equal [wm state $path.shell] "normal"]} { 608 _unmapliste $path 609 return 610 } 611 612 if { [Widget::cget $path -state] == "disabled" } { 613 return 614 } 615 if {[llength [set cmd [Widget::getMegawidgetOption $path -postcommand]]]} { 616 uplevel \#0 $cmd 617 } 618 if { ![llength [Widget::getMegawidgetOption $path -values]] } { 619 return 620 } 621 622 _recreate_popup $path 623 624 ArrowButton::configure $path.a -relief sunken 625 update 626 627 set bw [Widget::cget $path -bwlistbox] 628 629 $listb selection clear 0 end 630 set values [Widget::getMegawidgetOption $path -values] 631 set curval [Entry::cget $path.e -text] 632 if { [set idx [lsearch -exact $values $curval]] != -1 || 633 [set idx [lsearch -exact $values "$curval*"]] != -1 } { 634 if {$bw} { 635 set idx [$listb items $idx] 636 } else { 637 $listb activate $idx 638 } 639 $listb selection set $idx 640 $listb see $idx 641 } else { 642 set idx 0 643 if {$bw} { 644 set idx [$listb items 0] 645 } else { 646 $listb activate $idx 647 } 648 $listb selection set $idx 649 $listb see $idx 650 } 651 652 set width [Widget::cget $path -listboxwidth] 653 if {!$width} { set width [winfo width $path] } 654 BWidget::place $path.shell $width 0 below $path 655 wm deiconify $path.shell 656 raise $path.shell 657 BWidget::focus set $listb 658 if {! $Widget::_aqua } { 659 BWidget::grab global $path 660 } 661} 662 663 664# ---------------------------------------------------------------------------- 665# Command ComboBox::_unmapliste 666# ---------------------------------------------------------------------------- 667proc ComboBox::_unmapliste { path {refocus 1} } { 668 # On aqua, state is zoomed, otherwise normal 669 if {[winfo exists $path.shell] && \ 670 ( [string equal [wm state $path.shell] "normal"] || 671 [string equal [wm state $path.shell] "zoomed"] ) } { 672 if {! $Widget::_aqua } { 673 BWidget::grab release $path 674 BWidget::focus release $path.shell.listb $refocus 675 # Update now because otherwise [focus -force...] makes the app hang! 676 if {$refocus} { 677 update 678 focus -force $path.e 679 } 680 } 681 wm withdraw $path.shell 682 ArrowButton::configure $path.a -relief raised 683 } 684} 685 686 687# ---------------------------------------------------------------------------- 688# Command ComboBox::_select 689# ---------------------------------------------------------------------------- 690proc ComboBox::_select { path index } { 691 set index [$path.shell.listb index $index] 692 _unmapliste $path 693 if { $index != -1 } { 694 if { [setvalue $path @$index] } { 695 set cmd [Widget::getMegawidgetOption $path -modifycmd] 696 if {[llength $cmd]} { 697 uplevel \#0 $cmd 698 } 699 } 700 } 701 $path.e selection clear 702 if {[$path.e cget -exportselection]} { 703 $path.e selection range 0 end 704 } 705} 706 707 708# ---------------------------------------------------------------------------- 709# Command ComboBox::_modify_value 710# ---------------------------------------------------------------------------- 711proc ComboBox::_modify_value { path direction } { 712 if {[setvalue $path $direction] 713 && [llength [set cmd [Widget::getMegawidgetOption $path -modifycmd]]]} { 714 uplevel \#0 $cmd 715 } 716} 717 718# ---------------------------------------------------------------------------- 719# Command ComboBox::_expand 720# ---------------------------------------------------------------------------- 721proc ComboBox::_expand {path} { 722 set values [Widget::getMegawidgetOption $path -values] 723 if {![llength $values]} { 724 bell 725 return 0 726 } 727 728 set found {} 729 set curval [Entry::cget $path.e -text] 730 set curlen [$path.e index insert] 731 if {$curlen < [string length $curval]} { 732 # we are somewhere in the middle of a string. 733 # if the full value matches some string in the listbox, 734 # reorder values to start matching after that string. 735 set idx [lsearch -exact $values $curval] 736 if {$idx >= 0} { 737 set values [concat [lrange $values [expr {$idx+1}] end] \ 738 [lrange $values 0 $idx]] 739 } 740 } 741 if {$curlen == 0} { 742 set found $values 743 } else { 744 foreach val $values { 745 if {[string equal -length $curlen $curval $val]} { 746 lappend found $val 747 } 748 } 749 } 750 if {[llength $found]} { 751 Entry::configure $path.e -text [lindex $found 0] 752 if {[llength $found] > 1} { 753 set best [_best_match $found [string range $curval 0 $curlen]] 754 set blen [string length $best] 755 $path.e icursor $blen 756 $path.e selection range $blen end 757 } 758 } else { 759 bell 760 } 761 return [llength $found] 762} 763 764# best_match -- 765# finds the best unique match in a list of names 766# The extra $e in this argument allows us to limit the innermost loop a 767# little further. 768# Arguments: 769# l list to find best unique match in 770# e currently best known unique match 771# Returns: 772# longest unique match in the list 773# 774proc ComboBox::_best_match {l {e {}}} { 775 set ec [lindex $l 0] 776 if {[llength $l]>1} { 777 set e [string length $e]; incr e -1 778 set ei [string length $ec]; incr ei -1 779 foreach l $l { 780 while {$ei>=$e && [string first $ec $l]} { 781 set ec [string range $ec 0 [incr ei -1]] 782 } 783 } 784 } 785 return $ec 786} 787# possibly faster 788#proc match {string1 string2} { 789# set i 1 790# while {[string equal -length $i $string1 $string2]} { incr i } 791# return [string range $string1 0 [expr {$i-2}]] 792#} 793#proc matchlist {list} { 794# set list [lsort $list] 795# return [match [lindex $list 0] [lindex $list end]] 796#} 797 798 799# ---------------------------------------------------------------------------- 800# Command ComboBox::_traverse_in 801# Called when widget receives keyboard focus due to keyboard traversal. 802# ---------------------------------------------------------------------------- 803proc ComboBox::_traverse_in { path } { 804 if {[$path.e selection present] != 1} { 805 # Autohighlight the selection, but not if one existed 806 $path.e selection range 0 end 807 } 808} 809 810 811# ---------------------------------------------------------------------------- 812# Command ComboBox::_focus_out 813# ---------------------------------------------------------------------------- 814proc ComboBox::_focus_out { path } { 815 if {[string first $path [focus]] != 0} { 816 # we lost focus to some other app or window, so remove the listbox 817 return [_unmapliste $path 0] 818 } 819} 820 821proc ComboBox::_auto_complete { path key } { 822 ## Any key string with more than one character and is not entirely 823 ## lower-case is considered a function key and is thus ignored. 824 if {[string length $key] > 1 && [string tolower $key] != $key} { return } 825 826 set text [string map [list {[} {\[} {]} {\]}] [$path.e get]] 827 if {[string equal $text ""]} { return } 828 set values [Widget::cget $path -values] 829 set x [lsearch $values $text*] 830 if {$x < 0} { return } 831 832 set idx [$path.e index insert] 833 $path.e configure -text [lindex $values $x] 834 $path.e icursor $idx 835 $path.e select range insert end 836} 837 838proc ComboBox::_auto_post { path key } { 839 if {[string equal $key "Escape"] || [string equal $key "Return"]} { 840 _unmapliste $path 841 return 842 } 843 if {[catch {$path.shell.listb curselection} x] || $x == ""} { 844 if {[string equal $key "Up"]} { 845 _unmapliste $path 846 return 847 } 848 set x -1 849 } 850 if {([string length $key] > 1 && [string tolower $key] != $key) && \ 851 [string equal $key "BackSpace"] != 0 && \ 852 [string equal $key "Up"] != 0 && \ 853 [string equal $key "Down"] != 0} { 854 return 855 } 856 857 # post the listbox 858 _create_popup $path 859 set width [Widget::cget $path -listboxwidth] 860 if {!$width} { set width [winfo width $path] } 861 BWidget::place $path.shell $width 0 below $path 862 wm deiconify $path.shell 863 BWidget::grab release $path 864 BWidget::focus release $path.shell.listb 1 865 focus -force $path.e 866 867 set values [Widget::cget $path -values] 868 switch -- $key { 869 Up { 870 if {[incr x -1] < 0} { 871 set x 0 872 } else { 873 Entry::configure $path.e -text [lindex $values $x] 874 } 875 } 876 Down { 877 if {[incr x] >= [llength $values]} { 878 set x [expr {[llength $values] - 1}] 879 } else { 880 Entry::configure $path.e -text [lindex $values $x] 881 } 882 } 883 default { 884 # auto-select within the listbox the item closest to the entry's value 885 set text [string map [list {[} {\[} {]} {\]}] [$path.e get]] 886 if {[string equal $text ""]} { 887 set x 0 888 } else { 889 set x [lsearch $values $text*] 890 } 891 } 892 } 893 894 if {$x >= 0} { 895 $path.shell.listb selection clear 0 end 896 $path.shell.listb selection set $x 897 $path.shell.listb see $x 898 } 899} 900# ------------------------------------------------------------------------------ 901# Command ComboBox::_destroy 902# ------------------------------------------------------------------------------ 903proc ComboBox::_destroy { path } { 904 variable _index 905 Widget::destroy $path 906 unset _index($path) 907} 908 909 910# ---------------------------------------------------------------------------- 911# Command ComboBox::_themechanged 912# ---------------------------------------------------------------------------- 913proc ComboBox::_themechanged { path } { 914 if { ![winfo exists $path] } { return } 915 BWidget::set_themedefaults 916 $path configure -background $BWidget::colors(SystemWindow) 917} 918