diff -r 000000000000 -r ae805ac0140d python-2.5.2/win32/tcl/tix8.4/ComboBox.tcl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/python-2.5.2/win32/tcl/tix8.4/ComboBox.tcl Fri Apr 03 17:19:34 2009 +0100 @@ -0,0 +1,1558 @@ +# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*- +# +# $Id: ComboBox.tcl,v 1.8 2004/03/28 02:44:57 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) [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 { + if {[tixComboBox:EscKey %W]} { + break + } + } + tixBind TixComboBox { + 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 { + 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 { + 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 { + tixComboBox:ArrowUp [tixGetMegaWidget %W TixComboBox] + } + tixBind TixComboArrow { + if {[tixComboBox:EscKey [tixGetMegaWidget %W TixComboBox]]} { + break + } + } + + + #---------------------------------------------------------------------- + # The class tixBindings for the entry widget inside the TixComboBox + # + tixBind TixComboEntry { + tixComboBox:EntDirKey [tixGetMegaWidget %W TixComboBox] up + } + tixBind TixComboEntry { + tixComboBox:EntDirKey [tixGetMegaWidget %W TixComboBox] down + } + tixBind TixComboEntry { + tixComboBox:EntDirKey [tixGetMegaWidget %W TixComboBox] pageup + } + tixBind TixComboEntry { + tixComboBox:EntDirKey [tixGetMegaWidget %W TixComboBox] pagedown + } + tixBind TixComboEntry { + tixComboBox:EntReturnKey [tixGetMegaWidget %W TixComboBox] + } + tixBind TixComboEntry { + tixComboBox:EntKeyPress [tixGetMegaWidget %W TixComboBox] + } + tixBind TixComboEntry { + if {[tixComboBox:EscKey [tixGetMegaWidget %W TixComboBox]]} { + break + } + } + tixBind TixComboEntry { + 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 { + tixComboBox:EntKeyPress [tixGetMegaWidget %W TixComboBox] + } + + #---------------------------------------------------------------------- + # The class bindings for the listbox subwidget + # + + tixBind TixComboWid { + if {[tixComboBox:EscKey [tixGetMegaWidget %W TixComboBox]]} { + break + } + } + + #---------------------------------------------------------------------- + # The class bindings for some widgets inside ComboBox + # + tixBind TixComboWid { + tixComboBox:WidUp [tixGetMegaWidget %W TixComboBox] + } + tixBind TixComboWid { + 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 + } + } + } + { + 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 } + + 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 + } +}