if 0 {

[MBS] 2008-01-28  For an application that I've been developing at work,
I needed some sort of ''disjointlistbox''.  The [Iwidgets] package 
offers one of these, in the form of [disjointlistbox].  There was also 
[A little list selector] by [RS] and [tklib] has [swaplist].

None of these were quite right for what my user's were requesting.

I ended up with a combination of [swaplist] with [tablelist].

Sorry, no docs for it at present time.  I based a lot of the code 
on [swaplist], so hopefully between the demo code and the docs for
both [tablelist] and [swaplist] you should get the idea.

----
[http://www.geocities.com/stuckymb/images/swapTableList.jpg]
----

I'm sure that it could use some ''polish'', so comments, 
improvements, etc. are welcome.

Let me know what you think...   --Mark

----

}

 set ::useTestDemo 1 ;# Used to enable the demo code below

 set ::useTile     1 ;# Set this in the calling routine before
                     ;# "package require Swaptablelist" if you
                     ;# want to enable "Tile"

 ############################## Cut Here ##############################

 if {![info exists ::useTile]} {
     set ::useTile 0
 }
 
 package require Tk
 
 if {$::useTile} {
     package require tile
     package require Tablelist_tile
 } else {
     package require Tablelist
 }
 package require BWidget
 package require autoscroll
 
 package provide Swaptablelist 1.0
 
 namespace eval Swaptablelist {
     variable lTbl
     variable rTbl
 
     namespace export swaptablelist
 
 }
 
 ########################################################################
 
 option add *Tablelist.activeStyle	frame
 option add *Tablelist.background	gray98
 option add *Tablelist.stripeBackground	#e0e8f0
 option add *Tablelist.setGrid		yes
 option add *Tablelist.movableColumns	yes
 option add *Tablelist.labelCommand	tablelist::sortByColumn
 
 option add *Tablelist.Font		"Courier -12"
 
 ########################################################################
 
 proc Swaptablelist::create_tablelist {fr args} {
 
     array set options {
         -height      0
         -width       0
     }
 
     Swaptablelist::parseOpts options {\
                            {-title {}} \
                            {-listvariable {}} \
                            {-llistvar {}} {-rlistvar {}} \
                            {-columns {}} \
                            {-lcolumns {}} {-rcolumns {}} \
                            {-height {}} {-width {}} \
                            {-lwidth {}} {-rwidth {}} \
                            {-llabel {}} {-rlabel {}} \
                            {-reorder boolean} \
                            {-geometry {}} \
                            {-lbuttontext {}} {-rbuttontext {}} \
                            {-ubuttontext {}} {-dbuttontext {}}} \
                       $args
 
     tablelist::tablelist $fr.tbl \
                  -columns $options(-columns) \
                  -listvariable $options(-listvariable) \
                  -editstartcommand editStartCmd \
                  -editendcommand   editEndCmd \
                  -xscrollcommand "$fr.xs set" \
                  -yscrollcommand "$fr.ys set" \
                  -stretch all \
                  -selectmode extended \
                  -height $options(-height) \
                  -width  $options(-width)
 
     scrollbar $fr.ys -orient v -command "$fr.tbl yview"
     scrollbar $fr.xs -orient h -command "$fr.tbl xview"
     
     
     grid $fr.tbl  -row 0 -column 0 -sticky nsew
     grid $fr.ys   -row 0 -column 1 -sticky ns
     grid $fr.xs   -row 2 -column 0 -sticky ew
 
     grid columnconfigure $fr 0 -weight 1
     grid columnconfigure $fr 1 -weight 0
 
     grid rowconfigure $fr 0 -weight 1
     grid rowconfigure $fr 1 -weight 0
 
     update idletasks
 
     ::autoscroll::autoscroll $fr.ys
     ::autoscroll::autoscroll $fr.xs
 
     return $fr.tbl
 }
 
 proc Swaptablelist::create_swap_list {w args} {
     variable lTbl
     variable rTbl
 
     array set options {
         -reorder 1
         -lbuttontext "<<"
         -rbuttontext ">>"
         -ubuttontext "Move Up"
         -dbuttontext "Move Down"
         -lcolumns    "Left" 
         -rcolumns    "Right"
         -height      0
         -lwidth      0
         -rwidth      0
     }
 
 
     Swaptablelist::parseOpts options {\
                            {-title {}} \
                            {-listvariable {}} \
                            {-llistvar {}} {-rlistvar {}} \
                            {-lcolumns {}} {-rcolumns {}} \
                            {-height {}} {-lwidth {}} {-rwidth {}} \
                            {-llabel {}} {-rlabel {}} \
                            {-reorder boolean} \
                            {-geometry {}} \
                            {-lbuttontext {}} {-rbuttontext {}} \
                            {-ubuttontext {}} {-dbuttontext {}}} \
                       $args
 
 
     # Left hand side...
     if {$::useTile} {
         # set lf1 [LabelFrame $w.f1 -text $options(-llabel) -side top ]
         set lf1 [ttk::labelframe $w.f1 -text $options(-llabel) -labelanchor nw]
     } else {
         set lf1 [labelframe $w.f1 -text $options(-llabel) -labelanchor nw]
     }
     #  set f1  [$lf1 getframe]
     set f1  $lf1
     set options(-columns) [Swaptablelist::extract_column $options(-lcolumns)]
     set options(-width)  $options(-lwidth)
     set options(-listvariable)  $options(-llistvar)
 
     set lTbl($w) [eval [list Swaptablelist::create_tablelist $f1] [array get options]]
 
     # Right hand side...
     if {$::useTile} {
         # set lf2 [LabelFrame $w.f2 -text $options(-rlabel) -side top ]
         set lf2 [ttk::labelframe $w.f2 -text $options(-rlabel) -labelanchor nw]
     } else {
         set lf2 [labelframe $w.f2 -text $options(-rlabel) -labelanchor nw]
     }
     #  set f2  [$lf2 getframe]
     set f2  $lf2
     set options(-columns) [Swaptablelist::extract_column $options(-rcolumns)]
     set options(-width)  $options(-rwidth)
     set options(-listvariable)  $options(-rlistvar)
 
     set rTbl($w) [eval [list Swaptablelist::create_tablelist $f2] [array get options]]
 
     # left/right buttons
     set flr [frame $w.lr]
     set width [Swaptablelist::strmin 5 $options(-lbuttontext) $options(-rbuttontext)]
 
     set olist [list]
 
     if {$::useTile} {
         ttk::button $flr.left  -width $width -text $options(-lbuttontext) \
             -command [list Swaptablelist::ShiftL $w $olist]
         ttk::button $flr.right -width $width -text $options(-rbuttontext) \
             -command [list Swaptablelist::ShiftR $w $olist]
     } else {
         button $flr.left  -width $width -text $options(-lbuttontext) \
             -command [list Swaptablelist::ShiftL $w $olist]
         button $flr.right -width $width -text $options(-rbuttontext) \
             -command [list Swaptablelist::ShiftR $w $olist]
     }
     grid $flr.right -pady 4
     grid $flr.left  -pady 4
     grid columnconfigure $flr 0 -uniform 1
 
     # up/down buttons
     set width [Swaptablelist::strmin 3 $options(-ubuttontext) $options(-dbuttontext)]
     set fud [frame $w.ud]
 
     if {$::useTile} {
         ttk::button $fud.up   -width $width -text $options(-ubuttontext) \
             -command [list Swaptablelist::ShiftUD $w u]
         ttk::button $fud.down -width $width -text $options(-dbuttontext) \
             -command [list Swaptablelist::ShiftUD $w d]
     } else {
         button $fud.up   -width $width -text $options(-ubuttontext) \
             -command [list Swaptablelist::ShiftUD $w u]
         button $fud.down -width $width -text $options(-dbuttontext) \
             -command [list Swaptablelist::ShiftUD $w d]
     }
     pack $fud.up   -side top    -pady 4
     pack $fud.down -side bottom -pady 4
 
     pack $lf1  -side left -expand yes -fill both
     pack $flr  -side left
     pack $lf2  -side left -expand yes -fill both
     pack $fud  -side left 
 
     return $w
 
 }
 
 proc Swaptablelist::extract_column {colList} {
 
     set retList [list]
     foreach col $colList {
         set clen [llength $col]
         switch $clen {
             3 {
                 set cWidth [lindex $col 0]
                 set cName  [lindex $col 1]
                 set cJust  [lindex $col 2]
             }
 
             2 {
                 set cWidth 0
                 set cName  [lindex $col 0]
                 set cJust  [lindex $col 1]
             }
 
             1 {
                 set cWidth 0
                 set cName  $col
                 set cJust  left
             }
 
             default {
                 set cWidth 0
                 set cName  unknown
                 set cJust  left
             }
         }
         lappend retList $cWidth $cName $cJust
     }
 
     return $retList
 }
 
 # return the min unless string1 or string2 is longer, if so return 
 # length of the longer one
 proc Swaptablelist::strmin {min s1 s2} {
     if {[string length $s1] > $min || [string length $s2] > $min} {
         return [expr {
                 ([string length $s1] > [string length $s2]) \
                 ? [string length $s1] \
                 : [string length $s2]
                }]
     } else {
         return $min
     }
 }
 
 proc Swaptablelist::parseOpts {var opts input} {
     upvar $var output
 
     for {set i 0} {$i < [llength $input]} {incr i} {
         for {set a 0} {$a < [llength $opts]} {incr a} {
             if {[lindex $opts $a 0] == [lindex $input $i]} { break }
         }
         if {$a == [llength $opts]} { error "unknown option [lindex $input $i]" }
         set opt [lindex $opts $a]
         if {[llength $opt] > 1} {
             foreach {opt type} $opt {break}
             if {[incr i] >= [llength $input]} { error "$opt requires an argument" }
             if {$type != "" && ![string is $type -strict [lindex $input $i]]} { 
                 error "$opt requires argument of type $type" 
             }
             set output($opt) [lindex $input $i]
         } else {
             set output($opt) {}
         }
     }
 }
 
 #------------------------------------------------------------------------------
 proc editStartCmd {tbl row col text} {
     set w [$tbl editwinpath]
 
     return $text
 }
 
 #------------------------------------------------------------------------------
 proc editEndCmd {tbl row col text} {
     return $text
 }
 
 #------------------------------------------------------------------------------
 
 
 proc Swaptablelist::ShiftR {w lst} {
     variable lTbl
     variable rTbl
 
     foreach sel [$lTbl($w) curselection] {
         set rList [list]
         for {set colNo 0} {$colNo < [$rTbl($w) columncount]} {incr colNo} {
             set lNdx [$lTbl($w) columnindex [$rTbl($w) columncget $colNo -name]]
             lappend rList $colNo [$lTbl($w) cellcget $sel,$lNdx -text]
         }
         Swaptablelist::insertR $w $rList
     } 
 }
 
 proc Swaptablelist::insertR {w lst} {
     variable rTbl
 
     set tbLen [llength [$rTbl($w) getkeys 0 end]]
 
     if {$tbLen == 0} {
         set nLst  [list]
         foreach {cNum valL} $lst {
             lappend nLst $valL
         }
         $rTbl($w) insert end $nLst
 
     } else {
 
         set found 0
         foreach k [$rTbl($w) getkeys 0 end] {
             set ndiff 0
             foreach {cNum valL} $lst {
                 set valT  [$rTbl($w) cellcget $k,$cNum -text]
                 if {$valT ne $valL} {
                     incr ndiff
                 }
             }
 
             if {$ndiff == 0} {
                 set found 1
                 break
             }
         }
 
         if {$found == 0} {
             set nLst  [list]
             foreach {cNum valL} $lst {
                 lappend nLst $valL
             }
             $rTbl($w) insert end $nLst
         }
     }
 }
 
 proc Swaptablelist::insert {tbl lst} {
 
     set tblCols [$tbl columncount]
 
     foreach item $lst {
         if {[llength $item] <= $tblCols} {
             $tbl insert end $item
         } else {
             set nLst [list]
             foreach it $item {
                 lappend nLst $it
             }
             while {[llength $nLst] < $tblCols} {
                 lappend nLst " "
             }
             foreach it $nLst {
                 $tbl insert end $it
             }
         }
     }
 }
 
 proc Swaptablelist::ShiftL {w lst} {
     variable rTbl
 
     $rTbl($w) delete [$rTbl($w) curselection]
     Swaptablelist::renumberWhenIdle $rTbl($w)
 }
 
 proc Swaptablelist::ShiftUD {w dir} {
     variable rTbl
 
     if {[set sel [$rTbl($w) curselection]] == ""} { return }
 
     set list {}
     # delete in reverse order so shifting indexes dont bite us
     foreach x [Swaptablelist::lreverse $sel] {
         # make a list in correct order with the items index and contents
         set list [linsert $list 0 [list $x [$rTbl($w) get $x]]]
         $rTbl($w) delete $x
     }
     if {$dir == "u"} {
         set n 0
         foreach x $list {
             set i [lindex $x 0]
             if {[incr i -1] < $n} {set i $n}
             $rTbl($w) insert $i [lindex $x 1]
             $rTbl($w) selection set $i
             incr n
         }
         $rTbl($w) see [expr {[lindex $list 0 0] - 1}]
     }
     if {$dir == "d"} {
         set n [$rTbl($w) index end]
         foreach x $list {
             set i [lindex $x 0]
             if {[incr i] > $n} {set i $n}
             $rTbl($w) insert $i [lindex $x 1]
             $rTbl($w) selection set $i
             incr n
         }
         $rTbl($w) see $i
     }
 }
 
 proc Swaptablelist::getLTable {swl} {
     variable lTbl
     return $Swaptablelist::lTbl($swl)
 }
 
 proc Swaptablelist::getRTable {swl} {
     variable rTbl
     return $Swaptablelist::rTbl($swl)
 }
 
 proc Swaptablelist::renumberWhenIdle tbl { 
     if {[$tbl attrib afterId] eq ""} { 
         $tbl attrib afterId [after idle [list Swaptablelist::renumber $tbl]] 
     } 
 } 
 
 proc Swaptablelist::renumber {tbl} { 
     $tbl attrib afterId "" 
 
     set itemList [$tbl get 0 end] 
     set nCol [$tbl columncount]
 
     $tbl delete 0 end 
 
     foreach item $itemList { 
         set rList [list]
         for {set colNo 0} {$colNo < $nCol} {incr colNo} {
             lappend rList [lindex $item $colNo]
         }
         $tbl insert end $rList
     } 
 } 
 
 # return a list in reversed order
 proc Swaptablelist::lreverse {list} {
     set new {}
     foreach x $list {set new [linsert $new 0 $x]}
     return $new
 }

if 0 {

Here is some test code

}

 ########################################################################
 #
 # test ...
 #
 ########################################################################

 if {$::useTestDemo} {

     set ::useTile    1
     
     package require Tk
     package require BWidget
     package require Swaptablelist 1.0
     
     proc main { } {
         interface
         set_Theme xpnative
     }
     
     proc set_Theme { th } {
         if {$::tcl_version <= 8.4} {
             tile::setTheme $th
         } else {
             ttk::style theme use $th
         }
     }
     
     proc interface { } {
     
         set w .
         wm withdraw $w
         wm title $w "Test swapTableList"
         wm protocol $w WM_DELETE_WINDOW exit
         
         set descmenu {
             "&File" all file 0 {
                 {command "Show Local" {} "Show local list" {}  -command show_local}
                 {separator}
                 {command "E&xit"      {} "Exit program"    {}  -command exit}
             }
             "&Theme" all theme 0 {
                 {radiobutton "Default"   {} "default"     {}  -command {set_Theme default}}
                 {radiobutton "Classic"   {} "classic"     {}  -command {set_Theme classic}}
                 {radiobutton "Clam"      {} "clam"        {}  -command {set_Theme clam}}
                 {radiobutton "Step"      {} "step"        {}  -command {set_Theme step}}
                 {radiobutton "alt"       {} "alt"         {}  -command {set_Theme alt}}
                 {radiobutton "winnative" {} "Win native"  {}  -command {set_Theme winnative}}
                 {radiobutton "xpnative"  {} "XP native"   {}  -command {set_Theme xpnative}}
             }
         }
     
         set mainframe [MainFrame .mainframe \
                            -menu         $descmenu \
                            -textvariable ::glob_var(status) \
                            -progressvar  ::glob_var(progressvar) \
                            -progressmax  100 \
                            -progresstype normal \
                            -progressfg blue ]
         
         $mainframe showstatusbar status    
         $mainframe addindicator -text "version 0.0"
         
         set mf [$mainframe getframe]
     
         build_swtl $mf
     
         pack $mainframe -fill both -expand yes
     
         update idletasks
     
         set x [expr {[winfo screenwidth $w]/2  - [winfo reqwidth $w]/2  - [winfo vrootx $w]}]
         set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 - [winfo vrooty $w]}]
         wm geometry $w +$x+$y
     
         raise $w
         wm deiconify $w
     }
     
     proc build_swtl { fr } {
     
         set ::glob_var(list,displayed) 0
     
         set ::glob_var(masterList) [list ]
         set ::glob_var(local)      [list ]
         
         set ::glob_var(masterList) {
             {1  MP1  "one"}
             {2  MP2  "two"}
             {3  MP3  "three"}
             {4  MP4  "four"}
             {5  MP5  "five"}
             {6  MP6  "six"}
             {7  MP7  "seven"}
             {8  MP8  "eight"}
             {9  MP9  "nine"}
             {10 MP10 "ten"}
         }
         
         array set ::options {
             -title  "Testing swapTablelist"
             -llabel "Master List"
             -rlabel "Local List"
             -lcolumns {
                 {5  "Index"             center }
                 {15 "MissionPoint ID"   left   } 
                 {40 "Description"       left   } 
             }
             -rcolumns {
                 {5  "Index"             center }
                 {15 "MissionPoint ID"   left   } 
             }
             -height 20
             -lwidth 0
             -rwidth 0
             -llistvar ::glob_var(masterList)
             -rlistvar ::glob_var(localList)
         }
     
         set f2 [frame $fr.f2]
         set ::swl [eval [list Swaptablelist::create_swap_list $f2] [array get ::options]]
         pack $f2
     
         set tbl [Swaptablelist::getLTable $::swl]
         $tbl columnconfigure 0 -name col_index  -editable no -sortmode integer
         $tbl columnconfigure 1 -name col_mpID   -editable no -sortmode dictionary
         $tbl columnconfigure 2 -name col_desc   -editable no -sortmode dictionary
     
         set tbl [Swaptablelist::getRTable $::swl]
         $tbl columnconfigure 0 -name col_index  -editable no -sortmode integer
         $tbl columnconfigure 1 -name col_mpID   -editable no -sortmode dictionary
     
     
     }
     
     proc show_local { } {
         puts "Local list : "
         puts $::glob_var(localList)
     }
 
 proc fill { } {

     # Old code : Not used in the demo any more, but I left
     # it in "just in case"...
         
     if {$::glob_var(list,displayed)} {
         return
     }
     set tbl [Swaptablelist::getLTable $::swl]
     
     set mpList {
         {1  MP1  "one"}
         {2  MP2  "two"}
         {3  MP3  "three"}
         {4  MP4  "four"}
         {5  MP5  "five"}
         {6  MP6  "six"}
         {7  MP7  "seven"}
         {8  MP8  "eight"}
         {9  MP9  "nine"}
         {10 MP10 "ten"}
     }
         
     Swaptablelist::insert $tbl $mpList
         
     set ::glob_var(list,displayed) 1
 }
     
 main

}

----
!!!!!!
%| [Category GUI] | [Category Widget] |%
!!!!!!