/usr/share/tcltk/iwidgets4.0.1/scripts/disjointlistbox.itk is in iwidgets4 4.0.1-6.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 | #
# ::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)
}
}
|