--- /dev/null
+#
+# ::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)
+ }
+}
OSDN Git Service
