blob: 5b38157c1c70cd99f2bf50adb5d511e328cbadc9 [file] [log] [blame]
# Combobox
# ----------------------------------------------------------------------
# Implements a Combobox widget. A Combobox has 2 basic styles: simple and
# dropdown. Dropdowns display an entry field with an arrow button to the
# right of it. When the arrow button is pressed a selectable list of
# items is popped up. A simple Combobox displays an entry field and a listbox
# just beneath it which is always displayed. In both types, if the user
# selects an item in the listbox, the contents of the entry field are
# replaced with the text from the selected item. If the Combobox is
# editable, the user can type in the entry field and when <Return> is
# pressed the item will be inserted into the list.
#
# WISH LIST:
# This section lists possible future enhancements.
#
# Combobox 1.x:
# - convert bindings to bindtags.
#
# ----------------------------------------------------------------------
# ORIGINAL AUTHOR: John S. Sigler
# ----------------------------------------------------------------------
# CURRENT MAINTAINER: Chad Smith EMAIL: csmith@adc.com, itclguy@yahoo.com
#
# Copyright (c) 1995 John S. Sigler
# Copyright (c) 1997 Mitch Gorman
# ======================================================================
# Permission is hereby granted, without written agreement and without
# license or royalty fees, to use, copy, modify, and distribute this
# software and its documentation for any purpose, provided that the
# above copyright notice and the following two paragraphs appear in
# all copies of this software.
#
# IN NO EVENT SHALL THE COPYRIGHT HOLDER BE LIABLE TO ANY PARTY FOR
# DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
# ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN
# IF THE COPYRIGHT HOLDER HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
# DAMAGE.
#
# THE COPYRIGHT HOLDER SPECIFICALLY DISCLAIMS ANY WARRANTIES, INCLUDING,
# BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
# FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS
# ON AN "AS IS" BASIS, AND THE COPYRIGHT HOLDER HAS NO OBLIGATION TO
# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
# ======================================================================
#
# Default resources.
#
option add *Combobox.borderWidth 2 widgetDefault
option add *Combobox.labelPos wn widgetDefault
option add *Combobox.listHeight 150 widgetDefault
option add *Combobox.hscrollMode dynamic widgetDefault
option add *Combobox.vscrollMode dynamic widgetDefault
#
# Usual options.
#
itk::usual Combobox {
keep -background -borderwidth -cursor -foreground -highlightcolor \
-highlightthickness -insertbackground -insertborderwidth \
-insertofftime -insertontime -insertwidth -labelfont -popupcursor \
-selectbackground -selectborderwidth -selectforeground \
-textbackground -textfont
}
# ------------------------------------------------------------------
# COMBOBOX
# ------------------------------------------------------------------
itcl::class iwidgets::Combobox {
inherit iwidgets::Entryfield
constructor {args} {}
destructor {}
itk_option define -arrowrelief arrowRelief Relief raised
itk_option define -completion completion Completion true
itk_option define -dropdown dropdown Dropdown true
itk_option define -editable editable Editable true
itk_option define -grab grab Grab local
itk_option define -listheight listHeight Height 150
itk_option define -margin margin Margin 1
itk_option define -popupcursor popupCursor Cursor arrow
itk_option define -selectioncommand selectionCommand SelectionCommand {}
itk_option define -state state State normal
itk_option define -unique unique Unique true
public method clear {{component all}}
public method curselection {}
public method delete {component first {last {}}}
public method get {{index {}}}
public method getcurselection {}
public method insert {component index args}
public method invoke {}
public method justify {direction}
public method see {index}
public method selection {option first {last {}}}
public method size {}
public method sort {{mode ascending}}
public method xview {args}
public method yview {args}
protected method _addToList {}
protected method _createComponents {}
protected method _deleteList {first {last {}}}
protected method _deleteText {first {last {}}}
protected method _doLayout {{when later}}
protected method _drawArrow {}
protected method _dropdownBtnRelease {{window {}} {x 1} {y 1}}
protected method _ignoreNextBtnRelease {ignore}
protected method _next {}
protected method _packComponents {{when later}}
protected method _positionList {}
protected method _postList {}
protected method _previous {}
protected method _resizeArrow {}
protected method _selectCmd {}
protected method _toggleList {}
protected method _unpostList {}
protected method _commonBindings {}
protected method _dropdownBindings {}
protected method _simpleBindings {}
protected method _listShowing {{val ""}}
private method _bs {}
private method _lookup {key}
private method _slbListbox {}
private method _stateSelect {}
private variable _doit 0;
private variable _inbs 0;
private variable _inlookup 0;
private variable _currItem {}; ;# current selected item.
private variable _ignoreRelease false ;# next button release ignored.
private variable _isPosted false; ;# is the dropdown popped up.
private variable _repacking {} ;# non-null => _packComponents pending.
private variable _grab ;# used to restore grabs
private variable _next_prevFLAG 0 ;# Used in _lookup to fix SF Bug 501300
private common _listShowing
private common count 0
}
#
# Provide a lowercase access method for the Combobox class.
#
proc ::iwidgets::combobox {pathName args} {
uplevel ::iwidgets::Combobox $pathName $args
}
# ------------------------------------------------------------------
# CONSTRUCTOR
# ------------------------------------------------------------------
itcl::body iwidgets::Combobox::constructor {args} {
set _listShowing($this) 0
set _grab(window) ""
set _grab(status) ""
# combobox is different as all components are created
# after determining what the dropdown style is...
# configure args
eval itk_initialize $args
# create components that are dependent on options
# (Scrolledlistbox, arrow button) and pack them.
if {$count == 0} {
image create bitmap downarrow -data {
#define down_width 16
#define down_height 16
static unsigned char down_bits[] = {
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0xfc, 0x7f, 0xf8, 0x3f,
0xf0, 0x1f, 0xe0, 0x0f, 0xc0, 0x07, 0x80, 0x03,
0x00, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
};
}
image create bitmap uparrow -data {
#define up_width 16
#define up_height 16
static unsigned char up_bits[] = {
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x00,
0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, 0xf8, 0x0f,
0xfc, 0x1f, 0xfe, 0x3f, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
};
}
}
incr count
_doLayout
}
# ------------------------------------------------------------------
# DESTRUCTOR
# ------------------------------------------------------------------
itcl::body iwidgets::Combobox::destructor {} {
# catch any repacking that may be waiting for idle time
if {$_repacking != ""} {
after cancel $_repacking
}
incr count -1
if {$count == 0} {
image delete uparrow
image delete downarrow
}
}
# ================================================================
# OPTIONS
# ================================================================
# --------------------------------------------------------------------
# OPTION: -arrowrelief
#
# Relief style used on the arrow button.
# --------------------------------------------------------------------
itcl::configbody iwidgets::Combobox::arrowrelief {}
# --------------------------------------------------------------------
# OPTION: -completion
#
# Relief style used on the arrow button.
# --------------------------------------------------------------------
itcl::configbody iwidgets::Combobox::completion {
switch -- $itk_option(-completion) {
0 - no - false - off { }
1 - yes - true - on { }
default {
error "bad completion option \"$itk_option(-completion)\":\
should be boolean"
}
}
}
# --------------------------------------------------------------------
# OPTION: -dropdown
#
# Boolean which determines the Combobox style: dropdown or simple.
# Because the two style's lists reside in different toplevel widgets
# this is more complicated than it should be.
# --------------------------------------------------------------------
itcl::configbody iwidgets::Combobox::dropdown {
switch -- $itk_option(-dropdown) {
1 - yes - true - on {
if {[winfo exists $itk_interior.list]} {
set vals [$itk_component(list) get 0 end]
destroy $itk_component(list)
_doLayout
if [llength $vals] {
eval insert list end $vals
}
}
}
0 - no - false - off {
if {[winfo exists $itk_interior.popup.list]} {
set vals [$itk_component(list) get 0 end]
catch {destroy $itk_component(arrowBtn)}
destroy $itk_component(popup) ;# this deletes the list too
_doLayout
if [llength $vals] {
eval insert list end $vals
}
}
}
default {
error "bad dropdown option \"$itk_option(-dropdown)\":\
should be boolean"
}
}
}
# --------------------------------------------------------------------
# OPTION: -editable
#
# Boolean which allows/disallows user input to the entry field area.
# --------------------------------------------------------------------
itcl::configbody iwidgets::Combobox::editable {
switch -- $itk_option(-editable) {
1 - true - yes - on {
switch -- $itk_option(-state) {
normal {
$itk_component(entry) configure -state normal
}
}
}
0 - false - no - off {
$itk_component(entry) configure -state disabled
}
default {
error "bad editable option \"$itk_option(-editable)\":\
should be boolean"
}
}
}
# --------------------------------------------------------------------
# OPTION: -grab
#
# grab-state of megawidget
# --------------------------------------------------------------------
itcl::configbody iwidgets::Combobox::grab {
switch -- $itk_option(-grab) {
local { }
global { }
default {
error "bad grab value \"$itk_option(-grab)\":\
must be global or local"
}
}
}
# --------------------------------------------------------------------
# OPTION: -listheight
#
# Listbox height in pixels. (Need to integrate the scrolledlistbox
# -visibleitems option here - at least for simple listbox.)
# --------------------------------------------------------------------
itcl::configbody iwidgets::Combobox::listheight {}
# --------------------------------------------------------------------
# OPTION: -margin
#
# Spacer between the entry field and arrow button of dropdown style
# Comboboxes.
# --------------------------------------------------------------------
itcl::configbody iwidgets::Combobox::margin {
grid columnconfigure $itk_interior 0 -minsize $itk_option(-margin)
}
# --------------------------------------------------------------------
# OPTION: -popupcursor
#
# Set the cursor for the popup list.
# --------------------------------------------------------------------
itcl::configbody iwidgets::Combobox::popupcursor {}
# --------------------------------------------------------------------
# OPTION: -selectioncommand
#
# Defines the proc to be called when an item is selected in the list.
# --------------------------------------------------------------------
itcl::configbody iwidgets::Combobox::selectioncommand {}
# --------------------------------------------------------------------
# OPTION: -state
#
# overall state of megawidget
# --------------------------------------------------------------------
itcl::configbody iwidgets::Combobox::state {
switch -- $itk_option(-state) {
disabled {
$itk_component(entry) configure -state disabled
}
normal {
switch -- $itk_option(-editable) {
1 - true - yes - on {
$itk_component(entry) configure -state normal
}
0 - false - no - off {
$itk_component(entry) configure -state disabled
}
}
}
readonly {
$itk_component(entry) configure -state readonly
}
default {
error "bad state value \"$itk_option(-state)\":\
must be normal or disabled"
}
}
if {[info exists itk_component(arrowBtn)]} {
$itk_component(arrowBtn) configure -state $itk_option(-state)
}
}
# --------------------------------------------------------------------
# OPTION: -unique
#
# Boolean which disallows/allows adding duplicate items to the listbox.
# --------------------------------------------------------------------
itcl::configbody iwidgets::Combobox::unique {
# boolean error check
switch -- $itk_option(-unique) {
1 - true - yes - on { }
0 - false - no - off { }
default {
error "bad unique value \"$itk_option(-unique)\":\
should be boolean"
}
}
}
# =================================================================
# METHODS
# =================================================================
# ------------------------------------------------------
# PUBLIC METHOD: clear ?component?
#
# Remove all elements from the listbox, all contents
# from the entry component, or both (if all).
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::clear {{component all}} {
switch -- $component {
entry {
iwidgets::Entryfield::clear
}
list {
delete list 0 end
}
all {
delete list 0 end
iwidgets::Entryfield::clear
}
default {
error "bad Combobox component \"$component\":\
must be entry, list, or all."
}
}
return
}
# ------------------------------------------------------
# PUBLIC METHOD: curselection
#
# Return the current selection index.
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::curselection {} {
return [$itk_component(list) curselection]
}
# ------------------------------------------------------
# PUBLIC METHOD: delete component first ?last?
#
# Delete an item or items from the listbox OR delete
# text from the entry field. First argument determines
# which component deletion occurs in - valid values are
# entry or list.
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::delete {component first {last {}}} {
switch -- $component {
entry {
if {$last == {}} {
set last [expr {$first + 1}]
}
iwidgets::Entryfield::delete $first $last
}
list {
_deleteList $first $last
}
default {
error "bad Combobox component \"$component\":\
must be entry or list."
}
}
}
# ------------------------------------------------------
# PUBLIC METHOD: get ?index?
#
#
# Retrieve entry contents if no args OR use args as list
# index and retrieve list item at index .
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::get {{index {}}} {
# no args means to get the current text in the entry field area
if {$index == {}} {
iwidgets::Entryfield::get
} else {
eval $itk_component(list) get $index
}
}
# ------------------------------------------------------
# PUBLIC METHOD: getcurselection
#
# Return currently selected item in the listbox. Shortcut
# version of get curselection command combination.
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::getcurselection {} {
return [$itk_component(list) getcurselection]
}
# ------------------------------------------------------------------
# PUBLIC METHOD: invoke
#
# Pops up or down a dropdown combobox.
#
# ------------------------------------------------------------------
itcl::body iwidgets::Combobox::invoke {} {
if {$itk_option(-dropdown)} {
return [_toggleList]
}
return
}
# ------------------------------------------------------------
# PUBLIC METHOD: insert comonent index string ?string ...?
#
# Insert an item into the listbox OR text into the entry area.
# Valid component names are entry or list.
#
# ------------------------------------------------------------
itcl::body iwidgets::Combobox::insert {component index args} {
set nargs [llength $args]
if {$nargs == 0} {
error "no value given for parameter \"string\" in function\
\"Combobox::insert\""
}
switch -- $component {
entry {
if { $nargs > 1} {
error "called function \"Combobox::insert entry\"\
with too many arguments"
} else {
if {$itk_option(-state) == "normal"} {
eval iwidgets::Entryfield::insert $index $args
[itcl::code $this _lookup ""]
}
}
}
list {
if {$itk_option(-state) == "normal"} {
eval $itk_component(list) insert $index $args
}
}
default {
error "bad Combobox component \"$component\": must\
be entry or list."
}
}
}
# ------------------------------------------------------
# PUBLIC METHOD: justify direction
#
# Wrapper for justifying the listbox items in one of
# 4 directions: top, bottom, left, or right.
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::justify {direction} {
return [$itk_component(list) justify $direction]
}
# ------------------------------------------------------------------
# PUBLIC METHOD: see index
#
# Adjusts the view such that the element given by index is visible.
# ------------------------------------------------------------------
itcl::body iwidgets::Combobox::see {index} {
return [$itk_component(list) see $index]
}
# ------------------------------------------------------------------
# PUBLIC METHOD: selection option first ?last?
#
# Adjusts the selection within the listbox and changes the contents
# of the entry component to be the value of the selected list item.
# ------------------------------------------------------------------
itcl::body iwidgets::Combobox::selection {option first {last {}}} {
# thin wrap
if {$option == "set"} {
$itk_component(list) selection clear 0 end
$itk_component(list) selection set $first
set rtn ""
} else {
set rtn [eval $itk_component(list) selection $option $first $last]
}
set _currItem $first
# combobox additions
set theText [getcurselection]
if {$theText != [$itk_component(entry) get]} {
clear entry
if {$theText != ""} {
insert entry 0 $theText
}
}
return $rtn
}
# ------------------------------------------------------------------
# PUBLIC METHOD: size
#
# Returns a decimal string indicating the total number of elements
# in the listbox.
# ------------------------------------------------------------------
itcl::body iwidgets::Combobox::size {} {
return [$itk_component(list) size]
}
# ------------------------------------------------------
# PUBLIC METHOD: sort ?mode?
#
# Sort the current list in either "ascending" or "descending" order.
#
# jss: how should i handle selected items?
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::sort {{mode ascending}} {
$itk_component(list) sort $mode
# return [$itk_component(list) sort $mode]
}
# ------------------------------------------------------------------
# PUBLIC METHOD: xview ?arg arg ...?
#
# Change or query the vertical position of the text in the list box.
# ------------------------------------------------------------------
itcl::body iwidgets::Combobox::xview {args} {
return [eval $itk_component(list) xview $args]
}
# ------------------------------------------------------------------
# PUBLIC METHOD: yview ?arg arg ...?
#
# Change or query the horizontal position of the text in the list box.
# ------------------------------------------------------------------
itcl::body iwidgets::Combobox::yview {args} {
return [eval $itk_component(list) yview $args]
}
# ------------------------------------------------------
# PROTECTED METHOD: _addToList
#
# Add the current item in the entry to the listbox.
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::_addToList {} {
set input [get]
if {$input != ""} {
if {$itk_option(-unique)} {
# if item is already in list, select it and exit
set item [lsearch -exact [$itk_component(list) get 0 end] $input]
if {$item != -1} {
selection clear 0 end
if {$item != {}} {
selection set $item $item
set _currItem $item
}
return
}
}
# add the item to end of list
selection clear 0 end
insert list end $input
selection set end end
}
}
# ------------------------------------------------------
# PROTECTED METHOD: _createComponents
#
# Create deferred combobox components and add bindings.
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::_createComponents {} {
if {$itk_option(-dropdown)} {
# --- build a dropdown combobox ---
# make the arrow childsite be on the right hand side
#-------------------------------------------------------------
# BUG FIX: csmith (Chad Smith: csmith@adc.com), 3/4/99
#-------------------------------------------------------------
# The following commented line of code overwrites the -command
# option when passed into the constructor. The order of calls
# in the constructor is:
# 1) eval itk_initalize $args (initializes -command)
# 2) _doLayout
# 3) _createComponents (overwrites -command)
# The solution is to only set the -command option if it hasn't
# already been set. The following 4 lines of code do this.
#-------------------------------------------------------------
# ** configure -childsitepos e -command [code $this _addToList]
#-------------------------------------------------------------
configure -childsitepos e
if ![llength [cget -command]] {
configure -command [itcl::code $this _addToList]
}
# arrow button to popup the list
itk_component add arrowBtn {
button $itk_interior.arrowBtn -borderwidth 2 \
-width 15 -height 15 -image downarrow \
-command [itcl::code $this _toggleList] -state $itk_option(-state)
} {
keep -background -borderwidth -cursor -state \
-highlightcolor -highlightthickness
rename -relief -arrowrelief arrowRelief Relief
rename -highlightbackground -background background Background
}
# popup list container
itk_component add popup {
toplevel $itk_interior.popup
} {
keep -background -cursor
}
wm withdraw $itk_interior.popup
# the listbox
itk_component add list {
iwidgets::Scrolledlistbox $itk_interior.popup.list -exportselection no \
-vscrollmode dynamic -hscrollmode dynamic -selectmode browse
} {
keep -background -borderwidth -cursor -foreground \
-highlightcolor -highlightthickness \
-hscrollmode -selectbackground \
-selectborderwidth -selectforeground -textbackground \
-textfont -vscrollmode
rename -height -listheight listHeight Height
rename -cursor -popupcursor popupCursor Cursor
}
# mode specific bindings
_dropdownBindings
# Ugly hack to avoid tk buglet revealed in _dropdownBtnRelease where
# relief is used but not set in scrollbar.tcl.
global tkPriv
set tkPriv(relief) raise
} else {
# --- build a simple combobox ---
configure -childsitepos s
itk_component add list {
iwidgets::Scrolledlistbox $itk_interior.list -exportselection no \
-vscrollmode dynamic -hscrollmode dynamic
} {
keep -background -borderwidth -cursor -foreground \
-highlightcolor -highlightthickness \
-hscrollmode -selectbackground \
-selectborderwidth -selectforeground -textbackground \
-textfont -visibleitems -vscrollmode
rename -height -listheight listHeight Height
}
# add mode specific bindings
_simpleBindings
}
# popup cursor applies only to the list within the combobox
configure -popupcursor $itk_option(-popupcursor)
# add mode independent bindings
_commonBindings
}
# ------------------------------------------------------
# PROTECTED METHOD: _deleteList first ?last?
#
# Delete an item or items from the listbox. Called via
# "delete list args".
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::_deleteList {first {last {}}} {
if {$last == {}} {
set last $first
}
$itk_component(list) delete $first $last
# remove the item if it is no longer in the list
set text [$this get]
if {$text != ""} {
set index [lsearch -exact [$itk_component(list) get 0 end] $text ]
if {$index == -1} {
clear entry
}
}
return
}
# ------------------------------------------------------
# PROTECTED METHOD: _deleteText first ?last?
#
# Renamed Entryfield delete method. Called via "delete entry args".
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::_deleteText {first {last {}}} {
$itk_component(entry) configure -state normal
set rtrn [delete $first $last]
switch -- $itk_option(-editable) {
0 - false - no - off {
$itk_component(entry) configure -state disabled
}
}
return $rtrn
}
# ------------------------------------------------------
# PROTECTED METHOD: _doLayout ?when?
#
# Call methods to create and pack the Combobox components.
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::_doLayout {{when later}} {
_createComponents
_packComponents $when
}
# ------------------------------------------------------
# PROTECTED METHOD: _drawArrow
#
# Draw the arrow button. Determines packing according to
# -labelpos.
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::_drawArrow {} {
set flip false
set relief ""
set fg [cget -foreground]
if {$_isPosted} {
set flip true
set relief "-relief sunken"
} else {
set relief "-relief $itk_option(-arrowrelief)"
}
if {$flip} {
#
# draw up arrow
#
eval $itk_component(arrowBtn) configure -image uparrow $relief
} else {
#
# draw down arrow
#
eval $itk_component(arrowBtn) configure -image downarrow $relief
}
}
# ------------------------------------------------------
# PROTECTED METHOD: _dropdownBtnRelease window x y
#
# Event handler for button releases while a dropdown list
# is posted.
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::_dropdownBtnRelease {{window {}} {x 1} {y 1}} {
# if it's a scrollbar then ignore the release
if {($window == [$itk_component(list) component vertsb]) ||
($window == [$itk_component(list) component horizsb])} {
return
}
# 1st release allows list to stay up unless we are in listbox
if {$_ignoreRelease} {
_ignoreNextBtnRelease false
return
}
# should I use just the listbox or also include the scrollbars
if { ($x >= 0) && ($x < [winfo width [_slbListbox]])
&& ($y >= 0) && ($y < [winfo height [_slbListbox]])} {
_stateSelect
}
_unpostList
# execute user command
if {$itk_option(-selectioncommand) != ""} {
uplevel #0 $itk_option(-selectioncommand)
}
}
# ------------------------------------------------------
# PROTECTED METHOD: _ignoreNextBtnRelease ignore
#
# Set private variable _ignoreRelease. If this variable
# is true then the next button release will not remove
# a dropdown list.
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::_ignoreNextBtnRelease {ignore} {
set _ignoreRelease $ignore
}
# ------------------------------------------------------
# PROTECTED METHOD: _next
#
# Select the next item in the list.
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::_next {} {
set _next_prevFLAG 1
if {[size] <= 1} {
return
}
set i [curselection]
if {($i == {}) || ($i == ([size]-1)) } {
set i 0
} else {
incr i
}
selection clear 0 end
selection set $i $i
see $i
set _currItem $i
}
# ------------------------------------------------------
# PROTECTED METHOD: _packComponents ?when?
#
# Pack the components of the combobox and add bindings.
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::_packComponents {{when later}} {
if {$when == "later"} {
if {$_repacking == ""} {
set _repacking [after idle [itcl::code $this _packComponents now]]
return
}
} elseif {$when != "now"} {
error "bad option \"$when\": should be now or later"
}
if {$itk_option(-dropdown)} {
grid configure $itk_component(list) -row 1 -column 0 -sticky news
_resizeArrow
grid config $itk_component(arrowBtn) -row 0 -column 1 -sticky nsew
} else {
# size and pack list hack
grid configure $itk_component(entry) -row 0 -column 0 -sticky ew
grid configure $itk_component(efchildsite) -row 1 -column 0 -sticky nsew
grid configure $itk_component(list) -row 0 -column 0 -sticky nsew
grid rowconfigure $itk_component(efchildsite) 1 -weight 1
grid columnconfigure $itk_component(efchildsite) 0 -weight 1
}
set _repacking ""
}
# ------------------------------------------------------
# PROTECTED METHOD: _positionList
#
# Determine the position (geometry) for the popped up list
# and map it to the screen.
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::_positionList {} {
set x [winfo rootx $itk_component(entry) ]
set y [expr {[winfo rooty $itk_component(entry) ] + \
[winfo height $itk_component(entry) ]}]
set w [winfo width $itk_component(entry) ]
set h [winfo height [_slbListbox] ]
set sh [winfo screenheight .]
if {(($y+$h) > $sh) && ($y > ($sh/2))} {
set y [expr {[winfo rooty $itk_component(entry) ] - $h}]
}
$itk_component(list) configure -width $w
wm overrideredirect $itk_component(popup) 0
wm geometry $itk_component(popup) +$x+$y
wm overrideredirect $itk_component(popup) 1
}
# ------------------------------------------------------
# PROTECTED METHOD: _postList
#
# Pop up the list in a dropdown style Combobox.
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::_postList {} {
if {[$itk_component(list) size] == ""} {
return
}
set _isPosted true
_positionList
# map window and do a grab
wm deiconify $itk_component(popup)
_listShowing -wait
# Added by csmith, 12/19/00. Thanks to Erik Leunissen for
# finding this problem. We need to restore any previous
# grabs after the dropdown listbox is withdrawn. To do this,
# save the currently grabbed window. It is then restored in
# the _unpostList method.
set _grab(window) [::grab current]
if {$_grab(window) != ""} {
set _grab(status) [::grab status $_grab(window)]
}
# Now grab the dropdown listbox.
if {$itk_option(-grab) == "global"} {
::grab -global $itk_component(popup)
} else {
::grab $itk_component(popup)
}
raise $itk_component(popup)
focus $itk_component(popup)
_drawArrow
# Added by csmith, 10/26/00. This binding keeps the listbox
# from staying mapped if the window in which the combobox
# is packed is iconified.
bind $itk_component(entry) <Unmap> [itcl::code $this _unpostList]
}
# ------------------------------------------------------
# PROTECTED METHOD: _previous
#
# Select the previous item in the list. Wraps at front
# and end of list.
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::_previous {} {
set _next_prevFLAG 1
if {[size] <= 1} {
return
}
set i [curselection]
if {$i == "" || $i == 0} {
set i [expr {[size] - 1}]
} else {
incr i -1
}
selection clear 0 end
selection set $i $i
see $i
set _currItem $i
}
# ------------------------------------------------------
# PROTECTED METHOD: _resizeArrow
#
# Recalculate the arrow button size and then redraw it.
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::_resizeArrow {} {
set bw [expr {[$itk_component(arrowBtn) cget -borderwidth]+ \
[$itk_component(arrowBtn) cget -highlightthickness]}]
set newHeight [expr {[winfo reqheight $itk_component(entry)]-(2*$bw) - 2}]
$itk_component(arrowBtn) configure -width $newHeight -height $newHeight
_drawArrow
}
# ------------------------------------------------------
# PROTECTED METHOD: _selectCmd
#
# Called when list item is selected to insert new text
# in entry, and call user -command callback if defined.
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::_selectCmd {} {
$itk_component(entry) configure -state normal
set _currItem [$itk_component(list) curselection]
set item [$itk_component(list) getcurselection]
clear entry
$itk_component(entry) insert 0 $item
switch -- $itk_option(-editable) {
0 - false - no - off {
$itk_component(entry) configure -state disabled
}
}
}
# ------------------------------------------------------
# PROTECTED METHOD: _toggleList
#
# Post or unpost the dropdown listbox (toggle).
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::_toggleList {} {
if {[winfo ismapped $itk_component(popup)] } {
_unpostList
} else {
_postList
}
}
# ------------------------------------------------------
# PROTECTED METHOD: _unpostList
#
# Unmap the listbox (pop it down).
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::_unpostList {} {
# Determine if event occured in the scrolledlistbox and, if it did,
# don't unpost it. (A selection in the list unposts it correctly and
# in the scrollbar we don't want to unpost it.)
set x [winfo x $itk_component(list)]
set y [winfo y $itk_component(list)]
set w [winfo width $itk_component(list)]
set h [winfo height $itk_component(list)]
wm withdraw $itk_component(popup)
::grab release $itk_component(popup)
# Added by csmith, 12/19/00. Thanks to Erik Leunissen for finding
# this problem. We need to restore any previous grabs when the
# dropdown listbox is unmapped.
if {$_grab(window) != ""} {
if {$_grab(status) == "global"} {
::grab -global $_grab(window)
} else {
::grab $_grab(window)
}
set _grab(window) ""
set _grab(status) ""
}
# Added by csmith, 10/26/00. This binding resets the binding
# created in _postList - see that method for further details.
bind $itk_component(entry) <Unmap> {}
set _isPosted false
$itk_component(list) selection clear 0 end
if {$_currItem != {}} {
$itk_component(list) selection set $_currItem $_currItem
$itk_component(list) activate $_currItem
}
switch -- $itk_option(-editable) {
1 - true - yes - on {
$itk_component(entry) configure -state normal
}
0 - false - no - off {
$itk_component(entry) configure -state disabled
}
}
_drawArrow
update
}
# ------------------------------------------------------
# PROTECTED METHOD: _commonBindings
#
# Bindings that are used by both simple and dropdown
# style Comboboxes.
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::_commonBindings {} {
bind $itk_component(entry) <KeyPress-BackSpace> [itcl::code $this _bs]
bind $itk_component(entry) <KeyRelease> [itcl::code $this _lookup %K]
bind $itk_component(entry) <Down> [itcl::code $this _next]
bind $itk_component(entry) <Up> [itcl::code $this _previous]
bind $itk_component(entry) <Control-n> [itcl::code $this _next]
bind $itk_component(entry) <Control-p> [itcl::code $this _previous]
bind [_slbListbox] <Control-n> [itcl::code $this _next]
bind [_slbListbox] <Control-p> [itcl::code $this _previous]
}
# ------------------------------------------------------
# PROTECTED METHOD: _dropdownBindings
#
# Bindings used only by the dropdown type Combobox.
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::_dropdownBindings {} {
bind $itk_component(popup) <Escape> [itcl::code $this _unpostList]
bind $itk_component(popup) <space> \
"[itcl::code $this _stateSelect]; [itcl::code $this _unpostList]"
bind $itk_component(popup) <Return> \
"[itcl::code $this _stateSelect]; [itcl::code $this _unpostList]"
bind $itk_component(popup) <ButtonRelease-1> \
[itcl::code $this _dropdownBtnRelease %W %x %y]
bind $itk_component(list) <Map> \
[itcl::code $this _listShowing 1]
bind $itk_component(list) <Unmap> \
[itcl::code $this _listShowing 0]
# once in the listbox, we drop on the next release (unless in scrollbar)
bind [_slbListbox] <Enter> \
[itcl::code $this _ignoreNextBtnRelease false]
bind $itk_component(arrowBtn) <3> [itcl::code $this _next]
bind $itk_component(arrowBtn) <Shift-3> [itcl::code $this _previous]
bind $itk_component(arrowBtn) <Down> [itcl::code $this _next]
bind $itk_component(arrowBtn) <Up> [itcl::code $this _previous]
bind $itk_component(arrowBtn) <Control-n> [itcl::code $this _next]
bind $itk_component(arrowBtn) <Control-p> [itcl::code $this _previous]
bind $itk_component(arrowBtn) <Shift-Down> [itcl::code $this _toggleList]
bind $itk_component(arrowBtn) <Shift-Up> [itcl::code $this _toggleList]
bind $itk_component(arrowBtn) <Return> [itcl::code $this _toggleList]
bind $itk_component(arrowBtn) <space> [itcl::code $this _toggleList]
bind $itk_component(entry) <Configure> [itcl::code $this _resizeArrow]
bind $itk_component(entry) <Shift-Down> [itcl::code $this _toggleList]
bind $itk_component(entry) <Shift-Up> [itcl::code $this _toggleList]
}
# ------------------------------------------------------
# PROTECTED METHOD: _simpleBindings
#
# Bindings used only by the simple type Comboboxes.
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::_simpleBindings {} {
bind [_slbListbox] <ButtonRelease-1> [itcl::code $this _stateSelect]
bind [_slbListbox] <space> [itcl::code $this _stateSelect]
bind [_slbListbox] <Return> [itcl::code $this _stateSelect]
bind $itk_component(entry) <Escape> ""
bind $itk_component(entry) <Shift-Down> ""
bind $itk_component(entry) <Shift-Up> ""
bind $itk_component(entry) <Configure> ""
}
# ------------------------------------------------------
# PROTECTED METHOD: _listShowing ?val?
#
# Used instead of "tkwait visibility" to make sure that
# the dropdown list is visible. Whenever the list gets
# mapped or unmapped, this method is called to keep
# track of it. When it is called with the value "-wait",
# it waits for the list to be mapped.
# ------------------------------------------------------
itcl::body iwidgets::Combobox::_listShowing {{val ""}} {
if {$val == ""} {
return $_listShowing($this)
} elseif {$val == "-wait"} {
while {!$_listShowing($this)} {
tkwait variable [itcl::scope _listShowing($this)]
}
return
}
set _listShowing($this) $val
}
# ------------------------------------------------------
# PRIVATE METHOD: _slbListbox
#
# Access the tk listbox window out of the scrolledlistbox.
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::_slbListbox {} {
return [$itk_component(list) component listbox]
}
# ------------------------------------------------------
# PRIVATE METHOD: _stateSelect
#
# only allows a B1 release in the listbox to have an effect if -state is
# normal.
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::_stateSelect {} {
switch -- $itk_option(-state) {
normal {
[itcl::code $this _selectCmd]
}
}
}
# ------------------------------------------------------
# PRIVATE METHOD: _bs
#
# A part of the auto-completion code, this function sets a flag when the
# Backspace key is hit and there is a selection in the entry field.
# Note that it's probably buggy to assume that a selection being present
# means that that selection came from auto-completion.
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::_bs {} {
#
# exit if completion is turned off
#
switch -- $itk_option(-completion) {
0 - no - false - off {
return
}
}
#
# critical section flag. it ain't perfect, but for most usage it'll
# keep us from being in this code "twice" at the same time
# (auto-repeated keystrokes are a pain!)
#
if {$_inbs} {
return
} else {
set _inbs 1
}
#
# set the _doit flag if there is a selection set in the entry field
#
set _doit 0
if [$itk_component(entry) selection present] {
set _doit 1
}
#
# clear the semaphore and return
#
set _inbs 0
}
# ------------------------------------------------------
# PRIVATE METHOD: _lookup
#
# handles auto-completion of text typed (or insert'd) into the entry field.
#
# ------------------------------------------------------
itcl::body iwidgets::Combobox::_lookup {key} {
#
# Don't process auto-completion stuff if navigation key was released
# Fixes SF bug 501300
#
if {$_next_prevFLAG} {
set _next_prevFLAG 0
return
}
#
# exit if completion is turned off
#
switch -- $itk_option(-completion) {
0 - no - false - off {
return
}
}
#
# critical section flag. it ain't perfect, but for most usage it'll
# keep us from being in this code "twice" at the same time
# (auto-repeated keystrokes are a pain!)
#
if {$_inlookup} {
return
} else {
set _inlookup 1
}
#
# if state of megawidget is disabled, or the entry is not editable,
# clear the semaphore and exit
#
if {$itk_option(-state) == "disabled" \
|| [lsearch {on 1 true yes} $itk_option(-editable)] == -1} {
set _inlookup 0
return
}
#
# okay, *now* we can get to work
# the _bs function is called on keyPRESS of BackSpace, and will set
# the _doit flag if there's a selection set in the entryfield. If
# there is, we're assuming that it's generated by completion itself
# (this is probably a Bad Assumption), so we'll want to whack the
# selected text, as well as the character immediately preceding the
# insertion cursor.
#
if {$key == "BackSpace"} {
if {$_doit} {
set first [expr {[$itk_component(entry) index insert] -1}]
$itk_component(entry) delete $first end
$itk_component(entry) icursor $first
}
}
#
# get the text left in the entry field, and its length. if
# zero-length, clear the selection in the listbox, clear the
# semaphore, and boogie.
#
set text [get]
set len [string length $text]
if {$len == 0} {
$itk_component(list) selection clear 0 end
set _inlookup 0
return
}
# No need to do lookups for Shift keys or Arrows. The up/down
# arrow keys should walk up/down the listbox entries.
switch $key {
Shift_L - Shift_R - Up - Down - Left - Right {
set _inlookup 0
return
}
default { }
}
# Added by csmith 12/11/01 to resolve SF ticket #474817. It's an unusual
# circumstance, but we need to make sure the character passed into this
# method matches the last character in the entry's text string. It's
# possible to type fast enough that the _lookup method gets invoked
# *after* multiple characters have been typed and *before* the first
# character has been processed. For example, you can type "bl" very
# quickly, and by the time the interpreter processes "b", the "l" has
# already been placed in the entry field. This causes problems as noted
# in the SF ticket.
#
# Thus, if the character currently being processed does not match the
# last character in the entry field, reset the _inlookup flag and return.
# Also, note that we're only concerned with single characters here, not
# keys such as backspace, delete, etc.
if {$key != [string range $text end end] && [string match ? $key]} {
set _inlookup 0
return
}
#
# okay, so we have to do a lookup. find the first match in the
# listbox to the text we've got in the entry field (glob).
# if one exists, clear the current listbox selection, and set it to
# the one we just found, making that one visible in the listbox.
# then, pick off the text from the listbox entry that hadn't yet been
# entered into the entry field. we need to tack that text onto the
# end of the entry field, select it, and then set the insertion cursor
# back to just before the point where we just added that text.
# if one didn't exist, then just clear the listbox selection
#
set item [lsearch [$itk_component(list) get 0 end] "$text*" ]
if {$item != -1} {
$itk_component(list) selection clear 0 end
$itk_component(list) selection set $item $item
see $item
set remainder [string range [$itk_component(list) get $item] $len end]
$itk_component(entry) insert end $remainder
$itk_component(entry) selection range $len end
$itk_component(entry) icursor $len
} else {
$itk_component(list) selection clear 0 end
}
#
# clear the semaphore and return
#
set _inlookup 0
return
}