1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558 |
- # -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
- #
- # $Id: ComboBox.tcl,v 1.9 2008/02/28 22:39:13 hobbs Exp $
- #
- # tixCombobox --
- #
- # A combobox widget is basically a listbox widget with an entry
- # widget.
- #
- #
- # Copyright (c) 1993-1999 Ioi Kim Lam.
- # Copyright (c) 2000-2001 Tix Project Group.
- # Copyright (c) 2004 ActiveState
- #
- # See the file "license.terms" for information on usage and redistribution
- # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- global tkPriv
- if {![llength [info globals tkPriv]]} {
- tk::unsupported::ExposePrivateVariable tkPriv
- }
- #--------------------------------------------------------------------------
- # tkPriv elements used in this file:
- #
- # afterId - Token returned by "after" for autoscanning.
- #--------------------------------------------------------------------------
- #
- foreach fun {tkCancelRepeat tkListboxUpDown tkButtonUp} {
- if {![llength [info commands $fun]]} {
- tk::unsupported::ExposePrivateCommand $fun
- }
- }
- unset fun
- tixWidgetClass tixComboBox {
- -classname TixComboBox
- -superclass tixLabelWidget
- -method {
- addhistory align appendhistory flash invoke insert pick popdown
- }
- -flag {
- -anchor -arrowbitmap -browsecmd -command -crossbitmap
- -disablecallback -disabledforeground -dropdown -editable
- -fancy -grab -histlimit -historylimit -history -listcmd
- -listwidth -prunehistory -selection -selectmode -state
- -tickbitmap -validatecmd -value -variable
- }
- -static {
- -dropdown -fancy
- }
- -forcecall {
- -variable -selectmode -state
- }
- -configspec {
- {-arrowbitmap arrowBitmap ArrowBitmap ""}
- {-anchor anchor Anchor w}
- {-browsecmd browseCmd BrowseCmd ""}
- {-command command Command ""}
- {-crossbitmap crossBitmap CrossBitmap ""}
- {-disablecallback disableCallback DisableCallback 0 tixVerifyBoolean}
- {-disabledforeground disabledForeground DisabledForeground #606060}
- {-dropdown dropDown DropDown true tixVerifyBoolean}
- {-editable editable Editable false tixVerifyBoolean}
- {-fancy fancy Fancy false tixVerifyBoolean}
- {-grab grab Grab global}
- {-listcmd listCmd ListCmd ""}
- {-listwidth listWidth ListWidth ""}
- {-historylimit historyLimit HistoryLimit ""}
- {-history history History false tixVerifyBoolean}
- {-prunehistory pruneHistory PruneHistory true tixVerifyBoolean}
- {-selectmode selectMode SelectMode browse}
- {-selection selection Selection ""}
- {-state state State normal}
- {-validatecmd validateCmd ValidateCmd ""}
- {-value value Value ""}
- {-variable variable Variable ""}
- {-tickbitmap tickBitmap TickBitmap ""}
- }
- -alias {
- {-histlimit -historylimit}
- }
- -default {
- {*Entry.relief sunken}
- {*TixScrolledListBox.scrollbar auto}
- {*Listbox.exportSelection false}
- {*Listbox.takeFocus false}
- {*shell.borderWidth 2}
- {*shell.relief raised}
- {*shell.cursor arrow}
- {*Button.anchor c}
- {*Button.borderWidth 1}
- {*Button.highlightThickness 0}
- {*Button.padX 0}
- {*Button.padY 0}
- {*tick.width 18}
- {*tick.height 18}
- {*cross.width 18}
- {*cross.height 18}
- {*arrow.anchor c}
- {*arrow.width 15}
- {*arrow.height 18}
- }
- }
- # States: normal numbers: for dropdown style
- # d+digit(s) : for non-dropdown style
- #
- proc tixComboBox:InitWidgetRec {w} {
- upvar #0 $w data
- tixChainMethod $w InitWidgetRec
- set data(curIndex) ""
- set data(varInited) 0
- set data(state) none
- set data(ignore) 0
- if {$data(-history)} {
- set data(-editable) 1
- }
- if {$data(-arrowbitmap) eq ""} {
- set data(-arrowbitmap) [tix getbitmap cbxarrow]
- }
- if {$data(-crossbitmap) eq ""} {
- set data(-crossbitmap) [tix getbitmap cross]
- }
- if {$data(-tickbitmap) eq ""} {
- set data(-tickbitmap) [tix getbitmap tick]
- }
- }
- proc tixComboBox:ConstructFramedWidget {w frame} {
- upvar #0 $w data
- tixChainMethod $w ConstructFramedWidget $frame
- if {$data(-dropdown)} {
- tixComboBox:ConstructEntryFrame $w $frame
- tixComboBox:ConstructListShell $w
- } else {
- set f1 [frame $frame.f1]
- set f2 [frame $frame.f2]
- tixComboBox:ConstructEntryFrame $w $f1
- tixComboBox:ConstructListFrame $w $f2
- pack $f1 -side top -pady 2 -fill x
- pack $f2 -side top -pady 2 -fill both -expand yes
- }
- }
- proc tixComboBox:ConstructEntryFrame {w frame} {
- upvar #0 $w data
- # (1) The entry
- #
- set data(w:entry) [entry $frame.entry]
- if {!$data(-editable)} {
- set bg [$w cget -bg]
- $data(w:entry) config -bg $bg -state disabled -takefocus 1
- }
- # This is used during "config-state"
- #
- set data(entryfg) [$data(w:entry) cget -fg]
- # (2) The dropdown button, not necessary when not in dropdown mode
- #
- set data(w:arrow) [button $frame.arrow -bitmap $data(-arrowbitmap)]
- if {!$data(-dropdown)} {
- set xframe [frame $frame.xframe -width 19]
- }
- # (3) The fancy tick and cross buttons
- #
- if {$data(-fancy)} {
- if {$data(-editable)} {
- set data(w:cross) [button $frame.cross -bitmap $data(-crossbitmap)]
- set data(w:tick) [button $frame.tick -bitmap $data(-tickbitmap)]
- pack $frame.cross -side left -padx 1
- pack $frame.tick -side left -padx 1
- } else {
- set data(w:tick) [button $frame.tick -bitmap $data(-tickbitmap)]
- pack $frame.tick -side left -padx 1
- }
- }
- if {$data(-dropdown)} {
- pack $data(w:arrow) -side right -padx 1
- foreach wid [list $data(w:frame) $data(w:label)] {
- tixAddBindTag $wid TixComboWid
- tixSetMegaWidget $wid $w TixComboBox
- }
- } else {
- pack $xframe -side right -padx 1
- }
- pack $frame.entry -side right -fill x -expand yes -padx 1
- }
- proc tixComboBox:ConstructListShell {w} {
- upvar #0 $w data
- # Create the shell and the list
- #------------------------------
- set data(w:shell) [menu $w.shell -bd 2 -relief raised -tearoff 0]
- wm overrideredirect $data(w:shell) 1
- wm withdraw $data(w:shell)
- set data(w:slistbox) [tixScrolledListBox $data(w:shell).slistbox \
- -anchor $data(-anchor) -scrollbarspace y \
- -options {listbox.selectMode "browse"}]
- set data(w:listbox) [$data(w:slistbox) subwidget listbox]
- pack $data(w:slistbox) -expand yes -fill both -padx 2 -pady 2
- }
- proc tixComboBox:ConstructListFrame {w frame} {
- upvar #0 $w data
- set data(w:slistbox) [tixScrolledListBox $frame.slistbox \
- -anchor $data(-anchor)]
- set data(w:listbox) [$data(w:slistbox) subwidget listbox]
- pack $data(w:slistbox) -expand yes -fill both
- }
- proc tixComboBox:SetBindings {w} {
- upvar #0 $w data
- tixChainMethod $w SetBindings
- # (1) Fix the bindings for the combobox
- #
- bindtags $w [list $w TixComboBox [winfo toplevel $w] all]
- # (2) The entry subwidget
- #
- tixSetMegaWidget $data(w:entry) $w TixComboBox
- bindtags $data(w:entry) [list $data(w:entry) Entry TixComboEntry\
- TixComboWid [winfo toplevel $data(w:entry)] all]
- # (3) The listbox and slistbox
- #
- $data(w:slistbox) config -browsecmd \
- [list tixComboBox:LbBrowse $w]
- $data(w:slistbox) config -command\
- [list tixComboBox:LbCommand $w]
- $data(w:listbox) config -takefocus 0
- tixAddBindTag $data(w:listbox) TixComboLb
- tixAddBindTag $data(w:slistbox) TixComboLb
- tixSetMegaWidget $data(w:listbox) $w TixComboBox
- tixSetMegaWidget $data(w:slistbox) $w TixComboBox
- # (4) The buttons
- #
- if {$data(-dropdown)} {
- $data(w:arrow) config -takefocus 0
- tixAddBindTag $data(w:arrow) TixComboArrow
- tixSetMegaWidget $data(w:arrow) $w TixComboBox
- bind $data(w:root) <1> [list tixComboBox:RootDown $w]
- bind $data(w:root) <ButtonRelease-1> [list tixComboBox:RootUp $w]
- }
- if {$data(-fancy)} {
- if {$data(-editable)} {
- $data(w:cross) config -command [list tixComboBox:CrossBtn $w] \
- -takefocus 0
- }
- $data(w:tick) config -command [list tixComboBox:Invoke $w] -takefocus 0
- }
- if {$data(-dropdown)} {
- set data(state) 0
- } else {
- set data(state) n0
- }
- }
- proc tixComboBoxBind {} {
- #----------------------------------------------------------------------
- # The class bindings for the TixComboBox
- #
- tixBind TixComboBox <Escape> {
- if {[tixComboBox:EscKey %W]} {
- break
- }
- }
- tixBind TixComboBox <Configure> {
- tixWidgetDoWhenIdle tixComboBox:align %W
- }
- # Only the two "linear" detail_fields are for tabbing (moving) among
- # widgets inside the same toplevel. Other detail_fields are sort
- # of irrelevant
- #
- tixBind TixComboBox <FocusOut> {
- if {[string equal %d NotifyNonlinear] ||
- [string equal %d NotifyNonlinearVirtual]} {
- if {[info exists %W(cancelTab)]} {
- unset %W(cancelTab)
- } else {
- if {[set %W(-state)] ne "disabled"} {
- if {[set %W(-selection)] ne [set %W(-value)]} {
- tixComboBox:Invoke %W
- }
- }
- }
- }
- }
- tixBind TixComboBox <FocusIn> {
- if {"%d" eq "NotifyNonlinear" || "%d" eq "NotifyNonlinearVirtual"} {
- focus [%W subwidget entry]
- # CYGNUS: Setting the selection if there is no data
- # causes backspace to misbehave.
- if {[[set %W(w:entry)] get] ne ""} {
- [set %W(w:entry)] selection from 0
- [set %W(w:entry)] selection to end
- }
- }
- }
- #----------------------------------------------------------------------
- # The class tixBindings for the arrow button widget inside the TixComboBox
- #
- tixBind TixComboArrow <1> {
- tixComboBox:ArrowDown [tixGetMegaWidget %W TixComboBox]
- }
- tixBind TixComboArrow <ButtonRelease-1> {
- tixComboBox:ArrowUp [tixGetMegaWidget %W TixComboBox]
- }
- tixBind TixComboArrow <Escape> {
- if {[tixComboBox:EscKey [tixGetMegaWidget %W TixComboBox]]} {
- break
- }
- }
- #----------------------------------------------------------------------
- # The class tixBindings for the entry widget inside the TixComboBox
- #
- tixBind TixComboEntry <Up> {
- tixComboBox:EntDirKey [tixGetMegaWidget %W TixComboBox] up
- }
- tixBind TixComboEntry <Down> {
- tixComboBox:EntDirKey [tixGetMegaWidget %W TixComboBox] down
- }
- tixBind TixComboEntry <Prior> {
- tixComboBox:EntDirKey [tixGetMegaWidget %W TixComboBox] pageup
- }
- tixBind TixComboEntry <Next> {
- tixComboBox:EntDirKey [tixGetMegaWidget %W TixComboBox] pagedown
- }
- tixBind TixComboEntry <Return> {
- tixComboBox:EntReturnKey [tixGetMegaWidget %W TixComboBox]
- }
- tixBind TixComboEntry <KeyPress> {
- tixComboBox:EntKeyPress [tixGetMegaWidget %W TixComboBox]
- }
- tixBind TixComboEntry <Escape> {
- if {[tixComboBox:EscKey [tixGetMegaWidget %W TixComboBox]]} {
- break
- }
- }
- tixBind TixComboEntry <Tab> {
- if {[set [tixGetMegaWidget %W TixComboBox](-state)] ne "disabled"} {
- if {[tixComboBox:EntTab [tixGetMegaWidget %W TixComboBox]]} {
- break
- }
- }
- }
- tixBind TixComboEntry <1> {
- if {[set [tixGetMegaWidget %W TixComboBox](-state)] ne "disabled"} {
- focus %W
- }
- }
- tixBind TixComboEntry <ButtonRelease-2> {
- tixComboBox:EntKeyPress [tixGetMegaWidget %W TixComboBox]
- }
- #----------------------------------------------------------------------
- # The class bindings for the listbox subwidget
- #
- tixBind TixComboWid <Escape> {
- if {[tixComboBox:EscKey [tixGetMegaWidget %W TixComboBox]]} {
- break
- }
- }
- #----------------------------------------------------------------------
- # The class bindings for some widgets inside ComboBox
- #
- tixBind TixComboWid <ButtonRelease-1> {
- tixComboBox:WidUp [tixGetMegaWidget %W TixComboBox]
- }
- tixBind TixComboWid <Escape> {
- if {[tixComboBox:EscKey [tixGetMegaWidget %W TixComboBox]]} {
- break
- }
- }
- }
- #----------------------------------------------------------------------
- # Cooked events
- #----------------------------------------------------------------------
- proc tixComboBox:ArrowDown {w} {
- upvar #0 $w data
- if {$data(-state) eq "disabled"} {
- return
- }
- switch -exact -- $data(state) {
- 0 { tixComboBox:GoState 1 $w }
- 2 { tixComboBox:GoState 19 $w }
- default { tixComboBox:StateError $w }
- }
- }
- proc tixComboBox:ArrowUp {w} {
- upvar #0 $w data
-
- switch -exact -- $data(state) {
- 1 { tixComboBox:GoState 2 $w }
- 19 {
- # data(ignore) was already set in state 19
- tixComboBox:GoState 4 $w
- }
- 5 { tixComboBox:GoState 13 $w }
- default { tixComboBox:StateError $w }
- }
- }
- proc tixComboBox:RootDown {w} {
- upvar #0 $w data
-
- switch -exact -- $data(state) {
- 0 {
- # Ignore
- }
- 2 { tixComboBox:GoState 3 $w }
- default { tixComboBox:StateError $w }
- }
- }
- proc tixComboBox:RootUp {w} {
- upvar #0 $w data
-
- switch -exact -- $data(state) {
- {1} {
- tixComboBox:GoState 12 $w
- }
- {3} {
- # data(ignore) was already set in state 3
- tixComboBox:GoState 4 $w
- }
- {5} {
- tixComboBox:GoState 7 $w
- }
- default {
- tixComboBox:StateError $w
- }
- }
- }
- proc tixComboBox:WidUp {w} {
- upvar #0 $w data
-
- switch -exact -- $data(state) {
- {1} {
- tixComboBox:GoState 12 $w
- }
- {5} {
- tixComboBox:GoState 13 $w
- }
- }
- }
- proc tixComboBox:LbBrowse {w args} {
- upvar #0 $w data
- set event [tixEvent type]
- set x [tixEvent flag x]
- set y [tixEvent flag y]
- set X [tixEvent flag X]
- set Y [tixEvent flag Y]
- if {$data(-state) eq "disabled"} { return }
- switch -exact -- $event {
- <1> {
- case $data(state) {
- {2} {
- tixComboBox:GoState 5 $w $x $y $X $Y
- }
- {5} {
- tixComboBox:GoState 5 $w $x $y $X $Y
- }
- {n0} {
- tixComboBox:GoState n6 $w $x $y $X $Y
- }
- default {
- tixComboBox:StateError $w
- }
- }
- }
- <ButtonRelease-1> {
- case $data(state) {
- {5} {
- tixComboBox:GoState 6 $w $x $y $X $Y
- }
- {n6} {
- tixComboBox:GoState n0 $w
- }
- default {
- tixComboBox:StateError $w
- }
- }
- }
- default {
- # Must be a motion event
- case $data(state) {
- {1} {
- tixComboBox:GoState 9 $w $x $y $X $Y
- }
- {5} {
- tixComboBox:GoState 5 $w $x $y $X $Y
- }
- {n6} {
- tixComboBox:GoState n6 $w $x $y $X $Y
- }
- default {
- tixComboBox:StateError $w
- }
- }
- }
- }
- }
- proc tixComboBox:LbCommand {w} {
- upvar #0 $w data
- if {$data(state) eq "n0"} {
- tixComboBox:GoState n1 $w
- }
- }
- #----------------------------------------------------------------------
- # General keyboard event
- # returns 1 if the combobox is in some special state and the Escape key
- # shouldn't be handled by the toplevel bind tag. As a result, when a combobox
- # is popped up in a dialog box, Escape will popdown the combo. If the combo
- # is not popped up, Escape will invoke the toplevel bindtag (which can
- # pop down the dialog box)
- #
- proc tixComboBox:EscKey {w} {
- upvar #0 $w data
- if {$data(-state) eq "disabled"} { return 0 }
- switch -exact -- $data(state) {
- {0} {
- tixComboBox:GoState 17 $w
- }
- {2} {
- tixComboBox:GoState 16 $w
- return 1
- }
- {n0} {
- tixComboBox:GoState n4 $w
- }
- default {
- # ignore
- return 1
- }
- }
- return 0
- }
- #----------------------------------------
- # Keyboard events
- #----------------------------------------
- proc tixComboBox:EntDirKey {w dir} {
- upvar #0 $w data
- if {$data(-state) eq "disabled"} { return }
- switch -exact -- $data(state) {
- {0} {
- tixComboBox:GoState 10 $w $dir
- }
- {2} {
- tixComboBox:GoState 11 $w $dir
- }
- {5} {
- # ignore
- }
- {n0} {
- tixComboBox:GoState n3 $w $dir
- }
- }
- }
- proc tixComboBox:EntReturnKey {w} {
- upvar #0 $w data
- if {$data(-state) eq "disabled"} { return }
- switch -exact -- $data(state) {
- {0} {
- tixComboBox:GoState 14 $w
- }
- {2} {
- tixComboBox:GoState 15 $w
- }
- {5} {
- # ignore
- }
- {n0} {
- tixComboBox:GoState n1 $w
- }
- }
- }
- # Return 1 == break from the binding == no keyboard focus traversal
- proc tixComboBox:EntTab {w} {
- upvar #0 $w data
- switch -exact -- $data(state) {
- {0} {
- tixComboBox:GoState 14 $w
- set data(cancelTab) ""
- return 0
- }
- {2} {
- tixComboBox:GoState 15 $w
- set data(cancelTab) ""
- return 0
- }
- {n0} {
- tixComboBox:GoState n1 $w
- set data(cancelTab) ""
- return 0
- }
- default {
- return 1
- }
- }
- }
- proc tixComboBox:EntKeyPress {w} {
- upvar #0 $w data
- if {$data(-state) eq "disabled" || !$data(-editable)} { return }
- switch -exact -- $data(state) {
- 0 - 2 - n0 {
- tixComboBox:ClearListboxSelection $w
- tixComboBox:SetSelection $w [$data(w:entry) get] 0 0
- }
- }
- }
- #----------------------------------------------------------------------
- proc tixComboBox:HandleDirKey {w dir} {
- upvar #0 $w data
- if {[tixComboBox:CheckListboxSelection $w]} {
- switch -exact -- $dir {
- "up" {
- tkListboxUpDown $data(w:listbox) -1
- set data(curIndex) [lindex [$data(w:listbox) curselection] 0]
- tixComboBox:SetSelectionFromListbox $w
- }
- "down" {
- tkListboxUpDown $data(w:listbox) 1
- set data(curIndex) [lindex [$data(w:listbox) curselection] 0]
- tixComboBox:SetSelectionFromListbox $w
- }
- "pageup" {
- $data(w:listbox) yview scroll -1 pages
- }
- "pagedown" {
- $data(w:listbox) yview scroll 1 pages
- }
- }
- } else {
- # There wasn't good selection in the listbox.
- #
- tixComboBox:SetSelectionFromListbox $w
- }
- }
- proc tixComboBox:Invoke {w} {
- upvar #0 $w data
- tixComboBox:SetValue $w $data(-selection)
- if {![winfo exists $w]} {
- return
- }
- if {$data(-history)} {
- tixComboBox:addhistory $w $data(-value)
- set data(curIndex) 0
- }
- $data(w:entry) selection from 0
- $data(w:entry) selection to end
- $data(w:entry) icursor end
- }
- #----------------------------------------------------------------------
- # MAINTAINING THE -VALUE
- #----------------------------------------------------------------------
- proc tixComboBox:SetValue {w newValue {noUpdate 0} {updateEnt 1}} {
- upvar #0 $w data
- if {[llength $data(-validatecmd)]} {
- set data(-value) [tixEvalCmdBinding $w $data(-validatecmd) "" $newValue]
- } else {
- set data(-value) $newValue
- }
- if {! $noUpdate} {
- tixVariable:UpdateVariable $w
- }
- if {$updateEnt} {
- if {!$data(-editable)} {
- $data(w:entry) delete 0 end
- $data(w:entry) insert 0 $data(-value)
- }
- }
- if {!$data(-disablecallback) && [llength $data(-command)]} {
- if {![info exists data(varInited)]} {
- set bind(specs) {%V}
- set bind(%V) $data(-value)
- tixEvalCmdBinding $w $data(-command) bind $data(-value)
- if {![winfo exists $w]} {
- # The user destroyed the window!
- return
- }
- }
- }
- set data(-selection) $data(-value)
- if {$updateEnt} {
- tixSetEntry $data(w:entry) $data(-value)
- if {$data(-anchor) eq "e"} {
- tixComboBox:EntryAlignEnd $w
- }
- }
- }
- # markSel: should the all the text in the entry be highlighted?
- #
- proc tixComboBox:SetSelection {w value {markSel 1} {setent 1}} {
- upvar #0 $w data
- if {$setent} {
- tixSetEntry $data(w:entry) $value
- }
- set data(-selection) $value
- if {$data(-selectmode) eq "browse"} {
- if {$markSel} {
- $data(w:entry) selection range 0 end
- }
- if {[llength $data(-browsecmd)]} {
- set bind(specs) {%V}
- set bind(%V) [$data(w:entry) get]
- tixEvalCmdBinding $w $data(-browsecmd) bind [$data(w:entry) get]
- }
- } else {
- tixComboBox:SetValue $w $value 0 0
- }
- }
- proc tixComboBox:ClearListboxSelection {w} {
- upvar #0 $w data
- if {![winfo exists $data(w:listbox)]} {
- tixDebug "tixComboBox:ClearListboxSelection error non-existent $data(w:listbox)"
- return
- }
- $data(w:listbox) selection clear 0 end
- }
- proc tixComboBox:UpdateListboxSelection {w index} {
- upvar #0 $w data
- if {![winfo exists $data(w:listbox)]} {
- tixDebug "tixComboBox:UpdateListboxSelection error non-existent $data(w:listbox)"
- return
- }
- if {$index != ""} {
- $data(w:listbox) selection set $index
- $data(w:listbox) selection anchor $index
- }
- }
- proc tixComboBox:Cancel {w} {
- upvar #0 $w data
- tixSetEntry $data(w:entry) $data(-value)
- tixComboBox:SetSelection $w $data(-value)
- if {[tixComboBox:LbGetSelection $w] ne $data(-selection)} {
- tixComboBox:ClearListboxSelection $w
- }
- }
- proc tixComboBox:flash {w} {
- tixComboBox:BlinkEntry $w
- }
- # Make the entry blink when the user selects a choice
- #
- proc tixComboBox:BlinkEntry {w} {
- upvar #0 $w data
- if {![info exists data(entryBlacken)]} {
- set old_bg [$data(w:entry) cget -bg]
- set old_fg [$data(w:entry) cget -fg]
- $data(w:entry) config -fg $old_bg
- $data(w:entry) config -bg $old_fg
- set data(entryBlacken) 1
- after 50 tixComboBox:RestoreBlink $w [list $old_bg] [list $old_fg]
- }
- }
- proc tixComboBox:RestoreBlink {w old_bg old_fg} {
- upvar #0 $w data
- if {[info exists data(w:entry)] && [winfo exists $data(w:entry)]} {
- $data(w:entry) config -fg $old_fg
- $data(w:entry) config -bg $old_bg
- }
- if {[info exists data(entryBlacken)]} {
- unset data(entryBlacken)
- }
- }
- #----------------------------------------
- # Handle events inside the list box
- #----------------------------------------
- proc tixComboBox:LbIndex {w {flag ""}} {
- upvar #0 $w data
- if {![winfo exists $data(w:listbox)]} {
- tixDebug "tixComboBox:LbIndex error non-existent $data(w:listbox)"
- if {$flag eq "emptyOK"} {
- return ""
- } else {
- return 0
- }
- }
- set sel [lindex [$data(w:listbox) curselection] 0]
- if {$sel != ""} {
- return $sel
- } else {
- if {$flag eq "emptyOK"} {
- return ""
- } else {
- return 0
- }
- }
- }
- #----------------------------------------------------------------------
- #
- # STATE MANIPULATION
- #
- #----------------------------------------------------------------------
- proc tixComboBox:GoState-0 {w} {
- upvar #0 $w data
- if {[info exists data(w:root)] && [grab current] eq "$data(w:root)"} {
- grab release $w
- }
- }
- proc tixComboBox:GoState-1 {w} {
- upvar #0 $w data
- tixComboBox:Popup $w
- }
- proc tixComboBox:GoState-2 {w} {
- upvar #0 $w data
- }
- proc tixComboBox:GoState-3 {w} {
- upvar #0 $w data
- set data(ignore) 1
- tixComboBox:Popdown $w
- }
- proc tixComboBox:GoState-4 {w} {
- upvar #0 $w data
- tixComboBox:Ungrab $w
- if {$data(ignore)} {
- tixComboBox:Cancel $w
- } else {
- tixComboBox:Invoke $w
- }
- tixComboBox:GoState 0 $w
- }
- proc tixComboBox:GoState-5 {w x y X Y} {
- upvar #0 $w data
- tixComboBox:LbSelect $w $x $y $X $Y
- }
- proc tixComboBox:GoState-6 {w x y X Y} {
- upvar #0 $w data
- tixComboBox:Popdown $w
- if {[tixWithinWindow $data(w:shell) $X $Y]} {
- set data(ignore) 0
- } else {
- set data(ignore) 1
- }
- tixComboBox:GoState 4 $w
- }
- proc tixComboBox:GoState-7 {w} {
- upvar #0 $w data
- tixComboBox:Popdown $w
- set data(ignore) 1
- catch {
- global tkPriv
- if {$tkPriv(afterId) != ""} {
- tkCancelRepeat
- }
- }
- set data(ignore) 1
- tixComboBox:GoState 4 $w
- }
- proc tixComboBox:GoState-9 {w x y X Y} {
- upvar #0 $w data
- catch {
- tkButtonUp $data(w:arrow)
- }
- tixComboBox:GoState 5 $w $x $y $X $Y
- }
- proc tixComboBox:GoState-10 {w dir} {
- upvar #0 $w data
- tixComboBox:Popup $w
- if {![tixComboBox:CheckListboxSelection $w]} {
- # There wasn't good selection in the listbox.
- #
- tixComboBox:SetSelectionFromListbox $w
- }
- tixComboBox:GoState 2 $w
- }
- proc tixComboBox:GoState-11 {w dir} {
- upvar #0 $w data
- tixComboBox:HandleDirKey $w $dir
- tixComboBox:GoState 2 $w
- }
- proc tixComboBox:GoState-12 {w} {
- upvar #0 $w data
- catch {
- tkButtonUp $data(w:arrow)
- }
- tixComboBox:GoState 2 $w
- }
- proc tixComboBox:GoState-13 {w} {
- upvar #0 $w data
- catch {
- global tkPriv
- if {$tkPriv(afterId) != ""} {
- tkCancelRepeat
- }
- }
- tixComboBox:GoState 2 $w
- }
- proc tixComboBox:GoState-14 {w} {
- upvar #0 $w data
- tixComboBox:Invoke $w
- tixComboBox:GoState 0 $w
- }
- proc tixComboBox:GoState-15 {w} {
- upvar #0 $w data
- tixComboBox:Popdown $w
- set data(ignore) 0
- tixComboBox:GoState 4 $w
- }
- proc tixComboBox:GoState-16 {w} {
- upvar #0 $w data
- tixComboBox:Popdown $w
- tixComboBox:Cancel $w
- set data(ignore) 1
- tixComboBox:GoState 4 $w
- }
- proc tixComboBox:GoState-17 {w} {
- upvar #0 $w data
- tixComboBox:Cancel $w
- tixComboBox:GoState 0 $w
- }
- proc tixComboBox:GoState-19 {w} {
- upvar #0 $w data
- set data(ignore) [string equal $data(-selection) $data(-value)]
- tixComboBox:Popdown $w
- }
- #----------------------------------------------------------------------
- # Non-dropdown states
- #----------------------------------------------------------------------
- proc tixComboBox:GoState-n0 {w} {
- upvar #0 $w data
- }
- proc tixComboBox:GoState-n1 {w} {
- upvar #0 $w data
- tixComboBox:Invoke $w
- tixComboBox:GoState n0 $w
- }
- proc tixComboBox:GoState-n3 {w dir} {
- upvar #0 $w data
- tixComboBox:HandleDirKey $w $dir
- tixComboBox:GoState n0 $w
- }
- proc tixComboBox:GoState-n4 {w} {
- upvar #0 $w data
- tixComboBox:Cancel $w
- tixComboBox:GoState n0 $w
- }
- proc tixComboBox:GoState-n6 {w x y X Y} {
- upvar #0 $w data
- tixComboBox:LbSelect $w $x $y $X $Y
- }
- #----------------------------------------------------------------------
- # General State Manipulation
- #----------------------------------------------------------------------
- proc tixComboBox:GoState {s w args} {
- upvar #0 $w data
- tixComboBox:SetState $w $s
- eval tixComboBox:GoState-$s $w $args
- }
- proc tixComboBox:SetState {w s} {
- upvar #0 $w data
- # catch {puts [info level -2]}
- # puts "setting state $data(state) --> $s"
- set data(state) $s
- }
- proc tixComboBox:StateError {w} {
- upvar #0 $w data
- # error "wrong state $data(state)"
- }
- #----------------------------------------------------------------------
- # Listbox handling
- #----------------------------------------------------------------------
- # Set a selection if there isn't one. Returns true if there was already
- # a good selection inside the listbox
- #
- proc tixComboBox:CheckListboxSelection {w} {
- upvar #0 $w data
- if {![winfo exists $data(w:listbox)]} {
- tixDebug "tixComboBox:CheckListboxSelection error non-existent $data(w:listbox)"
- return 0
- }
- if {[$data(w:listbox) curselection] == ""} {
- if {$data(curIndex) == ""} {
- set data(curIndex) 0
- }
- $data(w:listbox) activate $data(curIndex)
- $data(w:listbox) selection clear 0 end
- $data(w:listbox) selection set $data(curIndex)
- $data(w:listbox) see $data(curIndex)
- return 0
- } else {
- return 1
- }
- }
- proc tixComboBox:SetSelectionFromListbox {w} {
- upvar #0 $w data
- set string [$data(w:listbox) get $data(curIndex)]
- tixComboBox:SetSelection $w $string
- tixComboBox:UpdateListboxSelection $w $data(curIndex)
- }
- proc tixComboBox:LbGetSelection {w} {
- upvar #0 $w data
- set index [tixComboBox:LbIndex $w emptyOK]
- if {$index >=0} {
- return [$data(w:listbox) get $index]
- } else {
- return ""
- }
- }
- proc tixComboBox:LbSelect {w x y X Y} {
- upvar #0 $w data
- set index [tixComboBox:LbIndex $w emptyOK]
- if {$index == ""} {
- set index [$data(w:listbox) nearest $y]
- }
- if {$index >= 0} {
- if {[focus -lastfor $data(w:entry)] ne $data(w:entry) &&
- [focus -lastfor $data(w:entry)] ne $data(w:listbox)} {
- focus $data(w:entry)
- }
- set string [$data(w:listbox) get $index]
- tixComboBox:SetSelection $w $string
- tixComboBox:UpdateListboxSelection $w $index
- }
- }
- #----------------------------------------------------------------------
- # Internal commands
- #----------------------------------------------------------------------
- proc tixComboBox:CrossBtn {w} {
- upvar #0 $w data
- $data(w:entry) delete 0 end
- tixComboBox:ClearListboxSelection $w
- tixComboBox:SetSelection $w ""
- }
- #--------------------------------------------------
- # Popping up list shell
- #--------------------------------------------------
- # Popup the listbox and grab
- #
- #
- proc tixComboBox:Popup {w} {
- global tcl_platform
- upvar #0 $w data
- if {![winfo ismapped $data(w:root)]} {
- return
- }
- #---------------------------------------------------------------------
- # Pop up
- #
- if {$data(-listcmd) != ""} {
- # This option allows the user to fill in the listbox on demand
- #
- tixEvalCmdBinding $w $data(-listcmd)
- }
- # calculate the size
- set y [winfo rooty $data(w:entry)]
- incr y [winfo height $data(w:entry)]
- incr y 3
- set bd [$data(w:shell) cget -bd]
- # incr bd [$data(w:shell) cget -highlightthickness]
- set height [expr {[winfo reqheight $data(w:slistbox)] + 2*$bd}]
- set x1 [winfo rootx $data(w:entry)]
- if {$data(-listwidth) == ""} {
- if {[winfo ismapped $data(w:arrow)]} {
- set x2 [winfo rootx $data(w:arrow)]
- if {$x2 >= $x1} {
- incr x2 [winfo width $data(w:arrow)]
- set width [expr {$x2 - $x1}]
- } else {
- set width [winfo width $data(w:entry)]
- set x2 [expr {$x1 + $width}]
- }
- } else {
- set width [winfo width $data(w:entry)]
- set x2 [expr {$x1 + $width}]
- }
- } else {
- set width $data(-listwidth)
- set x2 [expr {$x1 + $width}]
- }
- set reqwidth [winfo reqwidth $data(w:shell)]
- if {$reqwidth < $width} {
- set reqwidth $width
- } else {
- if {$reqwidth > [expr {$width *3}]} {
- set reqwidth [expr {$width *3}]
- }
- if {$reqwidth > [winfo vrootwidth .]} {
- set reqwidth [winfo vrootwidth .]
- }
- }
- set width $reqwidth
- # If the listbox is too far right, pull it back to the left
- #
- set scrwidth [winfo vrootwidth .]
- if {$x2 > $scrwidth} {
- set x1 [expr {$scrwidth - $width}]
- }
- # If the listbox is too far left, pull it back to the right
- #
- if {$x1 < 0} {
- set x1 0
- }
- # If the listbox is below bottom of screen, put it upwards
- #
- set scrheight [winfo vrootheight .]
- set bottom [expr {$y+$height}]
- if {$bottom > $scrheight} {
- set y [expr {$y-$height-[winfo height $data(w:entry)]-5}]
- }
- # OK , popup the shell
- #
- global tcl_platform
- wm geometry $data(w:shell) $reqwidth\x$height+$x1+$y
- if {$tcl_platform(platform) eq "windows"} {
- update
- }
- wm deiconify $data(w:shell)
- if {$tcl_platform(platform) eq "windows"} {
- update
- }
- raise $data(w:shell)
- focus $data(w:entry)
- set data(popped) 1
- # add for safety
- update
-
- tixComboBox:Grab $w
- }
- proc tixComboBox:SetCursor {w cursor} {
- upvar #0 $w data
- $w config -cursor $cursor
- }
- proc tixComboBox:Popdown {w} {
- upvar #0 $w data
- wm withdraw $data(w:shell)
- tixComboBox:SetCursor $w ""
- }
- # Grab the server so that user cannot move the windows around
- proc tixComboBox:Grab {w} {
- upvar #0 $w data
- tixComboBox:SetCursor $w arrow
- if {[catch {
- # We catch here because grab may fail under a lot of circumstances
- # Just don't want to break the code ...
- switch -exact -- $data(-grab) {
- global { tixPushGrab -global $data(w:root) }
- local { tixPushGrab $data(w:root) }
- }
- } err]} {
- tixDebug "tixComboBox:Grab+: Error grabbing $data(w:root)\n$err"
- }
- }
- proc tixComboBox:Ungrab {w} {
- upvar #0 $w data
- if {[catch {
- catch {
- switch -exact -- $data(-grab) {
- global { tixPopGrab }
- local { tixPopGrab }
- }
- }
- } err]} {
- tixDebug "tixComboBox:Grab+: Error grabbing $data(w:root)\n$err"
- }
- }
- #----------------------------------------------------------------------
- # Alignment
- #----------------------------------------------------------------------
- # The following two routines can emulate a "right align mode" for the
- # entry in the combo box.
- proc tixComboBox:EntryAlignEnd {w} {
- upvar #0 $w data
- $data(w:entry) xview end
- }
- proc tixComboBox:Destructor {w} {
- upvar #0 $w data
- tixUnsetMegaWidget $data(w:entry)
- tixVariable:DeleteVariable $w
- # Chain this to the superclass
- #
- tixChainMethod $w Destructor
- }
- #----------------------------------------------------------------------
- # CONFIG OPTIONS
- #----------------------------------------------------------------------
- proc tixComboBox:config-state {w value} {
- upvar #0 $w data
- catch {if {[$data(w:arrow) cget -state] eq $value} {set a 1}}
- if {[info exists a]} {
- return
- }
- catch {$data(w:arrow) config -state $value}
- catch {$data(w:tick) config -state $value}
- catch {$data(w:cross) config -state $value}
- catch {$data(w:slistbox) config -state $value}
- if {[string equal $value normal]} {
- set fg [$data(w:arrow) cget -fg]
- set entryFg $data(entryfg)
- set lbSelFg [lindex [$data(w:listbox) config -selectforeground] 3]
- set lbSelBg [lindex [$data(w:listbox) config -selectbackground] 3]
- set entrySelFg [lindex [$data(w:entry) config -selectforeground] 3]
- set entrySelBg [lindex [$data(w:entry) config -selectbackground] 3]
- } else {
- set fg [$data(w:arrow) cget -disabledforeground]
- set entryFg $data(-disabledforeground)
- set lbSelFg $entryFg
- set lbSelBg [$data(w:listbox) cget -bg]
- set entrySelFg $entryFg
- set entrySelBg [$data(w:entry) cget -bg]
- }
- if {$fg ne ""} {
- $data(w:label) config -fg $fg
- $data(w:listbox) config -fg $fg -selectforeground $lbSelFg \
- -selectbackground $lbSelBg
- }
- $data(w:entry) config -fg $entryFg -selectforeground $entrySelFg \
- -selectbackground $entrySelBg
- if {$value eq "normal"} {
- if {$data(-editable)} {
- $data(w:entry) config -state normal
- }
- $data(w:entry) config -takefocus 1
- } else {
- if {$data(-editable)} {
- $data(w:entry) config -state disabled
- }
- $data(w:entry) config -takefocus 0
- }
- }
- proc tixComboBox:config-value {w value} {
- upvar #0 $w data
- tixComboBox:SetValue $w $value
- set data(-selection) $value
- if {[tixComboBox:LbGetSelection $w] ne $value} {
- tixComboBox:ClearListboxSelection $w
- }
- }
- proc tixComboBox:config-selection {w value} {
- upvar #0 $w data
- tixComboBox:SetSelection $w $value
- if {[tixComboBox:LbGetSelection $w] ne $value} {
- tixComboBox:ClearListboxSelection $w
- }
- }
- proc tixComboBox:config-variable {w arg} {
- upvar #0 $w data
- if {[tixVariable:ConfigVariable $w $arg]} {
- # The value of data(-value) is changed if tixVariable:ConfigVariable
- # returns true
- set data(-selection) $data(-value)
- tixComboBox:SetValue $w $data(-value) 1
- }
- catch {
- unset data(varInited)
- }
- set data(-variable) $arg
- }
- #----------------------------------------------------------------------
- # WIDGET COMMANDS
- #----------------------------------------------------------------------
- proc tixComboBox:align {w args} {
- upvar #0 $w data
- if {$data(-anchor) eq "e"} {
- tixComboBox:EntryAlignEnd $w
- }
- }
- proc tixComboBox:addhistory {w value} {
- upvar #0 $w data
- tixComboBox:insert $w 0 $value
- $data(w:listbox) selection clear 0 end
- if {$data(-prunehistory)} {
- # Prune from the end
- #
- set max [$data(w:listbox) size]
- if {$max <= 1} {
- return
- }
- for {set i [expr {$max -1}]} {$i >= 1} {incr i -1} {
- if {[$data(w:listbox) get $i] eq $value} {
- $data(w:listbox) delete $i
- break
- }
- }
- }
- }
- proc tixComboBox:appendhistory {w value} {
- upvar #0 $w data
- tixComboBox:insert $w end $value
- $data(w:listbox) selection clear 0 end
- if {$data(-prunehistory)} {
- # Prune from the end
- #
- set max [$data(w:listbox) size]
- if {$max <= 1} {
- return
- }
- for {set i [expr {$max -2}]} {$i >= 0} {incr i -1} {
- if {[$data(w:listbox) get $i] eq $value} {
- $data(w:listbox) delete $i
- break
- }
- }
- }
- }
- proc tixComboBox:insert {w index newitem} {
- upvar #0 $w data
- $data(w:listbox) insert $index $newitem
- if {$data(-history) && $data(-historylimit) != ""
- && [$data(w:listbox) size] eq $data(-historylimit)} {
- $data(w:listbox) delete 0
- }
- }
- proc tixComboBox:pick {w index} {
- upvar #0 $w data
- $data(w:listbox) activate $index
- $data(w:listbox) selection clear 0 end
- $data(w:listbox) selection set active
- $data(w:listbox) see active
- set text [$data(w:listbox) get $index]
- tixComboBox:SetValue $w $text
- set data(curIndex) $index
- }
- proc tixComboBox:invoke {w} {
- tixComboBox:Invoke $w
- }
- proc tixComboBox:popdown {w} {
- upvar #0 $w data
- if {$data(-dropdown)} {
- tixComboBox:Popdown $w
- }
- }
|