1# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*- 2# 3# $Id: ComboBox.tcl,v 1.9 2008/02/28 22:39:13 hobbs Exp $ 4# 5# tixCombobox -- 6# 7# A combobox widget is basically a listbox widget with an entry 8# widget. 9# 10# 11# Copyright (c) 1993-1999 Ioi Kim Lam. 12# Copyright (c) 2000-2001 Tix Project Group. 13# Copyright (c) 2004 ActiveState 14# 15# See the file "license.terms" for information on usage and redistribution 16# of this file, and for a DISCLAIMER OF ALL WARRANTIES. 17 18global tkPriv 19if {![llength [info globals tkPriv]]} { 20 tk::unsupported::ExposePrivateVariable tkPriv 21} 22#-------------------------------------------------------------------------- 23# tkPriv elements used in this file: 24# 25# afterId - Token returned by "after" for autoscanning. 26#-------------------------------------------------------------------------- 27# 28foreach fun {tkCancelRepeat tkListboxUpDown tkButtonUp} { 29 if {![llength [info commands $fun]]} { 30 tk::unsupported::ExposePrivateCommand $fun 31 } 32} 33unset fun 34 35tixWidgetClass tixComboBox { 36 -classname TixComboBox 37 -superclass tixLabelWidget 38 -method { 39 addhistory align appendhistory flash invoke insert pick popdown 40 } 41 -flag { 42 -anchor -arrowbitmap -browsecmd -command -crossbitmap 43 -disablecallback -disabledforeground -dropdown -editable 44 -fancy -grab -histlimit -historylimit -history -listcmd 45 -listwidth -prunehistory -selection -selectmode -state 46 -tickbitmap -validatecmd -value -variable 47 } 48 -static { 49 -dropdown -fancy 50 } 51 -forcecall { 52 -variable -selectmode -state 53 } 54 -configspec { 55 {-arrowbitmap arrowBitmap ArrowBitmap ""} 56 {-anchor anchor Anchor w} 57 {-browsecmd browseCmd BrowseCmd ""} 58 {-command command Command ""} 59 {-crossbitmap crossBitmap CrossBitmap ""} 60 {-disablecallback disableCallback DisableCallback 0 tixVerifyBoolean} 61 {-disabledforeground disabledForeground DisabledForeground #606060} 62 {-dropdown dropDown DropDown true tixVerifyBoolean} 63 {-editable editable Editable false tixVerifyBoolean} 64 {-fancy fancy Fancy false tixVerifyBoolean} 65 {-grab grab Grab global} 66 {-listcmd listCmd ListCmd ""} 67 {-listwidth listWidth ListWidth ""} 68 {-historylimit historyLimit HistoryLimit ""} 69 {-history history History false tixVerifyBoolean} 70 {-prunehistory pruneHistory PruneHistory true tixVerifyBoolean} 71 {-selectmode selectMode SelectMode browse} 72 {-selection selection Selection ""} 73 {-state state State normal} 74 {-validatecmd validateCmd ValidateCmd ""} 75 {-value value Value ""} 76 {-variable variable Variable ""} 77 {-tickbitmap tickBitmap TickBitmap ""} 78 } 79 -alias { 80 {-histlimit -historylimit} 81 } 82 -default { 83 {*Entry.relief sunken} 84 {*TixScrolledListBox.scrollbar auto} 85 {*Listbox.exportSelection false} 86 {*Listbox.takeFocus false} 87 {*shell.borderWidth 2} 88 {*shell.relief raised} 89 {*shell.cursor arrow} 90 {*Button.anchor c} 91 {*Button.borderWidth 1} 92 {*Button.highlightThickness 0} 93 {*Button.padX 0} 94 {*Button.padY 0} 95 {*tick.width 18} 96 {*tick.height 18} 97 {*cross.width 18} 98 {*cross.height 18} 99 {*arrow.anchor c} 100 {*arrow.width 15} 101 {*arrow.height 18} 102 } 103} 104 105# States: normal numbers: for dropdown style 106# d+digit(s) : for non-dropdown style 107# 108proc tixComboBox:InitWidgetRec {w} { 109 upvar #0 $w data 110 111 tixChainMethod $w InitWidgetRec 112 113 set data(curIndex) "" 114 set data(varInited) 0 115 set data(state) none 116 set data(ignore) 0 117 118 if {$data(-history)} { 119 set data(-editable) 1 120 } 121 122 if {$data(-arrowbitmap) eq ""} { 123 set data(-arrowbitmap) [tix getbitmap cbxarrow] 124 } 125 if {$data(-crossbitmap) eq ""} { 126 set data(-crossbitmap) [tix getbitmap cross] 127 } 128 if {$data(-tickbitmap) eq ""} { 129 set data(-tickbitmap) [tix getbitmap tick] 130 } 131} 132 133proc tixComboBox:ConstructFramedWidget {w frame} { 134 upvar #0 $w data 135 136 tixChainMethod $w ConstructFramedWidget $frame 137 138 if {$data(-dropdown)} { 139 tixComboBox:ConstructEntryFrame $w $frame 140 tixComboBox:ConstructListShell $w 141 } else { 142 set f1 [frame $frame.f1] 143 set f2 [frame $frame.f2] 144 145 tixComboBox:ConstructEntryFrame $w $f1 146 tixComboBox:ConstructListFrame $w $f2 147 pack $f1 -side top -pady 2 -fill x 148 pack $f2 -side top -pady 2 -fill both -expand yes 149 } 150} 151 152proc tixComboBox:ConstructEntryFrame {w frame} { 153 upvar #0 $w data 154 155 # (1) The entry 156 # 157 set data(w:entry) [entry $frame.entry] 158 159 if {!$data(-editable)} { 160 set bg [$w cget -bg] 161 $data(w:entry) config -bg $bg -state disabled -takefocus 1 162 } 163 164 # This is used during "config-state" 165 # 166 set data(entryfg) [$data(w:entry) cget -fg] 167 168 # (2) The dropdown button, not necessary when not in dropdown mode 169 # 170 set data(w:arrow) [button $frame.arrow -bitmap $data(-arrowbitmap)] 171 if {!$data(-dropdown)} { 172 set xframe [frame $frame.xframe -width 19] 173 } 174 175 # (3) The fancy tick and cross buttons 176 # 177 if {$data(-fancy)} { 178 if {$data(-editable)} { 179 set data(w:cross) [button $frame.cross -bitmap $data(-crossbitmap)] 180 set data(w:tick) [button $frame.tick -bitmap $data(-tickbitmap)] 181 182 pack $frame.cross -side left -padx 1 183 pack $frame.tick -side left -padx 1 184 } else { 185 set data(w:tick) [button $frame.tick -bitmap $data(-tickbitmap)] 186 pack $frame.tick -side left -padx 1 187 } 188 } 189 190 if {$data(-dropdown)} { 191 pack $data(w:arrow) -side right -padx 1 192 foreach wid [list $data(w:frame) $data(w:label)] { 193 tixAddBindTag $wid TixComboWid 194 tixSetMegaWidget $wid $w TixComboBox 195 } 196 } else { 197 pack $xframe -side right -padx 1 198 } 199 pack $frame.entry -side right -fill x -expand yes -padx 1 200} 201 202proc tixComboBox:ConstructListShell {w} { 203 upvar #0 $w data 204 205 # Create the shell and the list 206 #------------------------------ 207 set data(w:shell) [menu $w.shell -bd 2 -relief raised -tearoff 0] 208 wm overrideredirect $data(w:shell) 1 209 wm withdraw $data(w:shell) 210 211 set data(w:slistbox) [tixScrolledListBox $data(w:shell).slistbox \ 212 -anchor $data(-anchor) -scrollbarspace y \ 213 -options {listbox.selectMode "browse"}] 214 215 set data(w:listbox) [$data(w:slistbox) subwidget listbox] 216 217 pack $data(w:slistbox) -expand yes -fill both -padx 2 -pady 2 218} 219 220proc tixComboBox:ConstructListFrame {w frame} { 221 upvar #0 $w data 222 223 set data(w:slistbox) [tixScrolledListBox $frame.slistbox \ 224 -anchor $data(-anchor)] 225 226 set data(w:listbox) [$data(w:slistbox) subwidget listbox] 227 228 pack $data(w:slistbox) -expand yes -fill both 229} 230 231 232proc tixComboBox:SetBindings {w} { 233 upvar #0 $w data 234 235 tixChainMethod $w SetBindings 236 237 # (1) Fix the bindings for the combobox 238 # 239 bindtags $w [list $w TixComboBox [winfo toplevel $w] all] 240 241 # (2) The entry subwidget 242 # 243 tixSetMegaWidget $data(w:entry) $w TixComboBox 244 245 bindtags $data(w:entry) [list $data(w:entry) Entry TixComboEntry\ 246 TixComboWid [winfo toplevel $data(w:entry)] all] 247 248 # (3) The listbox and slistbox 249 # 250 $data(w:slistbox) config -browsecmd \ 251 [list tixComboBox:LbBrowse $w] 252 $data(w:slistbox) config -command\ 253 [list tixComboBox:LbCommand $w] 254 $data(w:listbox) config -takefocus 0 255 256 tixAddBindTag $data(w:listbox) TixComboLb 257 tixAddBindTag $data(w:slistbox) TixComboLb 258 tixSetMegaWidget $data(w:listbox) $w TixComboBox 259 tixSetMegaWidget $data(w:slistbox) $w TixComboBox 260 261 # (4) The buttons 262 # 263 if {$data(-dropdown)} { 264 $data(w:arrow) config -takefocus 0 265 tixAddBindTag $data(w:arrow) TixComboArrow 266 tixSetMegaWidget $data(w:arrow) $w TixComboBox 267 268 bind $data(w:root) <1> [list tixComboBox:RootDown $w] 269 bind $data(w:root) <ButtonRelease-1> [list tixComboBox:RootUp $w] 270 } 271 272 if {$data(-fancy)} { 273 if {$data(-editable)} { 274 $data(w:cross) config -command [list tixComboBox:CrossBtn $w] \ 275 -takefocus 0 276 } 277 $data(w:tick) config -command [list tixComboBox:Invoke $w] -takefocus 0 278 } 279 280 if {$data(-dropdown)} { 281 set data(state) 0 282 } else { 283 set data(state) n0 284 } 285} 286 287proc tixComboBoxBind {} { 288 #---------------------------------------------------------------------- 289 # The class bindings for the TixComboBox 290 # 291 tixBind TixComboBox <Escape> { 292 if {[tixComboBox:EscKey %W]} { 293 break 294 } 295 } 296 tixBind TixComboBox <Configure> { 297 tixWidgetDoWhenIdle tixComboBox:align %W 298 } 299 # Only the two "linear" detail_fields are for tabbing (moving) among 300 # widgets inside the same toplevel. Other detail_fields are sort 301 # of irrelevant 302 # 303 tixBind TixComboBox <FocusOut> { 304 if {[string equal %d NotifyNonlinear] || 305 [string equal %d NotifyNonlinearVirtual]} { 306 307 if {[info exists %W(cancelTab)]} { 308 unset %W(cancelTab) 309 } else { 310 if {[set %W(-state)] ne "disabled"} { 311 if {[set %W(-selection)] ne [set %W(-value)]} { 312 tixComboBox:Invoke %W 313 } 314 } 315 } 316 } 317 } 318 tixBind TixComboBox <FocusIn> { 319 if {"%d" eq "NotifyNonlinear" || "%d" eq "NotifyNonlinearVirtual"} { 320 focus [%W subwidget entry] 321 322 # CYGNUS: Setting the selection if there is no data 323 # causes backspace to misbehave. 324 if {[[set %W(w:entry)] get] ne ""} { 325 [set %W(w:entry)] selection from 0 326 [set %W(w:entry)] selection to end 327 } 328 329 } 330 } 331 332 #---------------------------------------------------------------------- 333 # The class tixBindings for the arrow button widget inside the TixComboBox 334 # 335 336 tixBind TixComboArrow <1> { 337 tixComboBox:ArrowDown [tixGetMegaWidget %W TixComboBox] 338 } 339 tixBind TixComboArrow <ButtonRelease-1> { 340 tixComboBox:ArrowUp [tixGetMegaWidget %W TixComboBox] 341 } 342 tixBind TixComboArrow <Escape> { 343 if {[tixComboBox:EscKey [tixGetMegaWidget %W TixComboBox]]} { 344 break 345 } 346 } 347 348 349 #---------------------------------------------------------------------- 350 # The class tixBindings for the entry widget inside the TixComboBox 351 # 352 tixBind TixComboEntry <Up> { 353 tixComboBox:EntDirKey [tixGetMegaWidget %W TixComboBox] up 354 } 355 tixBind TixComboEntry <Down> { 356 tixComboBox:EntDirKey [tixGetMegaWidget %W TixComboBox] down 357 } 358 tixBind TixComboEntry <Prior> { 359 tixComboBox:EntDirKey [tixGetMegaWidget %W TixComboBox] pageup 360 } 361 tixBind TixComboEntry <Next> { 362 tixComboBox:EntDirKey [tixGetMegaWidget %W TixComboBox] pagedown 363 } 364 tixBind TixComboEntry <Return> { 365 tixComboBox:EntReturnKey [tixGetMegaWidget %W TixComboBox] 366 } 367 tixBind TixComboEntry <KeyPress> { 368 tixComboBox:EntKeyPress [tixGetMegaWidget %W TixComboBox] 369 } 370 tixBind TixComboEntry <Escape> { 371 if {[tixComboBox:EscKey [tixGetMegaWidget %W TixComboBox]]} { 372 break 373 } 374 } 375 tixBind TixComboEntry <Tab> { 376 if {[set [tixGetMegaWidget %W TixComboBox](-state)] ne "disabled"} { 377 if {[tixComboBox:EntTab [tixGetMegaWidget %W TixComboBox]]} { 378 break 379 } 380 } 381 } 382 tixBind TixComboEntry <1> { 383 if {[set [tixGetMegaWidget %W TixComboBox](-state)] ne "disabled"} { 384 focus %W 385 } 386 } 387 tixBind TixComboEntry <ButtonRelease-2> { 388 tixComboBox:EntKeyPress [tixGetMegaWidget %W TixComboBox] 389 } 390 391 #---------------------------------------------------------------------- 392 # The class bindings for the listbox subwidget 393 # 394 395 tixBind TixComboWid <Escape> { 396 if {[tixComboBox:EscKey [tixGetMegaWidget %W TixComboBox]]} { 397 break 398 } 399 } 400 401 #---------------------------------------------------------------------- 402 # The class bindings for some widgets inside ComboBox 403 # 404 tixBind TixComboWid <ButtonRelease-1> { 405 tixComboBox:WidUp [tixGetMegaWidget %W TixComboBox] 406 } 407 tixBind TixComboWid <Escape> { 408 if {[tixComboBox:EscKey [tixGetMegaWidget %W TixComboBox]]} { 409 break 410 } 411 } 412} 413 414#---------------------------------------------------------------------- 415# Cooked events 416#---------------------------------------------------------------------- 417proc tixComboBox:ArrowDown {w} { 418 upvar #0 $w data 419 420 if {$data(-state) eq "disabled"} { 421 return 422 } 423 424 switch -exact -- $data(state) { 425 0 { tixComboBox:GoState 1 $w } 426 2 { tixComboBox:GoState 19 $w } 427 default { tixComboBox:StateError $w } 428 } 429} 430 431proc tixComboBox:ArrowUp {w} { 432 upvar #0 $w data 433 434 switch -exact -- $data(state) { 435 1 { tixComboBox:GoState 2 $w } 436 19 { 437 # data(ignore) was already set in state 19 438 tixComboBox:GoState 4 $w 439 } 440 5 { tixComboBox:GoState 13 $w } 441 default { tixComboBox:StateError $w } 442 } 443} 444 445proc tixComboBox:RootDown {w} { 446 upvar #0 $w data 447 448 switch -exact -- $data(state) { 449 0 { 450 # Ignore 451 } 452 2 { tixComboBox:GoState 3 $w } 453 default { tixComboBox:StateError $w } 454 } 455} 456 457proc tixComboBox:RootUp {w} { 458 upvar #0 $w data 459 460 switch -exact -- $data(state) { 461 {1} { 462 tixComboBox:GoState 12 $w 463 } 464 {3} { 465 # data(ignore) was already set in state 3 466 tixComboBox:GoState 4 $w 467 } 468 {5} { 469 tixComboBox:GoState 7 $w 470 } 471 default { 472 tixComboBox:StateError $w 473 } 474 } 475} 476 477proc tixComboBox:WidUp {w} { 478 upvar #0 $w data 479 480 switch -exact -- $data(state) { 481 {1} { 482 tixComboBox:GoState 12 $w 483 } 484 {5} { 485 tixComboBox:GoState 13 $w 486 } 487 } 488} 489 490proc tixComboBox:LbBrowse {w args} { 491 upvar #0 $w data 492 493 set event [tixEvent type] 494 set x [tixEvent flag x] 495 set y [tixEvent flag y] 496 set X [tixEvent flag X] 497 set Y [tixEvent flag Y] 498 499 if {$data(-state) eq "disabled"} { return } 500 501 switch -exact -- $event { 502 <1> { 503 case $data(state) { 504 {2} { 505 tixComboBox:GoState 5 $w $x $y $X $Y 506 } 507 {5} { 508 tixComboBox:GoState 5 $w $x $y $X $Y 509 } 510 {n0} { 511 tixComboBox:GoState n6 $w $x $y $X $Y 512 } 513 default { 514 tixComboBox:StateError $w 515 } 516 } 517 } 518 <ButtonRelease-1> { 519 case $data(state) { 520 {5} { 521 tixComboBox:GoState 6 $w $x $y $X $Y 522 } 523 {n6} { 524 tixComboBox:GoState n0 $w 525 } 526 default { 527 tixComboBox:StateError $w 528 } 529 } 530 } 531 default { 532 # Must be a motion event 533 case $data(state) { 534 {1} { 535 tixComboBox:GoState 9 $w $x $y $X $Y 536 } 537 {5} { 538 tixComboBox:GoState 5 $w $x $y $X $Y 539 } 540 {n6} { 541 tixComboBox:GoState n6 $w $x $y $X $Y 542 } 543 default { 544 tixComboBox:StateError $w 545 } 546 } 547 } 548 } 549} 550 551proc tixComboBox:LbCommand {w} { 552 upvar #0 $w data 553 554 if {$data(state) eq "n0"} { 555 tixComboBox:GoState n1 $w 556 } 557} 558 559#---------------------------------------------------------------------- 560# General keyboard event 561 562# returns 1 if the combobox is in some special state and the Escape key 563# shouldn't be handled by the toplevel bind tag. As a result, when a combobox 564# is popped up in a dialog box, Escape will popdown the combo. If the combo 565# is not popped up, Escape will invoke the toplevel bindtag (which can 566# pop down the dialog box) 567# 568proc tixComboBox:EscKey {w} { 569 upvar #0 $w data 570 571 if {$data(-state) eq "disabled"} { return 0 } 572 573 switch -exact -- $data(state) { 574 {0} { 575 tixComboBox:GoState 17 $w 576 } 577 {2} { 578 tixComboBox:GoState 16 $w 579 return 1 580 } 581 {n0} { 582 tixComboBox:GoState n4 $w 583 } 584 default { 585 # ignore 586 return 1 587 } 588 } 589 590 return 0 591} 592 593#---------------------------------------- 594# Keyboard events 595#---------------------------------------- 596proc tixComboBox:EntDirKey {w dir} { 597 upvar #0 $w data 598 599 if {$data(-state) eq "disabled"} { return } 600 601 switch -exact -- $data(state) { 602 {0} { 603 tixComboBox:GoState 10 $w $dir 604 } 605 {2} { 606 tixComboBox:GoState 11 $w $dir 607 } 608 {5} { 609 # ignore 610 } 611 {n0} { 612 tixComboBox:GoState n3 $w $dir 613 } 614 } 615} 616 617proc tixComboBox:EntReturnKey {w} { 618 upvar #0 $w data 619 620 if {$data(-state) eq "disabled"} { return } 621 622 switch -exact -- $data(state) { 623 {0} { 624 tixComboBox:GoState 14 $w 625 } 626 {2} { 627 tixComboBox:GoState 15 $w 628 } 629 {5} { 630 # ignore 631 } 632 {n0} { 633 tixComboBox:GoState n1 $w 634 } 635 } 636} 637 638# Return 1 == break from the binding == no keyboard focus traversal 639proc tixComboBox:EntTab {w} { 640 upvar #0 $w data 641 642 switch -exact -- $data(state) { 643 {0} { 644 tixComboBox:GoState 14 $w 645 set data(cancelTab) "" 646 return 0 647 } 648 {2} { 649 tixComboBox:GoState 15 $w 650 set data(cancelTab) "" 651 return 0 652 } 653 {n0} { 654 tixComboBox:GoState n1 $w 655 set data(cancelTab) "" 656 return 0 657 } 658 default { 659 return 1 660 } 661 } 662} 663 664proc tixComboBox:EntKeyPress {w} { 665 upvar #0 $w data 666 667 if {$data(-state) eq "disabled" || !$data(-editable)} { return } 668 669 switch -exact -- $data(state) { 670 0 - 2 - n0 { 671 tixComboBox:ClearListboxSelection $w 672 tixComboBox:SetSelection $w [$data(w:entry) get] 0 0 673 } 674 } 675} 676 677#---------------------------------------------------------------------- 678 679proc tixComboBox:HandleDirKey {w dir} { 680 upvar #0 $w data 681 682 if {[tixComboBox:CheckListboxSelection $w]} { 683 switch -exact -- $dir { 684 "up" { 685 tkListboxUpDown $data(w:listbox) -1 686 set data(curIndex) [lindex [$data(w:listbox) curselection] 0] 687 tixComboBox:SetSelectionFromListbox $w 688 } 689 "down" { 690 tkListboxUpDown $data(w:listbox) 1 691 set data(curIndex) [lindex [$data(w:listbox) curselection] 0] 692 tixComboBox:SetSelectionFromListbox $w 693 } 694 "pageup" { 695 $data(w:listbox) yview scroll -1 pages 696 } 697 "pagedown" { 698 $data(w:listbox) yview scroll 1 pages 699 } 700 } 701 } else { 702 # There wasn't good selection in the listbox. 703 # 704 tixComboBox:SetSelectionFromListbox $w 705 } 706} 707 708proc tixComboBox:Invoke {w} { 709 upvar #0 $w data 710 711 tixComboBox:SetValue $w $data(-selection) 712 if {![winfo exists $w]} { 713 return 714 } 715 716 if {$data(-history)} { 717 tixComboBox:addhistory $w $data(-value) 718 set data(curIndex) 0 719 } 720 $data(w:entry) selection from 0 721 $data(w:entry) selection to end 722 $data(w:entry) icursor end 723} 724 725#---------------------------------------------------------------------- 726# MAINTAINING THE -VALUE 727#---------------------------------------------------------------------- 728proc tixComboBox:SetValue {w newValue {noUpdate 0} {updateEnt 1}} { 729 upvar #0 $w data 730 731 if {[llength $data(-validatecmd)]} { 732 set data(-value) [tixEvalCmdBinding $w $data(-validatecmd) "" $newValue] 733 } else { 734 set data(-value) $newValue 735 } 736 737 if {! $noUpdate} { 738 tixVariable:UpdateVariable $w 739 } 740 741 if {$updateEnt} { 742 if {!$data(-editable)} { 743 $data(w:entry) delete 0 end 744 $data(w:entry) insert 0 $data(-value) 745 } 746 } 747 748 if {!$data(-disablecallback) && [llength $data(-command)]} { 749 if {![info exists data(varInited)]} { 750 set bind(specs) {%V} 751 set bind(%V) $data(-value) 752 753 tixEvalCmdBinding $w $data(-command) bind $data(-value) 754 if {![winfo exists $w]} { 755 # The user destroyed the window! 756 return 757 } 758 } 759 } 760 761 set data(-selection) $data(-value) 762 if {$updateEnt} { 763 tixSetEntry $data(w:entry) $data(-value) 764 765 if {$data(-anchor) eq "e"} { 766 tixComboBox:EntryAlignEnd $w 767 } 768 } 769} 770 771# markSel: should the all the text in the entry be highlighted? 772# 773proc tixComboBox:SetSelection {w value {markSel 1} {setent 1}} { 774 upvar #0 $w data 775 776 if {$setent} { 777 tixSetEntry $data(w:entry) $value 778 } 779 set data(-selection) $value 780 781 if {$data(-selectmode) eq "browse"} { 782 if {$markSel} { 783 $data(w:entry) selection range 0 end 784 } 785 if {[llength $data(-browsecmd)]} { 786 set bind(specs) {%V} 787 set bind(%V) [$data(w:entry) get] 788 tixEvalCmdBinding $w $data(-browsecmd) bind [$data(w:entry) get] 789 } 790 } else { 791 tixComboBox:SetValue $w $value 0 0 792 } 793} 794 795proc tixComboBox:ClearListboxSelection {w} { 796 upvar #0 $w data 797 798 if {![winfo exists $data(w:listbox)]} { 799 tixDebug "tixComboBox:ClearListboxSelection error non-existent $data(w:listbox)" 800 return 801 } 802 803 $data(w:listbox) selection clear 0 end 804} 805 806proc tixComboBox:UpdateListboxSelection {w index} { 807 upvar #0 $w data 808 809 if {![winfo exists $data(w:listbox)]} { 810 tixDebug "tixComboBox:UpdateListboxSelection error non-existent $data(w:listbox)" 811 return 812 } 813 if {$index != ""} { 814 $data(w:listbox) selection set $index 815 $data(w:listbox) selection anchor $index 816 } 817} 818 819 820proc tixComboBox:Cancel {w} { 821 upvar #0 $w data 822 823 tixSetEntry $data(w:entry) $data(-value) 824 tixComboBox:SetSelection $w $data(-value) 825 826 if {[tixComboBox:LbGetSelection $w] ne $data(-selection)} { 827 tixComboBox:ClearListboxSelection $w 828 } 829} 830 831proc tixComboBox:flash {w} { 832 tixComboBox:BlinkEntry $w 833} 834 835# Make the entry blink when the user selects a choice 836# 837proc tixComboBox:BlinkEntry {w} { 838 upvar #0 $w data 839 840 if {![info exists data(entryBlacken)]} { 841 set old_bg [$data(w:entry) cget -bg] 842 set old_fg [$data(w:entry) cget -fg] 843 844 $data(w:entry) config -fg $old_bg 845 $data(w:entry) config -bg $old_fg 846 847 set data(entryBlacken) 1 848 after 50 tixComboBox:RestoreBlink $w [list $old_bg] [list $old_fg] 849 } 850} 851 852proc tixComboBox:RestoreBlink {w old_bg old_fg} { 853 upvar #0 $w data 854 855 if {[info exists data(w:entry)] && [winfo exists $data(w:entry)]} { 856 $data(w:entry) config -fg $old_fg 857 $data(w:entry) config -bg $old_bg 858 } 859 860 if {[info exists data(entryBlacken)]} { 861 unset data(entryBlacken) 862 } 863} 864 865#---------------------------------------- 866# Handle events inside the list box 867#---------------------------------------- 868 869proc tixComboBox:LbIndex {w {flag ""}} { 870 upvar #0 $w data 871 872 if {![winfo exists $data(w:listbox)]} { 873 tixDebug "tixComboBox:LbIndex error non-existent $data(w:listbox)" 874 if {$flag eq "emptyOK"} { 875 return "" 876 } else { 877 return 0 878 } 879 } 880 set sel [lindex [$data(w:listbox) curselection] 0] 881 if {$sel != ""} { 882 return $sel 883 } else { 884 if {$flag eq "emptyOK"} { 885 return "" 886 } else { 887 return 0 888 } 889 } 890} 891 892#---------------------------------------------------------------------- 893# 894# STATE MANIPULATION 895# 896#---------------------------------------------------------------------- 897proc tixComboBox:GoState-0 {w} { 898 upvar #0 $w data 899 900 if {[info exists data(w:root)] && [grab current] eq "$data(w:root)"} { 901 grab release $w 902 } 903} 904 905proc tixComboBox:GoState-1 {w} { 906 upvar #0 $w data 907 908 tixComboBox:Popup $w 909} 910 911proc tixComboBox:GoState-2 {w} { 912 upvar #0 $w data 913 914} 915 916proc tixComboBox:GoState-3 {w} { 917 upvar #0 $w data 918 919 set data(ignore) 1 920 tixComboBox:Popdown $w 921} 922 923proc tixComboBox:GoState-4 {w} { 924 upvar #0 $w data 925 926 tixComboBox:Ungrab $w 927 if {$data(ignore)} { 928 tixComboBox:Cancel $w 929 } else { 930 tixComboBox:Invoke $w 931 } 932 tixComboBox:GoState 0 $w 933} 934 935proc tixComboBox:GoState-5 {w x y X Y} { 936 upvar #0 $w data 937 938 tixComboBox:LbSelect $w $x $y $X $Y 939} 940 941proc tixComboBox:GoState-6 {w x y X Y} { 942 upvar #0 $w data 943 944 tixComboBox:Popdown $w 945 946 if {[tixWithinWindow $data(w:shell) $X $Y]} { 947 set data(ignore) 0 948 } else { 949 set data(ignore) 1 950 } 951 952 tixComboBox:GoState 4 $w 953} 954 955proc tixComboBox:GoState-7 {w} { 956 upvar #0 $w data 957 958 tixComboBox:Popdown $w 959 set data(ignore) 1 960 catch { 961 global tkPriv 962 if {$tkPriv(afterId) != ""} { 963 tkCancelRepeat 964 } 965 } 966 967 set data(ignore) 1 968 tixComboBox:GoState 4 $w 969} 970 971proc tixComboBox:GoState-9 {w x y X Y} { 972 upvar #0 $w data 973 974 catch { 975 tkButtonUp $data(w:arrow) 976 } 977 tixComboBox:GoState 5 $w $x $y $X $Y 978} 979 980proc tixComboBox:GoState-10 {w dir} { 981 upvar #0 $w data 982 983 tixComboBox:Popup $w 984 if {![tixComboBox:CheckListboxSelection $w]} { 985 # There wasn't good selection in the listbox. 986 # 987 tixComboBox:SetSelectionFromListbox $w 988 } 989 990 tixComboBox:GoState 2 $w 991} 992 993proc tixComboBox:GoState-11 {w dir} { 994 upvar #0 $w data 995 996 tixComboBox:HandleDirKey $w $dir 997 998 tixComboBox:GoState 2 $w 999} 1000 1001proc tixComboBox:GoState-12 {w} { 1002 upvar #0 $w data 1003 1004 catch { 1005 tkButtonUp $data(w:arrow) 1006 } 1007 1008 tixComboBox:GoState 2 $w 1009} 1010 1011proc tixComboBox:GoState-13 {w} { 1012 upvar #0 $w data 1013 1014 catch { 1015 global tkPriv 1016 if {$tkPriv(afterId) != ""} { 1017 tkCancelRepeat 1018 } 1019 } 1020 tixComboBox:GoState 2 $w 1021} 1022 1023proc tixComboBox:GoState-14 {w} { 1024 upvar #0 $w data 1025 1026 tixComboBox:Invoke $w 1027 tixComboBox:GoState 0 $w 1028} 1029 1030proc tixComboBox:GoState-15 {w} { 1031 upvar #0 $w data 1032 1033 tixComboBox:Popdown $w 1034 set data(ignore) 0 1035 tixComboBox:GoState 4 $w 1036} 1037 1038proc tixComboBox:GoState-16 {w} { 1039 upvar #0 $w data 1040 1041 tixComboBox:Popdown $w 1042 tixComboBox:Cancel $w 1043 set data(ignore) 1 1044 tixComboBox:GoState 4 $w 1045} 1046 1047proc tixComboBox:GoState-17 {w} { 1048 upvar #0 $w data 1049 1050 tixComboBox:Cancel $w 1051 tixComboBox:GoState 0 $w 1052} 1053 1054proc tixComboBox:GoState-19 {w} { 1055 upvar #0 $w data 1056 1057 set data(ignore) [string equal $data(-selection) $data(-value)] 1058 tixComboBox:Popdown $w 1059} 1060 1061#---------------------------------------------------------------------- 1062# Non-dropdown states 1063#---------------------------------------------------------------------- 1064proc tixComboBox:GoState-n0 {w} { 1065 upvar #0 $w data 1066} 1067 1068proc tixComboBox:GoState-n1 {w} { 1069 upvar #0 $w data 1070 1071 tixComboBox:Invoke $w 1072 tixComboBox:GoState n0 $w 1073} 1074 1075proc tixComboBox:GoState-n3 {w dir} { 1076 upvar #0 $w data 1077 1078 tixComboBox:HandleDirKey $w $dir 1079 tixComboBox:GoState n0 $w 1080} 1081 1082proc tixComboBox:GoState-n4 {w} { 1083 upvar #0 $w data 1084 1085 tixComboBox:Cancel $w 1086 tixComboBox:GoState n0 $w 1087} 1088 1089proc tixComboBox:GoState-n6 {w x y X Y} { 1090 upvar #0 $w data 1091 1092 tixComboBox:LbSelect $w $x $y $X $Y 1093} 1094 1095#---------------------------------------------------------------------- 1096# General State Manipulation 1097#---------------------------------------------------------------------- 1098proc tixComboBox:GoState {s w args} { 1099 upvar #0 $w data 1100 1101 tixComboBox:SetState $w $s 1102 eval tixComboBox:GoState-$s $w $args 1103} 1104 1105proc tixComboBox:SetState {w s} { 1106 upvar #0 $w data 1107 1108# catch {puts [info level -2]} 1109# puts "setting state $data(state) --> $s" 1110 set data(state) $s 1111} 1112 1113proc tixComboBox:StateError {w} { 1114 upvar #0 $w data 1115 1116# error "wrong state $data(state)" 1117} 1118 1119#---------------------------------------------------------------------- 1120# Listbox handling 1121#---------------------------------------------------------------------- 1122 1123# Set a selection if there isn't one. Returns true if there was already 1124# a good selection inside the listbox 1125# 1126proc tixComboBox:CheckListboxSelection {w} { 1127 upvar #0 $w data 1128 1129 if {![winfo exists $data(w:listbox)]} { 1130 tixDebug "tixComboBox:CheckListboxSelection error non-existent $data(w:listbox)" 1131 return 0 1132 } 1133 if {[$data(w:listbox) curselection] == ""} { 1134 if {$data(curIndex) == ""} { 1135 set data(curIndex) 0 1136 } 1137 1138 $data(w:listbox) activate $data(curIndex) 1139 $data(w:listbox) selection clear 0 end 1140 $data(w:listbox) selection set $data(curIndex) 1141 $data(w:listbox) see $data(curIndex) 1142 return 0 1143 } else { 1144 return 1 1145 } 1146} 1147 1148proc tixComboBox:SetSelectionFromListbox {w} { 1149 upvar #0 $w data 1150 1151 set string [$data(w:listbox) get $data(curIndex)] 1152 tixComboBox:SetSelection $w $string 1153 tixComboBox:UpdateListboxSelection $w $data(curIndex) 1154} 1155 1156proc tixComboBox:LbGetSelection {w} { 1157 upvar #0 $w data 1158 set index [tixComboBox:LbIndex $w emptyOK] 1159 1160 if {$index >=0} { 1161 return [$data(w:listbox) get $index] 1162 } else { 1163 return "" 1164 } 1165} 1166 1167proc tixComboBox:LbSelect {w x y X Y} { 1168 upvar #0 $w data 1169 1170 set index [tixComboBox:LbIndex $w emptyOK] 1171 if {$index == ""} { 1172 set index [$data(w:listbox) nearest $y] 1173 } 1174 1175 if {$index >= 0} { 1176 if {[focus -lastfor $data(w:entry)] ne $data(w:entry) && 1177 [focus -lastfor $data(w:entry)] ne $data(w:listbox)} { 1178 focus $data(w:entry) 1179 } 1180 1181 set string [$data(w:listbox) get $index] 1182 tixComboBox:SetSelection $w $string 1183 1184 tixComboBox:UpdateListboxSelection $w $index 1185 } 1186} 1187 1188#---------------------------------------------------------------------- 1189# Internal commands 1190#---------------------------------------------------------------------- 1191proc tixComboBox:CrossBtn {w} { 1192 upvar #0 $w data 1193 1194 $data(w:entry) delete 0 end 1195 tixComboBox:ClearListboxSelection $w 1196 tixComboBox:SetSelection $w "" 1197} 1198 1199#-------------------------------------------------- 1200# Popping up list shell 1201#-------------------------------------------------- 1202 1203# Popup the listbox and grab 1204# 1205# 1206proc tixComboBox:Popup {w} { 1207 global tcl_platform 1208 upvar #0 $w data 1209 1210 if {![winfo ismapped $data(w:root)]} { 1211 return 1212 } 1213 1214 #--------------------------------------------------------------------- 1215 # Pop up 1216 # 1217 if {$data(-listcmd) != ""} { 1218 # This option allows the user to fill in the listbox on demand 1219 # 1220 tixEvalCmdBinding $w $data(-listcmd) 1221 } 1222 1223 # calculate the size 1224 set y [winfo rooty $data(w:entry)] 1225 incr y [winfo height $data(w:entry)] 1226 incr y 3 1227 1228 set bd [$data(w:shell) cget -bd] 1229# incr bd [$data(w:shell) cget -highlightthickness] 1230 set height [expr {[winfo reqheight $data(w:slistbox)] + 2*$bd}] 1231 1232 set x1 [winfo rootx $data(w:entry)] 1233 if {$data(-listwidth) == ""} { 1234 if {[winfo ismapped $data(w:arrow)]} { 1235 set x2 [winfo rootx $data(w:arrow)] 1236 if {$x2 >= $x1} { 1237 incr x2 [winfo width $data(w:arrow)] 1238 set width [expr {$x2 - $x1}] 1239 } else { 1240 set width [winfo width $data(w:entry)] 1241 set x2 [expr {$x1 + $width}] 1242 } 1243 } else { 1244 set width [winfo width $data(w:entry)] 1245 set x2 [expr {$x1 + $width}] 1246 } 1247 } else { 1248 set width $data(-listwidth) 1249 set x2 [expr {$x1 + $width}] 1250 } 1251 1252 set reqwidth [winfo reqwidth $data(w:shell)] 1253 if {$reqwidth < $width} { 1254 set reqwidth $width 1255 } else { 1256 if {$reqwidth > [expr {$width *3}]} { 1257 set reqwidth [expr {$width *3}] 1258 } 1259 if {$reqwidth > [winfo vrootwidth .]} { 1260 set reqwidth [winfo vrootwidth .] 1261 } 1262 } 1263 set width $reqwidth 1264 1265 1266 # If the listbox is too far right, pull it back to the left 1267 # 1268 set scrwidth [winfo vrootwidth .] 1269 if {$x2 > $scrwidth} { 1270 set x1 [expr {$scrwidth - $width}] 1271 } 1272 1273 # If the listbox is too far left, pull it back to the right 1274 # 1275 if {$x1 < 0} { 1276 set x1 0 1277 } 1278 1279 # If the listbox is below bottom of screen, put it upwards 1280 # 1281 set scrheight [winfo vrootheight .] 1282 set bottom [expr {$y+$height}] 1283 if {$bottom > $scrheight} { 1284 set y [expr {$y-$height-[winfo height $data(w:entry)]-5}] 1285 } 1286 1287 # OK , popup the shell 1288 # 1289 global tcl_platform 1290 1291 wm geometry $data(w:shell) $reqwidth\x$height+$x1+$y 1292 if {$tcl_platform(platform) eq "windows"} { 1293 update 1294 } 1295 wm deiconify $data(w:shell) 1296 if {$tcl_platform(platform) eq "windows"} { 1297 update 1298 } 1299 raise $data(w:shell) 1300 focus $data(w:entry) 1301 set data(popped) 1 1302 1303 # add for safety 1304 update 1305 1306 tixComboBox:Grab $w 1307} 1308 1309proc tixComboBox:SetCursor {w cursor} { 1310 upvar #0 $w data 1311 1312 $w config -cursor $cursor 1313} 1314 1315proc tixComboBox:Popdown {w} { 1316 upvar #0 $w data 1317 1318 wm withdraw $data(w:shell) 1319 tixComboBox:SetCursor $w "" 1320} 1321 1322# Grab the server so that user cannot move the windows around 1323proc tixComboBox:Grab {w} { 1324 upvar #0 $w data 1325 1326 tixComboBox:SetCursor $w arrow 1327 if {[catch { 1328 # We catch here because grab may fail under a lot of circumstances 1329 # Just don't want to break the code ... 1330 switch -exact -- $data(-grab) { 1331 global { tixPushGrab -global $data(w:root) } 1332 local { tixPushGrab $data(w:root) } 1333 } 1334 } err]} { 1335 tixDebug "tixComboBox:Grab+: Error grabbing $data(w:root)\n$err" 1336 } 1337} 1338 1339proc tixComboBox:Ungrab {w} { 1340 upvar #0 $w data 1341 1342 if {[catch { 1343 catch { 1344 switch -exact -- $data(-grab) { 1345 global { tixPopGrab } 1346 local { tixPopGrab } 1347 } 1348 } 1349 } err]} { 1350 tixDebug "tixComboBox:Grab+: Error grabbing $data(w:root)\n$err" 1351 } 1352} 1353 1354#---------------------------------------------------------------------- 1355# Alignment 1356#---------------------------------------------------------------------- 1357# The following two routines can emulate a "right align mode" for the 1358# entry in the combo box. 1359 1360proc tixComboBox:EntryAlignEnd {w} { 1361 upvar #0 $w data 1362 $data(w:entry) xview end 1363} 1364 1365 1366proc tixComboBox:Destructor {w} { 1367 upvar #0 $w data 1368 1369 tixUnsetMegaWidget $data(w:entry) 1370 tixVariable:DeleteVariable $w 1371 1372 # Chain this to the superclass 1373 # 1374 tixChainMethod $w Destructor 1375} 1376 1377 1378#---------------------------------------------------------------------- 1379# CONFIG OPTIONS 1380#---------------------------------------------------------------------- 1381 1382proc tixComboBox:config-state {w value} { 1383 upvar #0 $w data 1384 catch {if {[$data(w:arrow) cget -state] eq $value} {set a 1}} 1385 if {[info exists a]} { 1386 return 1387 } 1388 1389 catch {$data(w:arrow) config -state $value} 1390 catch {$data(w:tick) config -state $value} 1391 catch {$data(w:cross) config -state $value} 1392 catch {$data(w:slistbox) config -state $value} 1393 1394 if {[string equal $value normal]} { 1395 set fg [$data(w:arrow) cget -fg] 1396 set entryFg $data(entryfg) 1397 set lbSelFg [lindex [$data(w:listbox) config -selectforeground] 3] 1398 set lbSelBg [lindex [$data(w:listbox) config -selectbackground] 3] 1399 set entrySelFg [lindex [$data(w:entry) config -selectforeground] 3] 1400 set entrySelBg [lindex [$data(w:entry) config -selectbackground] 3] 1401 } else { 1402 set fg [$data(w:arrow) cget -disabledforeground] 1403 set entryFg $data(-disabledforeground) 1404 set lbSelFg $entryFg 1405 set lbSelBg [$data(w:listbox) cget -bg] 1406 set entrySelFg $entryFg 1407 set entrySelBg [$data(w:entry) cget -bg] 1408 } 1409 if {$fg ne ""} { 1410 $data(w:label) config -fg $fg 1411 $data(w:listbox) config -fg $fg -selectforeground $lbSelFg \ 1412 -selectbackground $lbSelBg 1413 } 1414 $data(w:entry) config -fg $entryFg -selectforeground $entrySelFg \ 1415 -selectbackground $entrySelBg 1416 1417 if {$value eq "normal"} { 1418 if {$data(-editable)} { 1419 $data(w:entry) config -state normal 1420 } 1421 $data(w:entry) config -takefocus 1 1422 } else { 1423 if {$data(-editable)} { 1424 $data(w:entry) config -state disabled 1425 } 1426 $data(w:entry) config -takefocus 0 1427 } 1428} 1429 1430proc tixComboBox:config-value {w value} { 1431 upvar #0 $w data 1432 1433 tixComboBox:SetValue $w $value 1434 1435 set data(-selection) $value 1436 1437 if {[tixComboBox:LbGetSelection $w] ne $value} { 1438 tixComboBox:ClearListboxSelection $w 1439 } 1440} 1441 1442proc tixComboBox:config-selection {w value} { 1443 upvar #0 $w data 1444 1445 tixComboBox:SetSelection $w $value 1446 1447 if {[tixComboBox:LbGetSelection $w] ne $value} { 1448 tixComboBox:ClearListboxSelection $w 1449 } 1450} 1451 1452proc tixComboBox:config-variable {w arg} { 1453 upvar #0 $w data 1454 1455 if {[tixVariable:ConfigVariable $w $arg]} { 1456 # The value of data(-value) is changed if tixVariable:ConfigVariable 1457 # returns true 1458 set data(-selection) $data(-value) 1459 tixComboBox:SetValue $w $data(-value) 1 1460 } 1461 catch { 1462 unset data(varInited) 1463 } 1464 set data(-variable) $arg 1465} 1466 1467 1468#---------------------------------------------------------------------- 1469# WIDGET COMMANDS 1470#---------------------------------------------------------------------- 1471proc tixComboBox:align {w args} { 1472 upvar #0 $w data 1473 1474 if {$data(-anchor) eq "e"} { 1475 tixComboBox:EntryAlignEnd $w 1476 } 1477} 1478 1479proc tixComboBox:addhistory {w value} { 1480 upvar #0 $w data 1481 1482 tixComboBox:insert $w 0 $value 1483 $data(w:listbox) selection clear 0 end 1484 1485 if {$data(-prunehistory)} { 1486 # Prune from the end 1487 # 1488 set max [$data(w:listbox) size] 1489 if {$max <= 1} { 1490 return 1491 } 1492 for {set i [expr {$max -1}]} {$i >= 1} {incr i -1} { 1493 if {[$data(w:listbox) get $i] eq $value} { 1494 $data(w:listbox) delete $i 1495 break 1496 } 1497 } 1498 } 1499} 1500 1501proc tixComboBox:appendhistory {w value} { 1502 upvar #0 $w data 1503 1504 tixComboBox:insert $w end $value 1505 $data(w:listbox) selection clear 0 end 1506 1507 if {$data(-prunehistory)} { 1508 # Prune from the end 1509 # 1510 set max [$data(w:listbox) size] 1511 if {$max <= 1} { 1512 return 1513 } 1514 for {set i [expr {$max -2}]} {$i >= 0} {incr i -1} { 1515 if {[$data(w:listbox) get $i] eq $value} { 1516 $data(w:listbox) delete $i 1517 break 1518 } 1519 } 1520 } 1521} 1522 1523proc tixComboBox:insert {w index newitem} { 1524 upvar #0 $w data 1525 1526 $data(w:listbox) insert $index $newitem 1527 1528 if {$data(-history) && $data(-historylimit) != "" 1529 && [$data(w:listbox) size] eq $data(-historylimit)} { 1530 $data(w:listbox) delete 0 1531 } 1532} 1533 1534proc tixComboBox:pick {w index} { 1535 upvar #0 $w data 1536 1537 $data(w:listbox) activate $index 1538 $data(w:listbox) selection clear 0 end 1539 $data(w:listbox) selection set active 1540 $data(w:listbox) see active 1541 set text [$data(w:listbox) get $index] 1542 1543 tixComboBox:SetValue $w $text 1544 1545 set data(curIndex) $index 1546} 1547 1548proc tixComboBox:invoke {w} { 1549 tixComboBox:Invoke $w 1550} 1551 1552proc tixComboBox:popdown {w} { 1553 upvar #0 $w data 1554 1555 if {$data(-dropdown)} { 1556 tixComboBox:Popdown $w 1557 } 1558} 1559