Gnocl Cookbook‎ > ‎

gnocl::listPicker







#---------------
# test-listPicker.tcl
#---------------
# Created by: William J Giddings (19/07/2011)
#---------------
#!/ 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




Comments