You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
1559 lines
37 KiB
1559 lines
37 KiB
4 years ago
|
# -*- 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
|
||
|
}
|
||
|
}
|