[WJG] (19/Jul/11) A number of times I've come across dialog windows that allow a range of items to be picked from a list. The Gtk+ libraries which Gnocl provides a Tcl binding has no such offering. Working with list widgets is a bit of a hassle, the Gnocl binding itself is approx' 3,000 lines of C-Code alone. Its much quicker to create such objects on the Tcl side. In this case not all of the list options are available, just the raw essentials. Each entry, however, does require a data value to be passed. In practice, the first value is the display word, and the data something potentially more meaningful for subsequent script operations. Here's a screen shot and the script to do it!

[https://lh3.googleusercontent.com/-nMPMzcbgnXE/TiSxdUtxybI/AAAAAAAAA8w/mKZ7rcyDxLk/s800/Screenshot-test-listPicker.tcl.png]

======
# test-listPicker.tcl
#!/ bin/sh
#\
exec tclsh "%0" "$@"

package require Gnocl

#---------------
# megawidget to contain Ok/Cancel buttons
#---------------
proc gnocl::listPicker { args } {
 set titles {"Item" data}
 set types {string string}
 set ls(from) [gnocl::list \
   -titles $titles \
   -types $types ]
 set ls(to) [gnocl::list \
   -titles $titles \
   -types $types ]
                
 # are any names data?
 set i [lsearch $titles data ]
    
 $ls(from) columnConfigure $i -visible 0
 $ls(to) columnConfigure $i -visible 0
    
 #~~~~~~~~~~~~~~~
 # move items between two lists
 #~~~~~~~~~~~~~~~                
 proc ::moveItem { from to i} {
   set active [$from getSelection] 
   if {$active == ""} {return}
   set rows [$from getNumChildren]
   set a [$from get $active 0]
   set b [$from get $active 1]
   $from erase $active
   set rows [$from getNumChildren]
   # set new active row
   if { $active < $rows } {
     $from setSelection $active
   } elseif {$rows == 1} {
     $from setSelection 0
   } else {
     if { $rows != 0 } { $from setSelection [incr rows -1] }
   }
   $to add "\{\{$a\} \{$b\}\}"
 }

 #~~~~~~~~~~~~~~~
 # return a list of selected items
 #~~~~~~~~~~~~~~~
 proc ::getList { w } {
   set r 0
   while {$r < [$w getNumChildren] } {
     lappend str [ list [$w get $r 0] [$w get $r 1] ]
     incr r
   }
   return $str
 }

 # selection buttons
 set but(from) [gnocl::button \
    -icon %#GoForward \
    -onClicked  "::moveItem $ls(from) $ls(to) $i" ]
 set but(to) [gnocl::button \
    -icon %#GoBack \
    -onClicked "::moveItem $ls(to) $ls(from) $i"]
  set bx(1) [gnocl::fixed ]
  $bx(1) add $but(from) \
     -x 0 -y 50 \
     -width 70 -height 35
  $bx(1) add $but(to) \
     -x 0 -y 100 \
     -width 70 -height 35
  set bx(2) [gnocl::box]
  $bx(2) add $ls(from) \
     -fill {1 1} \
     -expand 1
  $bx(2) add $bx(1) \
     -fill {0 1}
  $bx(2) add $ls(to) \
     -fill {1 1} \
     -expand 1
  $bx(2) configure -data $ls(to)
  # allocate which elements get which settings
  foreach {a b} $args {
    switch -- $a {
      -items {
         # create from list from supplied items
         foreach row $b { $ls(from) add "\{$row\}" }
         }
      -headersVisible { 
         # create from list from supplied items
         $ls(from) configure $a $b        
         $ls(to) configure $a $b
         }
      default { # nothing in here yet! }
    }
  }

  # overload the box to add commands
  rename $bx(2) _$bx(2)

  #~~~~~~~~~~~~~~~
  # overload box widget to create new commands
  #~~~~~~~~~~~~~~~
  proc $bx(2) {cmd args} {
    set self [lindex [::info level 0] 0]
    switch -- $cmd {
      get { return [::getList [_$self cget -data] ] }
      default {uplevel 1 _$self $cmd $args} }
    }

  return $bx(2)
}

set items {
        {New "New File"} 
        {Open "Open File"}        
        {Save "Save File"}
        {Help "Help Me"} 
        }

set box [gnocl::box -orientation vertical]
set lp [gnocl::listPicker -items $items -headersVisible 0]
set bt [gnocl::button -text "Get Selected Options" -onClicked { puts [$lp get]}] 
$box add $lp -fill {1 1} -expand 1
$box add $bt -fill {0 0} -expand 0 -align right

gnocl::window -child $box -setSize 0.25

======



<<categories>>GUI