combobox.tcl

The BWidget Toolkit is a high-level Widget Set for Tcl/Tk built using native Tcl/Tk 8.x namespaces.

# ----------------------------------------------------------------------------
#  combobox.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: combobox.tcl,v 1.29 2003/11/06 05:49:44 damonc Exp $
# ----------------------------------------------------------------------------
#  Index of commands:
#     - ComboBox::create
#     - ComboBox::configure
#     - ComboBox::cget
#     - ComboBox::setvalue
#     - ComboBox::getvalue
#     - ComboBox::_create_popup
#     - ComboBox::_mapliste
#     - ComboBox::_unmapliste
#     - ComboBox::_select
#     - ComboBox::_modify_value
# ----------------------------------------------------------------------------

# ComboBox uses the 8.3 -listvariable listbox option
package require Tk 8.3

namespace eval ComboBox {
    Widget::define ComboBox combobox ArrowButton Entry ListBox

    Widget::tkinclude ComboBox frame :cmd \
	include {-relief -borderwidth -bd -background} \
	initialize {-relief sunken -borderwidth 2} \

    Widget::bwinclude ComboBox Entry .e \
	remove {-relief -bd -borderwidth -bg} \
	rename {-background -entrybg}

    Widget::declare ComboBox {
	{-height       TkResource 0    0 listbox}
	{-values       String	  ""   0}
	{-images       String	  ""   0}
	{-indents      String	  ""   0}
	{-modifycmd    String	  ""   0}
	{-postcommand  String	  ""   0}
	{-expand       Enum	  none 0 {none tab}}
	{-autocomplete Boolean	  0    0}
        {-bwlistbox    Boolean    0    0}
        {-listboxwidth Int        0    0}
        {-hottrack     Boolean    0    0}
    }

    Widget::addmap ComboBox ArrowButton .a {
	-background {} -foreground {} -disabledforeground {} -state {}
    }

    Widget::syncoptions ComboBox Entry .e {-text {}}

    ::bind BwComboBox <FocusIn> [list after idle {BWidget::refocus %W %W.e}]
    ::bind BwComboBox <Destroy> [list Widget::destroy %W]

    ::bind ListBoxHotTrack <Motion> {
        %W selection clear 0 end
        %W activate @%x,%y
        %W selection set @%x,%y
    }
}


# ComboBox::create --
#
#	Create a combobox widget with the given options.
#
# Arguments:
#	path	name of the new widget.
#	args	optional arguments to the widget.
#
# Results:
#	path	name of the new widget.

proc ComboBox::create { path args } {
    array set maps [list ComboBox {} :cmd {} .e {} .a {}]
    array set maps [Widget::parseArgs ComboBox $args]

    eval [list frame $path] $maps(:cmd) \
	[list -highlightthickness 0 -takefocus 0 -class ComboBox]
    Widget::initFromODB ComboBox $path $maps(ComboBox)

    bindtags $path [list $path BwComboBox [winfo toplevel $path] all]

    set entry [eval [list Entry::create $path.e] $maps(.e) \
		   [list -relief flat -borderwidth 0 -takefocus 1]]

    ::bind $path.e <FocusOut>      [list $path _focus_out]
    ::bind $path   <<TraverseIn>>  [list $path _traverse_in]

    if {[Widget::cget $path -autocomplete]} {
	::bind $path.e <KeyRelease> [list $path _auto_complete %K]
    }

    if {[string equal $::tcl_platform(platform) "unix"]} {
	set ipadx 0
	set width 11
    } else {
	set ipadx 2
	set width 15
    }
    set height [winfo reqheight $entry]
    set arrow [eval [list ArrowButton::create $path.a] $maps(.a) \
		   -width $width -height $height \
		   -highlightthickness 0 -borderwidth 1 -takefocus 0 \
		   -dir	  bottom \
		   -type  button \
		   -ipadx $ipadx \
		   -command [list [list ComboBox::_mapliste $path]]]

    pack $arrow -side right -fill y
    pack $entry -side left  -fill both -expand yes

    set editable [Widget::cget $path -editable]
    Entry::configure $path.e -editable $editable
    if {$editable} {
	::bind $entry <ButtonPress-1> [list ComboBox::_unmapliste $path]
    } else {
	::bind $entry <ButtonPress-1> [list ArrowButton::invoke $path.a]
	if { ![string equal [Widget::cget $path -state] "disabled"] } {
	    Entry::configure $path.e -takefocus 1
	}
    }

    ::bind $path  <ButtonPress-1> [list ComboBox::_unmapliste $path]
    ::bind $entry <Key-Up>	  [list ComboBox::_unmapliste $path]
    ::bind $entry <Key-Down>	  [list ComboBox::_mapliste $path]
    ::bind $entry <Control-Up>	  [list ComboBox::_modify_value $path previous]
    ::bind $entry <Control-Down>  [list ComboBox::_modify_value $path next]
    ::bind $entry <Control-Prior> [list ComboBox::_modify_value $path first]
    ::bind $entry <Control-Next>  [list ComboBox::_modify_value $path last]

    if {$editable} {
	set expand [Widget::cget $path -expand]
	if {[string equal "tab" $expand]} {
	    # Expand entry value on Tab (from -values)
	    ::bind $entry <Tab> "[list ComboBox::_expand $path]; break"
	} elseif {[string equal "auto" $expand]} {
	    # Expand entry value anytime (from -values)
	    #::bind $entry <Key> "[list ComboBox::_expand $path]; break"
	}
    }

    ## If we have images, we have to use a BWidget ListBox.
    set bw [Widget::cget $path -bwlistbox]
    if {[llength [Widget::cget $path -images]]} {
        Widget::configure $path [list -bwlistbox 1]
    } else {
        Widget::configure $path [list -bwlistbox $bw]
    }

    return [Widget::create ComboBox $path]
}


# ComboBox::configure --
#
#	Configure subcommand for ComboBox widgets.  Works like regular
#	widget configure command.
#
# Arguments:
#	path	Name of the ComboBox widget.
#	args	Additional optional arguments:
#			?-option?
#			?-option value ...?
#
# Results:
#	Depends on arguments.  If no arguments are given, returns a complete
#	list of configuration information.  If one argument is given, returns
#	the configuration information for that option.  If more than one
#	argument is given, returns nothing.

proc ComboBox::configure { path args } {
    set res [Widget::configure $path $args]
    set entry $path.e


    set list [list -images -values -bwlistbox -hottrack]
    foreach {ci cv cb ch} [eval Widget::hasChangedX $path $list] { break }

    if { $ci } {
        set images [Widget::cget $path -images]
        if {[llength $images]} {
            Widget::configure $path [list -bwlistbox 1]
        } else {
            Widget::configure $path [list -bwlistbox 0]
        }
    }

    set bw [Widget::cget $path -bwlistbox]

    ## If the images, bwlistbox, hottrack or values have changed,
    ## destroy the shell so that it will re-create itself the next
    ## time around.
    if { $ci || $cb || $ch || ($bw && $cv) } {
        destroy $path.shell
    }

    set chgedit [Widget::hasChangedX $path -editable]
    if {$chgedit} {
        if {[Widget::cget $path -editable]} {
            ::bind $entry <ButtonPress-1> [list ComboBox::_unmapliste $path]
	    Entry::configure $entry -editable true
	} else {
	    ::bind $entry <ButtonPress-1> [list ArrowButton::invoke $path.a]
	    Entry::configure $entry -editable false

	    # Make sure that non-editable comboboxes can still be tabbed to.

	    if { ![string equal [Widget::cget $path -state] "disabled"] } {
		Entry::configure $entry -takefocus 1
	    }
        }
    }

    if {$chgedit || [Widget::hasChangedX $path -expand]} {
	# Unset what we may have created.
	::bind $entry <Tab> {}
	if {[Widget::cget $path -editable]} {
	    set expand [Widget::cget $path -expand]
	    if {[string equal "tab" $expand]} {
		# Expand entry value on Tab (from -values)
		::bind $entry <Tab> "[list ComboBox::_expand $path]; break"
	    } elseif {[string equal "auto" $expand]} {
		# Expand entry value anytime (from -values)
		#::bind $entry <Key> "[list ComboBox::_expand $path]; break"
	    }
	}
    }

    # if the dropdown listbox is shown, simply force the actual entry
    #  colors into it. If it is not shown, the next time the dropdown
    #  is shown it'll get the actual colors anyway
    if {[winfo exists $path.shell.listb]} {
	$path.shell.listb configure \
		-bg [Widget::cget $path -entrybg] \
		-fg [Widget::cget $path -foreground] \
		-selectbackground [Widget::cget $path -selectbackground] \
		-selectforeground [Widget::cget $path -selectforeground]
    }

    return $res
}


# ----------------------------------------------------------------------------
#  Command ComboBox::cget
# ----------------------------------------------------------------------------
proc ComboBox::cget { path option } {
    return [Widget::cget $path $option]
}


# ----------------------------------------------------------------------------
#  Command ComboBox::setvalue
# ----------------------------------------------------------------------------
proc ComboBox::setvalue { path index } {
    set values [Widget::getMegawidgetOption $path -values]
    set value  [Entry::cget $path.e -text]
    switch -- $index {
        next {
            if { [set idx [lsearch -exact $values $value]] != -1 } {
                incr idx
            } else {
                set idx [lsearch -exact $values "$value*"]
            }
        }
        previous {
            if { [set idx [lsearch -exact $values $value]] != -1 } {
                incr idx -1
            } else {
                set idx [lsearch -exact $values "$value*"]
            }
        }
        first {
            set idx 0
        }
        last {
            set idx [expr {[llength $values]-1}]
        }
        default {
            if { [string index $index 0] == "@" } {
                set idx [string range $index 1 end]
		if { ![string is integer -strict $idx] } {
                    return -code error "bad index \"$index\""
                }
            } else {
                return -code error "bad index \"$index\""
            }
        }
    }
    if { $idx >= 0 && $idx < [llength $values] } {
        set newval [lindex $values $idx]
	Entry::configure $path.e -text $newval
        return 1
    }
    return 0
}


proc ComboBox::icursor { path idx } {
    return [$path.e icursor $idx]
}


proc ComboBox::get { path } {
    return [$path.e get]
}


# ----------------------------------------------------------------------------
#  Command ComboBox::getvalue
# ----------------------------------------------------------------------------
proc ComboBox::getvalue { path } {
    set values [Widget::getMegawidgetOption $path -values]
    set value  [Entry::cget $path.e -text]

    return [lsearch -exact $values $value]
}


proc ComboBox::getlistbox { path } {
    _create_popup $path
    return $path.shell.listb
}


# ----------------------------------------------------------------------------
#  Command ComboBox::post
# ----------------------------------------------------------------------------
proc ComboBox::post { path } {
    _mapliste $path
    return
}


proc ComboBox::unpost { path } {
    _unmapliste $path
    return
}


# ----------------------------------------------------------------------------
#  Command ComboBox::bind
# ----------------------------------------------------------------------------
proc ComboBox::bind { path args } {
    return [eval [list ::bind $path.e] $args]
}


proc ComboBox::insert { path idx args } {
    upvar #0 [Widget::varForOption $path -values] values

    if {[Widget::cget $path -bwlistbox]} {
        set l [$path getlistbox]
        set i [eval $l insert $idx #auto $args]
        set text [$l itemcget $i -text]
        if {$idx == "end"} {
            lappend values $text
        } else {
            set values [linsert $values $idx $text]
        }
    } else {
        set values [eval linsert [list $values] $idx $args]
    }
}

# ----------------------------------------------------------------------------
#  Command ComboBox::_create_popup