/usr/share/tcltk/iwidgets4.0.1/scripts/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.
#
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)
    }
}
iwidgets4 4.0.1-6 / usr / share / tcltk / iwidgets4.0.1 / scripts / disjointlistbox.itk
