[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].