diff options
Diffstat (limited to 'itcl/iwidgets3.0.0/generic/disjointlistbox.itk')
| -rwxr-xr-x | itcl/iwidgets3.0.0/generic/disjointlistbox.itk | 489 |
1 files changed, 489 insertions, 0 deletions
diff --git a/itcl/iwidgets3.0.0/generic/disjointlistbox.itk b/itcl/iwidgets3.0.0/generic/disjointlistbox.itk new file mode 100755 index 00000000000..5f40399fa8e --- /dev/null +++ b/itcl/iwidgets3.0.0/generic/disjointlistbox.itk @@ -0,0 +1,489 @@ +# +# ::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. +# + +set tk_strictMotif 1 + +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 + + +# +# Usual options. +# +itk::usual Disjointlistbox { + keep -background -textbackground -cursor \ + -foreground -textfont -labelfont +} + + +# ---------------------------------------------------------------------- +# ::iwidgets::Disjointlistbox +# ---------------------------------------------------------------------- +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} + + 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: +# +body ::iwidgets::Disjointlistbox::constructor {args} { + # + # Create the left-most Listbox + # + itk_component add lhs { + iwidgets::Scrolledlistbox $itk_interior.lhs \ + -selectioncommand [code $this listboxClick lhs rhs] \ + -dblclickcommand [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 [code $this listboxClick rhs lhs] \ + -dblclickcommand [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> [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. +# +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 $itk_component($clickSide) + set destinationListbox $itk_component($otherSide) +} + +# ------------------------------------------------------------------ +# Method: listboxDblClick +# +# Purpose: Evaluate a double click in the specified Listbox. +# +body ::iwidgets::Disjointlistbox::listboxDblClick {clickSide otherSide} { + listboxClick $clickSide $otherSide + transfer +} + +# ------------------------------------------------------------------ +# Method: transfer +# +# Purpose: Transfer source Listbox items to destination Listbox +# +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 + } + $destinationListbox sort increasing + + showCount +} + +# ------------------------------------------------------------------ +# Method: getlhs +# +# Purpose: Retrieve the items of the left Listbox widget +# +body ::iwidgets::Disjointlistbox::getlhs {{first 0} {last end}} { + return [lhs get $first $last] +} + +# ------------------------------------------------------------------ +# Method: getrhs +# +# Purpose: Retrieve the items of the right Listbox widget +# +body ::iwidgets::Disjointlistbox::getrhs {{first 0} {last end}} { + return [rhs get $first $last] +} + +# ------------------------------------------------------------------ +# Method: insertrhs +# +# Purpose: Insert items into the right Listbox widget +# +body ::iwidgets::Disjointlistbox::insertrhs {items} { + remove $itk_component(lhs) $items + insert $itk_component(rhs) $items +} + +# ------------------------------------------------------------------ +# Method: insertlhs +# +# Purpose: Insert items into the left Listbox widget +# +body ::iwidgets::Disjointlistbox::insertlhs {items} { + remove $itk_component(rhs) $items + insert $itk_component(lhs) $items +} + +# ------------------------------------------------------------------ +# Method: clear +# +# Purpose: Remove the items from the Listbox widgets and set the item count +# Labels text to 0 +# +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. +# +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 + } + } + $theListbox sort increasing + showCount +} + +# ------------------------------------------------------------------ +# Method: remove +# +# Purpose: Remove the input items from the input Listbox widget while +# maintaining the disjoint property between them. +# +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. +# +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 +# +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 +# +body ::iwidgets::Disjointlistbox::setrhs {items} { + rhs clear + insertrhs $items +} + +# ------------------------------------------------------------------ +# Method: lhs +# +# Purpose: Evaluates the specified arguments against the lhs Listbox +# +body ::iwidgets::Disjointlistbox::lhs {args} { + return [eval $itk_component(lhs) $args] +} + +# ------------------------------------------------------------------ +# Method: rhs +# +# Purpose: Evaluates the specified arguments against the rhs Listbox +# +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. +# +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 [code $this transfer] + } { + usual + rename -text -lhsbuttonlabel lhsButtonLabel LabelText + rename -font -labelfont labelFont Font + } + + itk_component add rhsbutton { + button $itk_component(bbox).rhsbutton -command [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 [code $this transfer] + } { + usual + rename -text -lhsbuttonlabel lhsButtonLabel LabelText + rename -font -labelfont labelFont Font + } + + itk_component add rhsbutton { + button $itk_interior.rhsbutton -command [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" + } + } + } +} + |