--- /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) <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 }
+
+ 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
+ }
+}