Tcl-Tk-Tkwidget-Tix

 view release on metacpan or  search on metacpan

library/ComboBox.tcl  view on Meta::CPAN

# -*- 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 ""}

library/ComboBox.tcl  view on Meta::CPAN

    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

library/ComboBox.tcl  view on Meta::CPAN

	<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} {