A little list selector


Richard Suchenwirth 2002-04-03: Here is another mini-megawidget: two listboxes (with scrollbar), where items from the left listbox ("choices") can be copied to the right listbox by double-clicking on them.


WikiDbImage listbox2.jpg

Delete an item from the right listbox ("chosen") by double clicking. The content of the "chosen" list can be retrieved at any time in a linked global variable; also you can change the "choices" by assigning to another linked list variable. A vertical button bar offers "->" (take one), "<-" (remove one); ">>" (take all) and "<<" (remove all) actions. You can suppress the button bar by specifying -buttons 0.

Options aren't very many yet; you can select whether a choice can be added multiply or not with the -unique {0|1} switch, specify -listvar and -selvar, and determine the background color.

Reconfiguring isn't implemented either (yet) - feel free to add more bells and whistles!

MG 2004-04-29: The Iwidgets package also offers one of these, in the form of ::iwidgets::disjointlistbox::. The Iwidgets version is less attractive though (IMHO; I prefer the add/remove buttons where Richard put them), and also doesn't offer the (Add/Remove) All feature.

KPV: Also, tklib has swaplist.

MBS: Also see swaptablelist

proc listbox2 {w args} {
    array set opt {
        -listvar "" -selvar "" -bg white -unique 1 -buttons 1
    array set opt $args
    frame $w
    listbox $w.0 -yscrollcommand [list $w.y0 set] -listvar $opt(-listvar)\
        -bg $opt(-bg)
    scrollbar $w.y0 -ori vert -command [list $w.0 yview]
    if {$opt(-buttons)} {
        buttons $w.b [list \
          -> "ladd $opt(-selvar) \[selection get\]"     \
          <- "lremove $opt(-selvar) \[selection get\]"  \
          >> "set $opt(-selvar) \[set $opt(-listvar)\]" \
          << "set $opt(-selvar) {}"]
    listbox $w.1 -yscrollcommand [list $w.y1 set] -listvar $opt(-selvar)\
        -bg $opt(-bg)
    scrollbar $w.y1 -ori vert -command [list $w.1 yview]
    if {$opt(-unique)} {
        bind $w.0 <Double-1> "ladd $opt(-selvar) \[selection get\]"
    } else {
        bind $w.0 <Double-1> "lappend $opt(-selvar) \[selection get\]"
    bind $w.1 <Double-1> "lremove $opt(-selvar) \[selection get\]"
    set children [winfo children $w]
    eval grid $children -sticky news
    grid rowconfigure    $w 0 -weight 1
    grid columnconfigure $w 0 -weight 1
    grid columnconfigure $w [expr {[llength $children]-2}] -weight 1
    set w

proc buttons {w buttonlist args} {
    frame $w
    foreach {label command} $buttonlist {
        button $w.b$label -text $label -command $command
    eval pack [winfo children $w] -side top -fill x -padx 0
    set w

proc ladd {listName element} {
    upvar 1 $listName list
    if {[lsearch $list $element]<0} {lappend list $element}
    set list

proc lremove {listName element} {
    upvar 1 $listName list
    set pos [lsearch $list $element]
    set list [lreplace $list $pos $pos]

#----------------------------------------------demo and test:
if {[file tail [info script]] == [file tail $argv0]} {
    set testlist {foo bar grill baz and some more words}
    pack [label    .0 -text "Make your selection:"]
    pack [listbox2 .x -listvar testlist -selvar selected] -expand 1 -fill both
    bind . <Return> {puts $selected}