[WJG] (25/10/18) There ares time when a user needs to select a range of options from a list of alternatives. This simple Gnocl based megawidget allows a range choices to be presented from which selections made interactively through a dialog type window. Once the choices are confirmed, the appropriate lists are returned.
[gnocl_list_picker_img]
======
# !/bin/sh
# the next line restarts using tclsh \
exec tclsh "$0" "$@"
package require Gnocl
package provide picker
namespace eval gnocl::picker {}
set gnocl::picker::opts { -data -name -alias -tooltip }
set gnocl::picker::cmds { configure cget class opts cmds delete }
lappend gnocl::picker::opts -fromLabel -toLabel -fromList -toList -reorderable -autoSort
lappend gnocl::picker::cmds getSelection getUnselected
# component tooltips
set gnocl::picker::tooltips(list1) "Available choices"
set gnocl::picker::tooltips(list2) "Current selection"
set gnocl::picker::tooltips(but1) "Add item to selection"
set gnocl::picker::tooltips(but2) "Deselect item"
set gnocl::picker::tooltips(but3) "Reset lists to initial values"
proc gnocl::picker::cmd { wid {cmd ""} args } {
if { $cmd == "" } { return [string trim $wid _] }
gnocl::picker::check $cmd
# get list of members
foreach { w id } $gnocl::picker::components($wid) { set $w $id }
# apply the commands
switch -- $cmd {
opts -
cmds { return [ lsort [ set gnocl::picker::$cmd ] ] }
class { return "picker"}
delete { $wid delete }
configure -
cget { {*}"gnocl::picker::$cmd $wid $args" }
getSelection { return [$list2 getFullList] }
getUnselected { return [$list1 getFullList] }
reset { gnocl::picker::reset }
}
}
proc gnocl::picker::cget { wid opt } {
gnocl::picker::check $opt
# get list of members
foreach { w id } $gnocl::picker::components($wid) { set $w $id }
# apply according to each component
switch -- $opt {
-toList { return $::gnocl::picker::toList($wid) }
-fromList { return $::gnocl::picker::fromList($wid) }
-name { return $::gnocl::picker::name($wid) }
-tooltip -
-data { return [ $wid cget $opt ] }
-alias { return [lindex [split [interp aliases]] 1] }
}
}
proc gnocl::picker::check { opts } {
# test for a valid options
if { [string first - $opts ] >= 0 } {
foreach { opt val } $opts {
if { [string first $opt $gnocl::picker::opts] == -1 } {
append errmsg [string repeat - 17]\n
append errmsg "ERROR! Invalid gnocl::gnocl::picker option \"$opt\".\n"
append errmsg "Should be one of: [lsort $gnocl::picker::opts]\n"
append errmsg [string repeat - 17]\n
error $errmsg
}
}
return
}
# test for valid command
foreach { cmd } $opts {
if { [string first $cmd $gnocl::picker::cmds] == -1 } {
append errmsg [string repeat - 17]\n
append errmsg "ERROR! Invalid gnocl::gnocl::picker command \"$cmd\".\n"
append errmsg "Should be one of: [lsort $gnocl::picker::cmds]\n"
append errmsg [string repeat - 17]\n
error $errmsg
}
}
}
proc gnocl::picker::configure { wid args } {
gnocl::picker::check $args
# recover list of widget components
foreach {w id} $::gnocl::picker::components($wid) {set $w $id}
# apply new options
foreach {a b} $args {
# apply according to each component
switch -- $a {
-tooltip { $wid configure $a $b }
-alias { interp alias {} $b {} [string trim $wid _] }
-name { set ::gnocl::picker::name($wid) $b }
-autoSort { set ::gnocl::picker::autoSort($wid) $b }
-reorderable { $list1 configure -reorderable $b ; $list2 configure -reorderable $b }
-fromLabel { $lab1 configure -text $b }
-fromList { set b [lsort -unique $b] ; $list1 add $b ; set ::gnocl::picker::fromList($wid) $b }
-toList { set b [lsort -unique $b] ; $list2 add $b ; set ::gnocl::picker::toList($wid) $b }
-toLabel { $lab2 configure -text $b }
-onClicked { #$but_1 configure $a $b }
-data { $wid configure $a $b ; #$but_1 configure $a $b }
}
}
$list1 setSelection 0
}
proc gnocl::picker::sort { args } {
foreach w $args {
set vals [$w getFullList]
$w erase 0 end
$w add [lsort $vals]
}
}
proc gnocl::picker::delete { wid } {
$wid delete
array unset gnocl::picker::name $wid
array unset gnocl::picker::components $wid
}
proc gnocl::picker::construct {} {
# create object container
set container [ gnocl::box ]
# create components
set vbox1 [gnocl::vBox -padding 5 -widthGroup wg_$container ]
set vbox2 [gnocl::vBox -padding 5 ]
set vbox3 [gnocl::vBox -padding 5 -widthGroup wg_$container ]
set lab1 [gnocl::label -useMarkup 1 -text "FROM LIST" -yPad 4 ]
set list1 [gnocl::list \
-types string \
-titles "ITEMS" \
-headersVisible 0 \
-tooltip $gnocl::picker::tooltips(list1) ]
$vbox1 add $lab1
$vbox1 add $list1 -fill {1 1} -expand 1
set arrow1 [gnocl::button \
-sensitive 1 \
-icon %#GoForward \
-widthRequest 50 \
-data ${container}_ \
-onClicked { gnocl::picker::onClicked %d ADD } \
-tooltip $gnocl::picker::tooltips(but1) ]
set arrow2 [gnocl::button \
-sensitive 0 \
-icon %#GoBack \
-widthRequest 50 \
-data ${container}_ \
-onClicked { gnocl::picker::onClicked %d REMOVE } \
-tooltip $gnocl::picker::tooltips(but2) ]
set reset [gnocl::button \
-icon %#Home \
-widthRequest 50 \
-data ${container}_ \
-onClicked { gnocl::picker::reset %d } \
-tooltip $gnocl::picker::tooltips(but3) ]
$vbox2 add $arrow1 -fill {1 1} -align 0.25
$vbox2 add $arrow2
$vbox2 add [gnocl::separator] -padding 10
$vbox2 add $reset
set lab2 [gnocl::label -useMarkup 1 -text "TO LIST" -yPad 4]
set list2 [gnocl::list \
-types string \
-headersVisible 0 \
-tooltip $gnocl::picker::tooltips(list2)]
$vbox3 add $lab2
$vbox3 add $list2 -fill {1 1} -expand 1
$list1 configure -data $list2 -onSelectionChanged { %d setSelection "" }
$list2 configure -data $list1 -onSelectionChanged { %d setSelection "" }
$list1 configure -onButtonRelease "$arrow1 configure -sensitive 1 ; $arrow2 configure -sensitive 0"
$list2 configure -onButtonRelease "$arrow1 configure -sensitive 0 ; $arrow2 configure -sensitive 1"
# assemble components
$container add $vbox1 -fill {1 1} -expand 1
$container add $vbox2 -fill {0.5 0.5} -expand 0
$container add $vbox3 -fill {1 1} -expand 1
# add to listing
set ::gnocl::picker::components(${container}_) [list lab1 $lab1 lab2 $lab2 list1 $list1 list2 $list2 arrow1 $arrow1 arrow2 $arrow2]
# set internal variables
set ::gnocl::picker::autoSort(${container}_) 0
set ::gnocl::picker::name(${container}_) ""
return $container
}
proc gnocl::picker::exchange { wid1 wid2 } {
set row [ $wid1 getSelection ]
if { $row == "" } { return }
set val [ $wid1 get $row 0 ]
#if { $val == "" } { return }
$wid2 add [list [list $val]]
gnocl::picker::sort $wid2
#-----
# The gnocl code is fine, but somehow problems arising in the GtkLibs need this workaround.
#-----
if { [$wid1 getNumChildren] > 1 } {
$wid1 erase $row
} else {
$wid1 cellConfigure $row 0 -value ""
}
}
proc gnocl::picker::destroy { wid } {
namespace delete ::gnocl::picker
}
proc gnocl::picker::reset { wid } {
# recover list of widget components
foreach {w id} $::gnocl::picker::components($wid) {set $w $id}
$list1 erase 0 end
$list1 add $::gnocl::picker::fromList($wid)
$list2 erase 0 end
$list2 add $::gnocl::picker::toList($wid)
$list1 setSelection 0
}
proc gnocl::picker::onClicked { wid action } {
# recover list of widget components
foreach {w id} $::gnocl::picker::components($wid) {set $w $id}
switch [string tolower $action] {
add { gnocl::picker::exchange $list1 $list2 }
remove { gnocl::picker::exchange $list2 $list1 }
}
gnocl::picker::sort $list1 $list2
$arrow1 configure -sensitive 0 ; $arrow2 configure -sensitive 0
}
proc gnocl::picker { args } {
set wid [gnocl::picker::construct ]
# initialize necessary variables
set ::gnocl::picker::fromList($wid) ""
set ::gnocl::picker::toList($wid) ""
# overload the box to add commands
rename $wid ${wid}_
# configure
{*}"gnocl::picker::configure ${wid}_ $args"
# widget command
proc $wid { {cmd ""} args } {
set wid [lindex [::info level 0] 0]
{*}"gnocl::picker::cmd ${wid}_ $cmd $args"
}
return $wid
}
proc demo {} {
set box [gnocl::vBox]
# create lists, with deliberate duplicates
set from [list Apple Damson Apple Damson Bananna Cherry Plum]
set to [list Red Orange Yellow Green Blue Orange Indigo Violet]
set wid(1) [gnocl::picker \
-alias pick \
-name myPicker \
-tooltip "Picker demonstration" \
-fromLabel "Various FRUITS" \
-toLabel "Numerous COLOURS" \
-fromList $from \
-toList $to \
-autoSort 1 ]
$box add [pick] -fill {1 1} -expand 1
gnocl::dialog \
-child $box \
-width 400 \
-height 400 \
-data $wid(1) \
-onResponse {
# the modified lists
puts [%d getSelection]
puts [%d getUnselected]
# the original lists
puts [%d cget -toList]
puts [%d cget -fromList]
}
}
demo
======
----
'''[kpv] - 2018-10-26 17:34:32'''
There's also [swaplist] in [tklib].