# !/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 "<b>FROM LIST</b>" -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 "<b>TO LIST</b>" -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 <b>FRUITS</b>" \
                -toLabel         "Numerous <u>COLOURS</u>" \
                -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