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

package require Gnocl

#---------------
# megawidget to create list picker
#---------------
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