# # ::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) [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) } }