path: root/itcl/iwidgets3.0.0/generic/disjointlistbox.itk

#
# ::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"
      }
    }
  }
}