| # |
| # ::iwidgets::Disjointlistbox |
| # ---------------------------------------------------------------------- |
| # Implements a widget which maintains a disjoint relationship between |
| # the items displayed by two listboxes. The disjointlistbox is composed |
| # of 2 Scrolledlistboxes, 2 Pushbuttons, and 2 labels. |
| # |
| # The disjoint behavior of this widget exists between the two Listboxes, |
| # That is, a given instance of a ::iwidgets::Disjointlistbox will never |
| # exist which has Listbox widgets with items in common. |
| # |
| # Users may transfer items between the two Listbox widgets using the |
| # the two Pushbuttons. |
| # |
| # The options include the ability to configure the "items" displayed by |
| # either of the two Listboxes and to control the placement of the insertion |
| # and removal buttons. |
| # |
| # The following depicts the allowable "-buttonplacement" option values |
| # and their associated layout: |
| # |
| # "-buttonplacement" => center |
| # |
| # -------------------------- |
| # |listbox| |listbox| |
| # | |________| | |
| # | (LHS) | button | (RHS) | |
| # | |========| | |
| # | | button | | |
| # |_______|--------|_______| |
| # | count | | count | |
| # -------------------------- |
| # |
| # "-buttonplacement" => bottom |
| # |
| # --------------------- |
| # | listbox | listbox | |
| # | (LHS) | (RHS) | |
| # |_________|_________| |
| # | button | button | |
| # |---------|---------| |
| # | count | count | |
| # --------------------- |
| # |
| # ---------------------------------------------------------------------- |
| # AUTHOR: John A. Tucker EMAIL: jatucker@spd.dsccc.com |
| # |
| # ====================================================================== |
| |
| # |
| # Default resources. |
| # |
| option add *Disjointlistbox.lhsLabelText Available widgetDefault |
| option add *Disjointlistbox.rhsLabelText Current widgetDefault |
| option add *Disjointlistbox.lhsButtonLabel {Insert >>} widgetDefault |
| option add *Disjointlistbox.rhsButtonLabel {<< Remove} widgetDefault |
| option add *Disjointlistbox.vscrollMode static widgetDefault |
| option add *Disjointlistbox.hscrollMode static widgetDefault |
| option add *Disjointlistbox.selectMode multiple widgetDefault |
| option add *Disjointlistbox.labelPos nw widgetDefault |
| option add *Disjointlistbox.buttonPlacement bottom widgetDefault |
| option add *Disjointlistbox.lhsSortOption increasing widgetDefault |
| option add *Disjointlistbox.rhsSortOption increasing widgetDefault |
| |
| |
| # |
| # Usual options. |
| # |
| itk::usual Disjointlistbox { |
| keep -background -textbackground -cursor \ |
| -foreground -textfont -labelfont |
| } |
| |
| |
| # ---------------------------------------------------------------------- |
| # ::iwidgets::Disjointlistbox |
| # ---------------------------------------------------------------------- |
| itcl::class ::iwidgets::Disjointlistbox { |
| |
| inherit itk::Widget |
| |
| # |
| # options |
| # |
| itk_option define -buttonplacement buttonPlacement ButtonPlacement bottom |
| itk_option define -lhsbuttonlabel lhsButtonLabel LabelText {Insert >>} |
| itk_option define -rhsbuttonlabel rhsButtonLabel LabelText {<< Remove} |
| itk_option define -lhssortoption lhsSortOption LhsSortOption increasing |
| itk_option define -rhssortoption rhsSortOption RhsSortOption increasing |
| |
| constructor {args} {} |
| |
| # |
| # PUBLIC |
| # |
| public { |
| method clear {} |
| method getlhs {{first 0} {last end}} |
| method getrhs {{first 0} {last end}} |
| method lhs {args} |
| method insertlhs {items} |
| method insertrhs {items} |
| method setlhs {items} |
| method setrhs {items} |
| method rhs {args} |
| } |
| |
| # |
| # PROTECTED |
| # |
| protected { |
| method insert {theListbox items} |
| method listboxClick {clickSide otherSide} |
| method listboxDblClick {clickSide otherSide} |
| method remove {theListbox items} |
| method showCount {} |
| method transfer {} |
| |
| variable sourceListbox {} |
| variable destinationListbox {} |
| } |
| } |
| |
| # |
| # Provide a lowercased access method for the ::iwidgets::Disjointlistbox class. |
| # |
| proc ::iwidgets::disjointlistbox {pathName args} { |
| uplevel ::iwidgets::Disjointlistbox $pathName $args |
| } |
| |
| # ------------------------------------------------------------------ |
| # |
| # Method: Constructor |
| # |
| # Purpose: |
| # |
| itcl::body ::iwidgets::Disjointlistbox::constructor {args} { |
| # |
| # Create the left-most Listbox |
| # |
| itk_component add lhs { |
| iwidgets::Scrolledlistbox $itk_interior.lhs \ |
| -selectioncommand [itcl::code $this listboxClick lhs rhs] \ |
| -dblclickcommand [itcl::code $this listboxDblClick lhs rhs] |
| } { |
| usual |
| keep -selectmode -vscrollmode -hscrollmode |
| rename -labeltext -lhslabeltext lhsLabelText LabelText |
| } |
| |
| # |
| # Create the right-most Listbox |
| # |
| itk_component add rhs { |
| iwidgets::Scrolledlistbox $itk_interior.rhs \ |
| -selectioncommand [itcl::code $this listboxClick rhs lhs] \ |
| -dblclickcommand [itcl::code $this listboxDblClick rhs lhs] |
| } { |
| usual |
| keep -selectmode -vscrollmode -hscrollmode |
| rename -labeltext -rhslabeltext rhsLabelText LabelText |
| } |
| |
| # |
| # Create the left-most item count Label |
| # |
| itk_component add lhsCount { |
| label $itk_interior.lhscount |
| } { |
| usual |
| rename -font -labelfont labelFont Font |
| } |
| |
| # |
| # Create the right-most item count Label |
| # |
| itk_component add rhsCount { |
| label $itk_interior.rhscount |
| } { |
| usual |
| rename -font -labelfont labelFont Font |
| } |
| |
| set sourceListbox $itk_component(lhs) |
| set destinationListbox $itk_component(rhs) |
| |
| # |
| # Bind the "showCount" method to the Map event of one of the labels |
| # to keep the diplayed item count current. |
| # |
| bind $itk_component(lhsCount) <Map> [itcl::code $this showCount] |
| |
| grid $itk_component(lhs) -row 0 -column 0 -sticky nsew |
| grid $itk_component(rhs) -row 0 -column 2 -sticky nsew |
| |
| grid rowconfigure $itk_interior 0 -weight 1 |
| grid columnconfigure $itk_interior 0 -weight 1 |
| grid columnconfigure $itk_interior 2 -weight 1 |
| |
| eval itk_initialize $args |
| } |
| |
| # ------------------------------------------------------------------ |
| # Method: listboxClick |
| # |
| # Purpose: Evaluate a single click make in the specified Listbox. |
| # |
| itcl::body ::iwidgets::Disjointlistbox::listboxClick {clickSide otherSide} { |
| set button "button" |
| $itk_component($clickSide$button) configure -state active |
| $itk_component($otherSide$button) configure -state disabled |
| set sourceListbox $clickSide |
| set destinationListbox $otherSide |
| } |
| |
| # ------------------------------------------------------------------ |
| # Method: listboxDblClick |
| # |
| # Purpose: Evaluate a double click in the specified Listbox. |
| # |
| itcl::body ::iwidgets::Disjointlistbox::listboxDblClick {clickSide otherSide} { |
| listboxClick $clickSide $otherSide |
| transfer |
| } |
| |
| # ------------------------------------------------------------------ |
| # Method: transfer |
| # |
| # Purpose: Transfer source Listbox items to destination Listbox |
| # |
| itcl::body ::iwidgets::Disjointlistbox::transfer {} { |
| |
| if {[$sourceListbox selecteditemcount] == 0} { |
| return |
| } |
| set selectedindices [lsort -integer -decreasing [$sourceListbox curselection]] |
| set selecteditems [$sourceListbox getcurselection] |
| |
| foreach index $selectedindices { |
| $sourceListbox delete $index |
| } |
| |
| foreach item $selecteditems { |
| $destinationListbox insert end $item |
| } |
| |
| if {![string equal $itk_option(-${destinationListbox}sortoption) "none"]} { |
| $destinationListbox sort $itk_option(-${destinationListbox}sortoption) |
| } |
| |
| showCount |
| } |
| |
| # ------------------------------------------------------------------ |
| # Method: getlhs |
| # |
| # Purpose: Retrieve the items of the left Listbox widget |
| # |
| itcl::body ::iwidgets::Disjointlistbox::getlhs {{first 0} {last end}} { |
| return [lhs get $first $last] |
| } |
| |
| # ------------------------------------------------------------------ |
| # Method: getrhs |
| # |
| # Purpose: Retrieve the items of the right Listbox widget |
| # |
| itcl::body ::iwidgets::Disjointlistbox::getrhs {{first 0} {last end}} { |
| return [rhs get $first $last] |
| } |
| |
| # ------------------------------------------------------------------ |
| # Method: insertrhs |
| # |
| # Purpose: Insert items into the right Listbox widget |
| # |
| itcl::body ::iwidgets::Disjointlistbox::insertrhs {items} { |
| remove $itk_component(lhs) $items |
| insert rhs $items |
| } |
| |
| # ------------------------------------------------------------------ |
| # Method: insertlhs |
| # |
| # Purpose: Insert items into the left Listbox widget |
| # |
| itcl::body ::iwidgets::Disjointlistbox::insertlhs {items} { |
| remove $itk_component(rhs) $items |
| insert lhs $items |
| } |
| |
| # ------------------------------------------------------------------ |
| # Method: clear |
| # |
| # Purpose: Remove the items from the Listbox widgets and set the item count |
| # Labels text to 0 |
| # |
| itcl::body ::iwidgets::Disjointlistbox::clear {} { |
| lhs clear |
| rhs clear |
| showCount |
| } |
| |
| # ------------------------------------------------------------------ |
| # Method: insert |
| # |
| # Purpose: Insert the input items into the input Listbox widget while |
| # maintaining the disjoint property between them. |
| # |
| itcl::body ::iwidgets::Disjointlistbox::insert {theListbox items} { |
| |
| set curritems [$theListbox get 0 end] |
| |
| foreach item $items { |
| # |
| # if the item is not already present in the Listbox then insert it |
| # |
| if {[lsearch -exact $curritems $item] == -1} { |
| $theListbox insert end $item |
| } |
| } |
| |
| if {![string equal $itk_option(-${theListbox}sortoption) "none"]} { |
| $theListbox sort $itk_option(-${theListbox}sortoption) |
| } |
| |
| showCount |
| } |
| |
| # ------------------------------------------------------------------ |
| # Method: remove |
| # |
| # Purpose: Remove the input items from the input Listbox widget while |
| # maintaining the disjoint property between them. |
| # |
| itcl::body ::iwidgets::Disjointlistbox::remove {theListbox items} { |
| |
| set indexes {} |
| set curritems [$theListbox get 0 end] |
| |
| foreach item $items { |
| # |
| # if the item is in the listbox then add its index to the index list |
| # |
| if {[set index [lsearch -exact $curritems $item]] != -1} { |
| lappend indexes $index |
| } |
| } |
| |
| foreach index [lsort -integer -decreasing $indexes] { |
| $theListbox delete $index |
| } |
| showCount |
| } |
| |
| # ------------------------------------------------------------------ |
| # Method: showCount |
| # |
| # Purpose: Set the text of the item count Labels. |
| # |
| itcl::body ::iwidgets::Disjointlistbox::showCount {} { |
| $itk_component(lhsCount) config -text "item count: [lhs size]" |
| $itk_component(rhsCount) config -text "item count: [rhs size]" |
| } |
| |
| # ------------------------------------------------------------------ |
| # METHOD: setlhs |
| # |
| # Set the items of the left-most Listbox with the input list |
| # option. Remove all (if any) items from the right-most Listbox |
| # which exist in the input list option to maintain the disjoint |
| # property between the two |
| # |
| itcl::body ::iwidgets::Disjointlistbox::setlhs {items} { |
| lhs clear |
| insertlhs $items |
| } |
| |
| # ------------------------------------------------------------------ |
| # METHOD: setrhs |
| # |
| # Set the items of the right-most Listbox with the input list |
| # option. Remove all (if any) items from the left-most Listbox |
| # which exist in the input list option to maintain the disjoint |
| # property between the two |
| # |
| itcl::body ::iwidgets::Disjointlistbox::setrhs {items} { |
| rhs clear |
| insertrhs $items |
| } |
| |
| # ------------------------------------------------------------------ |
| # Method: lhs |
| # |
| # Purpose: Evaluates the specified arguments against the lhs Listbox |
| # |
| itcl::body ::iwidgets::Disjointlistbox::lhs {args} { |
| return [eval $itk_component(lhs) $args] |
| } |
| |
| # ------------------------------------------------------------------ |
| # Method: rhs |
| # |
| # Purpose: Evaluates the specified arguments against the rhs Listbox |
| # |
| itcl::body ::iwidgets::Disjointlistbox::rhs {args} { |
| return [eval $itk_component(rhs) $args] |
| } |
| |
| # ------------------------------------------------------------------ |
| # OPTION: buttonplacement |
| # |
| # Configure the placement of the buttons to be either between or below |
| # the two list boxes. |
| # |
| itcl::configbody ::iwidgets::Disjointlistbox::buttonplacement { |
| if {$itk_option(-buttonplacement) != ""} { |
| |
| if { [lsearch [component] lhsbutton] != -1 } { |
| eval destroy $itk_component(rhsbutton) $itk_component(lhsbutton) |
| } |
| |
| if { [lsearch [component] bbox] != -1 } { |
| destroy $itk_component(bbox) |
| } |
| |
| set where $itk_option(-buttonplacement) |
| |
| switch $where { |
| |
| center { |
| # |
| # Create the button box frame |
| # |
| itk_component add bbox { |
| frame $itk_interior.bbox |
| } |
| |
| itk_component add lhsbutton { |
| button $itk_component(bbox).lhsbutton -command [itcl::code \ |
| $this transfer] |
| } { |
| usual |
| rename -text -lhsbuttonlabel lhsButtonLabel LabelText |
| rename -font -labelfont labelFont Font |
| } |
| |
| itk_component add rhsbutton { |
| button $itk_component(bbox).rhsbutton -command [itcl::code \ |
| $this transfer] |
| } { |
| usual |
| rename -text -rhsbuttonlabel rhsButtonLabel LabelText |
| rename -font -labelfont labelFont Font |
| } |
| |
| grid configure $itk_component(lhsCount) -row 1 -column 0 \ |
| -sticky ew |
| grid configure $itk_component(rhsCount) -row 1 -column 2 \ |
| -sticky ew |
| |
| grid configure $itk_component(bbox) \ |
| -in $itk_interior -row 0 -column 1 -columnspan 1 \ |
| -sticky nsew |
| |
| grid configure $itk_component(rhsbutton) \ |
| -in $itk_component(bbox) -row 0 -column 0 -sticky ew |
| grid configure $itk_component(lhsbutton) \ |
| -in $itk_component(bbox) -row 1 -column 0 -sticky ew |
| } |
| |
| bottom { |
| |
| itk_component add lhsbutton { |
| button $itk_interior.lhsbutton -command [itcl::code $this \ |
| transfer] |
| } { |
| usual |
| rename -text -lhsbuttonlabel lhsButtonLabel LabelText |
| rename -font -labelfont labelFont Font |
| } |
| |
| itk_component add rhsbutton { |
| button $itk_interior.rhsbutton -command [itcl::code $this \ |
| transfer] |
| } { |
| usual |
| rename -text -rhsbuttonlabel rhsButtonLabel LabelText |
| rename -font -labelfont labelFont Font |
| } |
| |
| grid $itk_component(lhsCount) -row 2 -column 0 -sticky ew |
| grid $itk_component(rhsCount) -row 2 -column 2 -sticky ew |
| grid $itk_component(lhsbutton) -row 1 -column 0 -sticky ew |
| grid $itk_component(rhsbutton) -row 1 -column 2 -sticky ew |
| } |
| |
| default { |
| error "bad buttonplacement option\"$where\": should be center\ |
| or bottom" |
| } |
| } |
| } |
| } |
| |
| # ------------------------------------------------------------------ |
| # OPTION: lhssortoption |
| # |
| # Configure the sort option to use for the left side |
| # |
| itcl::configbody ::iwidgets::Disjointlistbox::lhssortoption { |
| |
| if {![string equal $itk_option(-lhssortoption) "none"]} { |
| $itk_component(lhs) sort $itk_option(-lhssortoption) |
| } |
| } |
| |
| |
| # ------------------------------------------------------------------ |
| # OPTION: rhssortoption |
| # |
| # Configure the sort option to use for the right side |
| # |
| itcl::configbody ::iwidgets::Disjointlistbox::rhssortoption { |
| |
| if {![string equal $itk_option(-rhssortoption) "none"]} { |
| $itk_component(rhs) sort $itk_option(-rhssortoption) |
| } |
| } |
