Subversion Repositories or1k_old

#

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

  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"

      }

    }

  }

}