Why Gemfury? Push, build, and install  RubyGems npm packages Python packages Maven artifacts PHP packages Go Modules Debian packages RPM packages NuGet packages

Repository URL to install this package:

Details    
brlcad / usr / brlcad / share / tclscripts / swidgets / scripts / selectlists.itk
Size: Mime:
#                 S E L E C T L I S T S . I T K
# BRL-CAD
#
# Copyright (c) 2006-2016 United States Government as represented by
# the U.S. Army Research Laboratory.
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Lesser General Public License
# version 2.1 as published by the Free Software Foundation.
#
# This library is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# Lesser General Public License for more details.
#
# You should have received a copy of the GNU Lesser General Public
# License along with this file; see the file named COPYING for more
# information.
#
###
#
# Description:
#    Dual list boxes for selecting items.
#
##############################################################

#
# Default resources.
#


#
# Usual options.
#

# ------------------------------------------------------------
#                     SELECTLISTS
# ------------------------------------------------------------
itcl::class swidgets::Selectlists {
    inherit itk::Widget

    constructor {args} {}
    destructor {}

    itk_option define -sortlist1 sortList1 SortList1 true
    itk_option define -sortlist2 sortList2 SortList2 true
    itk_option define -numlines numlines Height 10
    itk_option define -lbwidth lbwidth Width 20
    itk_option define -unique unique Unique false
    itk_option define -command command Command {}
    itk_option define -state state State normal

    public {
	method component {name}
	method insert {index args}
	method clear {}
	method select {index}
	method unselect {index}
	method get {}
    }

    private {
	method _dblclick {list}
	method _add {}
	method _remove {}
	method _addall {}
	method _removeall {}
    }
}

#
# Provide a lowercased access method for the Selectlists class.
#
proc ::swidgets::selectlists {args} {
    uplevel ::swidgets::Selectlists $args
}

# ------------------------------------------------------------
#                      CONSTRUCTOR
# ------------------------------------------------------------
::itcl::body swidgets::Selectlists::constructor {args} {

    set frame [frame $itk_interior.frame]

    # LISTBOX 1
    itk_component add listbox1 {
	iwidgets::scrolledlistbox $frame.lstbox1 -vscrollmode static \
	    -hscrollmode dynamic -selectmode single \
	    -dblclickcommand [::itcl::code $this _dblclick "listbox1"]
    } {
	keep -textbackground
	rename -labelpos -labelpos1 labelPos1 Position
	rename -labeltext -labeltext1 labeltext1 Text
	rename -borderwidth -borderwidth1 borderWidth1 BorderWidth
	rename -relief -relief1 relief1 Relief
	rename -selectmode -selectmode1 selectMode1 SelectMode
    }

    # LISTBOX 2
    itk_component add listbox2 {
	iwidgets::scrolledlistbox $frame.lstbox2 -vscrollmode static \
	    -hscrollmode dynamic \
	    -dblclickcommand [::itcl::code $this _dblclick "listbox2"]
    } {
	keep -textbackground
	rename -labelpos -labelpos2 labelPos2 Position
	rename -labeltext -labeltext2 labelText2 Text
	rename -borderwidth -borderwidth2 borderWidth2 BorderWidth
	rename -relief -relief2 relief2 Relief
	rename -selectmode -selectmode2 selectMode2 SelectMode
    }

    set bbox [frame $frame.bbox]
    # ADD BUTTON
    itk_component add btn_add {
	button $bbox.add -text ">> Add >>" -command [::itcl::code $this _add]
    }
    itk_component add btn_all {
	button $bbox.all -text "Select All" -command [::itcl::code $this _addall]
    }
    itk_component add btn_del {
	button $bbox.del -text "<< Remove <<" -command [::itcl::code $this _remove]
    }

    grid $itk_component(btn_add) -column 0 -row 0 -padx 2 -pady 2 -sticky ew
    grid $itk_component(btn_all) -column 0 -row 1 -padx 2 -pady 2 -sticky ew
    grid $itk_component(btn_del) -column 0 -row 2 -padx 2 -pady 2 -sticky ew

    grid $itk_component(listbox1) -column 0 -row 0 -padx 2 -pady 2 -sticky nsew
    grid $bbox -column 1 -row 0;# -sticky ns
    grid $itk_component(listbox2) -column 2 -row 0 -padx 2 -pady 2 -sticky nsew
    grid columnconfigure $frame {0 2} -weight 1
    grid rowconfigure $frame 0 -weight 1
    pack $frame -fill both -expand yes


    #
    # Initialize the widget based on the command line options
    #
    eval itk_initialize $args
}

::itcl::body swidgets::Selectlists::destructor {} {
}

# ------------------------------------------------------------
#                        OPTIONS
# ------------------------------------------------------------
::itcl::configbody swidgets::Selectlists::sortlist1 {
    switch $itk_option(-sortlist1) {
	true -
	false {
	}
	default {
	    error "bad sortlist1 option \"$itk_option(-sortlist1)\":\
		    should be true or false"
	}
    }
}

::itcl::configbody swidgets::Selectlists::sortlist2 {
    switch $itk_option(-sortlist2) {
	true -
	false {
	}
	default {
	    error "bad sortlist2 option \"$itk_option(-sortlist2)\":\
		    should be true or false"
	}
    }
}

::itcl::configbody swidgets::Selectlists::unique {
    switch $itk_option(-unique) {
	true -
	false {
	}
	default {
	    error "bad unique option \"$itk_option(-unique)\":\
		    should be true or false"
	}
    }
}

::itcl::configbody swidgets::Selectlists::numlines {
    [$itk_component(listbox1) component listbox] configure -height $itk_option(-numlines)
    [$itk_component(listbox2) component listbox] configure -height $itk_option(-numlines)
}

::itcl::configbody swidgets::Selectlists::lbwidth {
    [$itk_component(listbox1) component listbox] configure -width $itk_option(-lbwidth)
    [$itk_component(listbox2) component listbox] configure -width $itk_option(-lbwidth)
}

::itcl::configbody swidgets::Selectlists::state {
    switch $itk_option(-state) {
	normal -
	disabled {
	    $itk_component(listbox1) configure -state $itk_option(-state)
	    $itk_component(listbox2) configure -state $itk_option(-state)
	    $itk_component(btn_add)  configure -state $itk_option(-state)
	    $itk_component(btn_all)  configure -state $itk_option(-state)
	    $itk_component(btn_del)  configure -state $itk_option(-state)
	}
	default {
	    error "bad state option \"$itk_option(-state)\":\
		    should be disabled or normal"
	}
    }
}

# ------------------------------------------------------------
#                        METHODS
# ------------------------------------------------------------
::itcl::body swidgets::Selectlists::_dblclick {list} {
    switch $list {
	"listbox1" {_add}
	"listbox2" {_remove}
    }
}

::itcl::body swidgets::Selectlists::_add {} {
    set selected [$itk_component(listbox1) curselection]
    if {$selected == ""} {return}
    foreach item $selected {
	$itk_component(listbox2) insert end [$itk_component(listbox1) get $item]
    }

    foreach item [lsort -integer -decreasing $selected] {
	$itk_component(listbox1) delete $item
    }

    # check for empty listbox1
    if {[$itk_component(listbox1) get 0] == ""} {
	$itk_component(btn_all) configure -text "Remove All" \
	    -command [::itcl::code $this _removeall]
    } else {
	$itk_component(btn_all) configure -text "Select All" \
	    -command [::itcl::code $this _addall]
    }

    if {$itk_option(-sortlist2) == "true"} {
	$itk_component(listbox2) sort ascending
    }

    # execute user command
    if {$itk_option(-command) != {}} {
	eval $itk_option(-command)
    }
}

::itcl::body swidgets::Selectlists::_remove {} {
    set selected [$itk_component(listbox2) curselection]
    if {$selected == ""} {return}
    foreach item $selected {
	$itk_component(listbox1) insert end [$itk_component(listbox2) get $item]
    }

    foreach item [lsort -integer -decreasing $selected] {
	$itk_component(listbox2) delete $item
    }

    # check for empty listbox1
    if {[$itk_component(listbox1) get 0] == ""} {
	$itk_component(btn_all) configure -text "Remove All" \
	    -command [::itcl::code $this _removeall]
    } else {
	$itk_component(btn_all) configure -text "Select All" \
	    -command [::itcl::code $this _addall]
    }

    if {$itk_option(-sortlist1) == "true"} {
	$itk_component(listbox1) sort ascending
    }

    # execute user command
    if {$itk_option(-command) != {}} {
	eval $itk_option(-command)
    }
}

::itcl::body swidgets::Selectlists::_addall {} {
    if {[$itk_component(listbox1) get 0] == ""} {return}
    while {[$itk_component(listbox1) get 0] != ""} {
	$itk_component(listbox2) insert end [$itk_component(listbox1) get 0]
	$itk_component(listbox1) delete 0
    }

    $itk_component(btn_all) configure -text "Remove All" \
	-command [::itcl::code $this _removeall]

    if {$itk_option(-sortlist2) == "true"} {
	$itk_component(listbox2) sort ascending
    }

    # execute user command
    if {$itk_option(-command) != {}} {
	eval $itk_option(-command)
    }
}

::itcl::body swidgets::Selectlists::_removeall {} {
    if {[$itk_component(listbox2) get 0] == ""} {return}
    while {[$itk_component(listbox2) get 0] != ""} {
	$itk_component(listbox1) insert end [$itk_component(listbox2) get 0]
	$itk_component(listbox2) delete 0
    }

    $itk_component(btn_all) configure -text "Select All" \
	-command [::itcl::code $this _addall]

    if {$itk_option(-sortlist1) == "true"} {
	$itk_component(listbox1) sort ascending
    }

    # execute user command
    if {$itk_option(-command) != {}} {
	eval $itk_option(-command)
    }
}

::itcl::body swidgets::Selectlists::component {name} {
    switch -- $name {
	"add"      {return $itk_component(btn_add)}
	"all"      {return $itk_component(btn_all)}
	"remove"   {return $itk_component(btn_del)}
	"listbox1" {return $itk_component(listbox1)}
	"listbox2" {return $itk_component(listbox2)}
	default {
	    error "bad component name \"$name\""
	}
    }
}

::itcl::body swidgets::Selectlists::insert {index args} {
    if {$itk_option(-state) == "disabled"} {return}
    if {[llength $args] < 2} {
	set args [lindex $args 0]
    }

    switch $index {
	"end" {
	    foreach item $args {
		# eliminate non-unique items if necessary
		if {$itk_option(-unique) == "true"} {
		    if {[lsearch [$itk_component(listbox1) get 0 end] $item] != -1 ||
			[lsearch [$itk_component(listbox2) get 0 end] $item] != -1} {
			continue
		    }
		}

		$itk_component(listbox1) insert end $item
	    }
	}
	default {
	    for {set i [expr [llength $args] -1]} {$i >= 0} {incr i -1} {
		set item [lindex $args $i]

		# eliminate non-unique items if necessary
		if {$itk_option(-unique) == "true"} {
		    if {[lsearch [$itk_component(listbox1) get 0 end] $item] != -1 ||
			[lsearch [$itk_component(listbox2) get 0 end] $item] != -1} {
			continue
		    }
		}

		$itk_component(listbox1) insert $index $item
	    }
	}
    }

    if {$itk_option(-sortlist1) == "true"} {
	$itk_component(listbox1) sort ascending
    }
}

::itcl::body swidgets::Selectlists::clear {} {
    if {$itk_option(-state) == "disabled"} {return}
    _removeall;  # move all elements to one list
    $itk_component(listbox1) delete 0 end
}

::itcl::body swidgets::Selectlists::unselect {index} {
    if {$itk_option(-state) == "disabled"} {return}
    set items [$itk_component(listbox2) get 0 end]
    if {[lsearch $items $index] > -1} {
	$itk_component(listbox2) selection set [lsearch $items $index]
	_remove
    }
}

::itcl::body swidgets::Selectlists::select {index} {
    if {$itk_option(-state) == "disabled"} {return}
    set items [$itk_component(listbox1) get 0 end]
    if {[lsearch $items $index] > -1} {
	$itk_component(listbox1) selection set [lsearch $items $index]
	_add
    } else {
	error "bad index $index"
    }
}

::itcl::body swidgets::Selectlists::get {} {
    return [$itk_component(listbox2) get 0 end]
}


# Local Variables:
# mode: Tcl
# tab-width: 8
# c-basic-offset: 4
# tcl-indent-level: 4
# indent-tabs-mode: t
# End:
# ex: shiftwidth=4 tabstop=8