figenc

[RADIOACTIVE] rsa and symmetric key encryption scripts and executables
git clone git://git.figbert.com/figenc.git
Log | Files | Refs | README

listbox.tcl (14595B)


      1 # listbox.tcl --
      2 #
      3 # This file defines the default bindings for Tk listbox widgets
      4 # and provides procedures that help in implementing those bindings.
      5 #
      6 # Copyright (c) 1994 The Regents of the University of California.
      7 # Copyright (c) 1994-1995 Sun Microsystems, Inc.
      8 # Copyright (c) 1998 by Scriptics Corporation.
      9 #
     10 # See the file "license.terms" for information on usage and redistribution
     11 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
     12 
     13 #--------------------------------------------------------------------------
     14 # tk::Priv elements used in this file:
     15 #
     16 # afterId -		Token returned by "after" for autoscanning.
     17 # listboxPrev -		The last element to be selected or deselected
     18 #			during a selection operation.
     19 # listboxSelection -	All of the items that were selected before the
     20 #			current selection operation (such as a mouse
     21 #			drag) started;  used to cancel an operation.
     22 #--------------------------------------------------------------------------
     23 
     24 #-------------------------------------------------------------------------
     25 # The code below creates the default class bindings for listboxes.
     26 #-------------------------------------------------------------------------
     27 
     28 # Note: the check for existence of %W below is because this binding
     29 # is sometimes invoked after a window has been deleted (e.g. because
     30 # there is a double-click binding on the widget that deletes it).  Users
     31 # can put "break"s in their bindings to avoid the error, but this check
     32 # makes that unnecessary.
     33 
     34 bind Listbox <1> {
     35     if {[winfo exists %W]} {
     36 	tk::ListboxBeginSelect %W [%W index @%x,%y] 1
     37     }
     38 }
     39 
     40 # Ignore double clicks so that users can define their own behaviors.
     41 # Among other things, this prevents errors if the user deletes the
     42 # listbox on a double click.
     43 
     44 bind Listbox <Double-1> {
     45     # Empty script
     46 }
     47 
     48 bind Listbox <B1-Motion> {
     49     set tk::Priv(x) %x
     50     set tk::Priv(y) %y
     51     tk::ListboxMotion %W [%W index @%x,%y]
     52 }
     53 bind Listbox <ButtonRelease-1> {
     54     tk::CancelRepeat
     55     %W activate @%x,%y
     56 }
     57 bind Listbox <Shift-1> {
     58     tk::ListboxBeginExtend %W [%W index @%x,%y]
     59 }
     60 bind Listbox <Control-1> {
     61     tk::ListboxBeginToggle %W [%W index @%x,%y]
     62 }
     63 bind Listbox <B1-Leave> {
     64     set tk::Priv(x) %x
     65     set tk::Priv(y) %y
     66     tk::ListboxAutoScan %W
     67 }
     68 bind Listbox <B1-Enter> {
     69     tk::CancelRepeat
     70 }
     71 
     72 bind Listbox <<PrevLine>> {
     73     tk::ListboxUpDown %W -1
     74 }
     75 bind Listbox <<SelectPrevLine>> {
     76     tk::ListboxExtendUpDown %W -1
     77 }
     78 bind Listbox <<NextLine>> {
     79     tk::ListboxUpDown %W 1
     80 }
     81 bind Listbox <<SelectNextLine>> {
     82     tk::ListboxExtendUpDown %W 1
     83 }
     84 bind Listbox <<PrevChar>> {
     85     %W xview scroll -1 units
     86 }
     87 bind Listbox <<PrevWord>> {
     88     %W xview scroll -1 pages
     89 }
     90 bind Listbox <<NextChar>> {
     91     %W xview scroll 1 units
     92 }
     93 bind Listbox <<NextWord>> {
     94     %W xview scroll 1 pages
     95 }
     96 bind Listbox <Prior> {
     97     %W yview scroll -1 pages
     98     %W activate @0,0
     99 }
    100 bind Listbox <Next> {
    101     %W yview scroll 1 pages
    102     %W activate @0,0
    103 }
    104 bind Listbox <Control-Prior> {
    105     %W xview scroll -1 pages
    106 }
    107 bind Listbox <Control-Next> {
    108     %W xview scroll 1 pages
    109 }
    110 bind Listbox <<LineStart>> {
    111     %W xview moveto 0
    112 }
    113 bind Listbox <<LineEnd>> {
    114     %W xview moveto 1
    115 }
    116 bind Listbox <Control-Home> {
    117     %W activate 0
    118     %W see 0
    119     %W selection clear 0 end
    120     %W selection set 0
    121     tk::FireListboxSelectEvent %W
    122 }
    123 bind Listbox <Control-Shift-Home> {
    124     tk::ListboxDataExtend %W 0
    125 }
    126 bind Listbox <Control-End> {
    127     %W activate end
    128     %W see end
    129     %W selection clear 0 end
    130     %W selection set end
    131     tk::FireListboxSelectEvent %W
    132 }
    133 bind Listbox <Control-Shift-End> {
    134     tk::ListboxDataExtend %W [%W index end]
    135 }
    136 bind Listbox <<Copy>> {
    137     if {[selection own -displayof %W] eq "%W"} {
    138 	clipboard clear -displayof %W
    139 	clipboard append -displayof %W [selection get -displayof %W]
    140     }
    141 }
    142 bind Listbox <space> {
    143     tk::ListboxBeginSelect %W [%W index active]
    144 }
    145 bind Listbox <<Invoke>> {
    146     tk::ListboxBeginSelect %W [%W index active]
    147 }
    148 bind Listbox <Select> {
    149     tk::ListboxBeginSelect %W [%W index active]
    150 }
    151 bind Listbox <Control-Shift-space> {
    152     tk::ListboxBeginExtend %W [%W index active]
    153 }
    154 bind Listbox <Shift-Select> {
    155     tk::ListboxBeginExtend %W [%W index active]
    156 }
    157 bind Listbox <Escape> {
    158     tk::ListboxCancel %W
    159 }
    160 bind Listbox <<SelectAll>> {
    161     tk::ListboxSelectAll %W
    162 }
    163 bind Listbox <<SelectNone>> {
    164     if {[%W cget -selectmode] ne "browse"} {
    165 	%W selection clear 0 end
    166         tk::FireListboxSelectEvent %W
    167     }
    168 }
    169 
    170 # Additional Tk bindings that aren't part of the Motif look and feel:
    171 
    172 bind Listbox <2> {
    173     %W scan mark %x %y
    174 }
    175 bind Listbox <B2-Motion> {
    176     %W scan dragto %x %y
    177 }
    178 
    179 # The MouseWheel will typically only fire on Windows and Mac OS X.
    180 # However, someone could use the "event generate" command to produce
    181 # one on other platforms.
    182 
    183 if {[tk windowingsystem] eq "aqua"} {
    184     bind Listbox <MouseWheel> {
    185         %W yview scroll [expr {- (%D)}] units
    186     }
    187     bind Listbox <Option-MouseWheel> {
    188         %W yview scroll [expr {-10 * (%D)}] units
    189     }
    190     bind Listbox <Shift-MouseWheel> {
    191         %W xview scroll [expr {- (%D)}] units
    192     }
    193     bind Listbox <Shift-Option-MouseWheel> {
    194         %W xview scroll [expr {-10 * (%D)}] units
    195     }
    196 } else {
    197     bind Listbox <MouseWheel> {
    198         %W yview scroll [expr {- (%D / 120) * 4}] units
    199     }
    200     bind Listbox <Shift-MouseWheel> {
    201         %W xview scroll [expr {- (%D / 120) * 4}] units
    202     }
    203 }
    204 
    205 if {"x11" eq [tk windowingsystem]} {
    206     # Support for mousewheels on Linux/Unix commonly comes through mapping
    207     # the wheel to the extended buttons.  If you have a mousewheel, find
    208     # Linux configuration info at:
    209     #	http://linuxreviews.org/howtos/xfree/mouse/
    210     bind Listbox <4> {
    211 	if {!$tk_strictMotif} {
    212 	    %W yview scroll -5 units
    213 	}
    214     }
    215     bind Listbox <Shift-4> {
    216 	if {!$tk_strictMotif} {
    217 	    %W xview scroll -5 units
    218 	}
    219     }
    220     bind Listbox <5> {
    221 	if {!$tk_strictMotif} {
    222 	    %W yview scroll 5 units
    223 	}
    224     }
    225     bind Listbox <Shift-5> {
    226 	if {!$tk_strictMotif} {
    227 	    %W xview scroll 5 units
    228 	}
    229     }
    230 }
    231 
    232 # ::tk::ListboxBeginSelect --
    233 #
    234 # This procedure is typically invoked on button-1 presses.  It begins
    235 # the process of making a selection in the listbox.  Its exact behavior
    236 # depends on the selection mode currently in effect for the listbox;
    237 # see the Motif documentation for details.
    238 #
    239 # Arguments:
    240 # w -		The listbox widget.
    241 # el -		The element for the selection operation (typically the
    242 #		one under the pointer).  Must be in numerical form.
    243 
    244 proc ::tk::ListboxBeginSelect {w el {focus 1}} {
    245     variable ::tk::Priv
    246     if {[$w cget -selectmode] eq "multiple"} {
    247 	if {[$w selection includes $el]} {
    248 	    $w selection clear $el
    249 	} else {
    250 	    $w selection set $el
    251 	}
    252     } else {
    253 	$w selection clear 0 end
    254 	$w selection set $el
    255 	$w selection anchor $el
    256 	set Priv(listboxSelection) {}
    257 	set Priv(listboxPrev) $el
    258     }
    259     tk::FireListboxSelectEvent $w
    260     # check existence as ListboxSelect may destroy us
    261     if {$focus && [winfo exists $w] && [$w cget -state] eq "normal"} {
    262 	focus $w
    263     }
    264 }
    265 
    266 # ::tk::ListboxMotion --
    267 #
    268 # This procedure is called to process mouse motion events while
    269 # button 1 is down.  It may move or extend the selection, depending
    270 # on the listbox's selection mode.
    271 #
    272 # Arguments:
    273 # w -		The listbox widget.
    274 # el -		The element under the pointer (must be a number).
    275 
    276 proc ::tk::ListboxMotion {w el} {
    277     variable ::tk::Priv
    278     if {$el == $Priv(listboxPrev)} {
    279 	return
    280     }
    281     set anchor [$w index anchor]
    282     switch [$w cget -selectmode] {
    283 	browse {
    284 	    $w selection clear 0 end
    285 	    $w selection set $el
    286 	    set Priv(listboxPrev) $el
    287 	    tk::FireListboxSelectEvent $w
    288 	}
    289 	extended {
    290 	    set i $Priv(listboxPrev)
    291 	    if {$i eq ""} {
    292 		set i $el
    293 		$w selection set $el
    294 	    }
    295 	    if {[$w selection includes anchor]} {
    296 		$w selection clear $i $el
    297 		$w selection set anchor $el
    298 	    } else {
    299 		$w selection clear $i $el
    300 		$w selection clear anchor $el
    301 	    }
    302 	    if {![info exists Priv(listboxSelection)]} {
    303 		set Priv(listboxSelection) [$w curselection]
    304 	    }
    305 	    while {($i < $el) && ($i < $anchor)} {
    306 		if {[lsearch $Priv(listboxSelection) $i] >= 0} {
    307 		    $w selection set $i
    308 		}
    309 		incr i
    310 	    }
    311 	    while {($i > $el) && ($i > $anchor)} {
    312 		if {[lsearch $Priv(listboxSelection) $i] >= 0} {
    313 		    $w selection set $i
    314 		}
    315 		incr i -1
    316 	    }
    317 	    set Priv(listboxPrev) $el
    318 	    tk::FireListboxSelectEvent $w
    319 	}
    320     }
    321 }
    322 
    323 # ::tk::ListboxBeginExtend --
    324 #
    325 # This procedure is typically invoked on shift-button-1 presses.  It
    326 # begins the process of extending a selection in the listbox.  Its
    327 # exact behavior depends on the selection mode currently in effect
    328 # for the listbox;  see the Motif documentation for details.
    329 #
    330 # Arguments:
    331 # w -		The listbox widget.
    332 # el -		The element for the selection operation (typically the
    333 #		one under the pointer).  Must be in numerical form.
    334 
    335 proc ::tk::ListboxBeginExtend {w el} {
    336     if {[$w cget -selectmode] eq "extended"} {
    337 	if {[$w selection includes anchor]} {
    338 	    ListboxMotion $w $el
    339 	} else {
    340 	    # No selection yet; simulate the begin-select operation.
    341 	    ListboxBeginSelect $w $el
    342 	}
    343     }
    344 }
    345 
    346 # ::tk::ListboxBeginToggle --
    347 #
    348 # This procedure is typically invoked on control-button-1 presses.  It
    349 # begins the process of toggling a selection in the listbox.  Its
    350 # exact behavior depends on the selection mode currently in effect
    351 # for the listbox;  see the Motif documentation for details.
    352 #
    353 # Arguments:
    354 # w -		The listbox widget.
    355 # el -		The element for the selection operation (typically the
    356 #		one under the pointer).  Must be in numerical form.
    357 
    358 proc ::tk::ListboxBeginToggle {w el} {
    359     variable ::tk::Priv
    360     if {[$w cget -selectmode] eq "extended"} {
    361 	set Priv(listboxSelection) [$w curselection]
    362 	set Priv(listboxPrev) $el
    363 	$w selection anchor $el
    364 	if {[$w selection includes $el]} {
    365 	    $w selection clear $el
    366 	} else {
    367 	    $w selection set $el
    368 	}
    369 	tk::FireListboxSelectEvent $w
    370     }
    371 }
    372 
    373 # ::tk::ListboxAutoScan --
    374 # This procedure is invoked when the mouse leaves an entry window
    375 # with button 1 down.  It scrolls the window up, down, left, or
    376 # right, depending on where the mouse left the window, and reschedules
    377 # itself as an "after" command so that the window continues to scroll until
    378 # the mouse moves back into the window or the mouse button is released.
    379 #
    380 # Arguments:
    381 # w -		The entry window.
    382 
    383 proc ::tk::ListboxAutoScan {w} {
    384     variable ::tk::Priv
    385     if {![winfo exists $w]} return
    386     set x $Priv(x)
    387     set y $Priv(y)
    388     if {$y >= [winfo height $w]} {
    389 	$w yview scroll 1 units
    390     } elseif {$y < 0} {
    391 	$w yview scroll -1 units
    392     } elseif {$x >= [winfo width $w]} {
    393 	$w xview scroll 2 units
    394     } elseif {$x < 0} {
    395 	$w xview scroll -2 units
    396     } else {
    397 	return
    398     }
    399     ListboxMotion $w [$w index @$x,$y]
    400     set Priv(afterId) [after 50 [list tk::ListboxAutoScan $w]]
    401 }
    402 
    403 # ::tk::ListboxUpDown --
    404 #
    405 # Moves the location cursor (active element) up or down by one element,
    406 # and changes the selection if we're in browse or extended selection
    407 # mode.
    408 #
    409 # Arguments:
    410 # w -		The listbox widget.
    411 # amount -	+1 to move down one item, -1 to move back one item.
    412 
    413 proc ::tk::ListboxUpDown {w amount} {
    414     variable ::tk::Priv
    415     $w activate [expr {[$w index active] + $amount}]
    416     $w see active
    417     switch [$w cget -selectmode] {
    418 	browse {
    419 	    $w selection clear 0 end
    420 	    $w selection set active
    421 	    tk::FireListboxSelectEvent $w
    422 	}
    423 	extended {
    424 	    $w selection clear 0 end
    425 	    $w selection set active
    426 	    $w selection anchor active
    427 	    set Priv(listboxPrev) [$w index active]
    428 	    set Priv(listboxSelection) {}
    429 	    tk::FireListboxSelectEvent $w
    430 	}
    431     }
    432 }
    433 
    434 # ::tk::ListboxExtendUpDown --
    435 #
    436 # Does nothing unless we're in extended selection mode;  in this
    437 # case it moves the location cursor (active element) up or down by
    438 # one element, and extends the selection to that point.
    439 #
    440 # Arguments:
    441 # w -		The listbox widget.
    442 # amount -	+1 to move down one item, -1 to move back one item.
    443 
    444 proc ::tk::ListboxExtendUpDown {w amount} {
    445     variable ::tk::Priv
    446     if {[$w cget -selectmode] ne "extended"} {
    447 	return
    448     }
    449     set active [$w index active]
    450     if {![info exists Priv(listboxSelection)]} {
    451 	$w selection set $active
    452 	set Priv(listboxSelection) [$w curselection]
    453     }
    454     $w activate [expr {$active + $amount}]
    455     $w see active
    456     ListboxMotion $w [$w index active]
    457 }
    458 
    459 # ::tk::ListboxDataExtend
    460 #
    461 # This procedure is called for key-presses such as Shift-KEndData.
    462 # If the selection mode isn't multiple or extend then it does nothing.
    463 # Otherwise it moves the active element to el and, if we're in
    464 # extended mode, extends the selection to that point.
    465 #
    466 # Arguments:
    467 # w -		The listbox widget.
    468 # el -		An integer element number.
    469 
    470 proc ::tk::ListboxDataExtend {w el} {
    471     set mode [$w cget -selectmode]
    472     if {$mode eq "extended"} {
    473 	$w activate $el
    474 	$w see $el
    475         if {[$w selection includes anchor]} {
    476 	    ListboxMotion $w $el
    477 	}
    478     } elseif {$mode eq "multiple"} {
    479 	$w activate $el
    480 	$w see $el
    481     }
    482 }
    483 
    484 # ::tk::ListboxCancel
    485 #
    486 # This procedure is invoked to cancel an extended selection in
    487 # progress.  If there is an extended selection in progress, it
    488 # restores all of the items between the active one and the anchor
    489 # to their previous selection state.
    490 #
    491 # Arguments:
    492 # w -		The listbox widget.
    493 
    494 proc ::tk::ListboxCancel w {
    495     variable ::tk::Priv
    496     if {[$w cget -selectmode] ne "extended"} {
    497 	return
    498     }
    499     set first [$w index anchor]
    500     set last $Priv(listboxPrev)
    501     if {$last eq ""} {
    502 	# Not actually doing any selection right now
    503 	return
    504     }
    505     if {$first > $last} {
    506 	set tmp $first
    507 	set first $last
    508 	set last $tmp
    509     }
    510     $w selection clear $first $last
    511     while {$first <= $last} {
    512 	if {[lsearch $Priv(listboxSelection) $first] >= 0} {
    513 	    $w selection set $first
    514 	}
    515 	incr first
    516     }
    517     tk::FireListboxSelectEvent $w
    518 }
    519 
    520 # ::tk::ListboxSelectAll
    521 #
    522 # This procedure is invoked to handle the "select all" operation.
    523 # For single and browse mode, it just selects the active element.
    524 # Otherwise it selects everything in the widget.
    525 #
    526 # Arguments:
    527 # w -		The listbox widget.
    528 
    529 proc ::tk::ListboxSelectAll w {
    530     set mode [$w cget -selectmode]
    531     if {$mode eq "single" || $mode eq "browse"} {
    532 	$w selection clear 0 end
    533 	$w selection set active
    534     } else {
    535 	$w selection set 0 end
    536     }
    537     tk::FireListboxSelectEvent $w
    538 }
    539 
    540 # ::tk::FireListboxSelectEvent
    541 #
    542 # Fire the <<ListboxSelect>> event if the listbox is not in disabled
    543 # state.
    544 #
    545 # Arguments:
    546 # w -		The listbox widget.
    547 
    548 proc ::tk::FireListboxSelectEvent w {
    549     if {[$w cget -state] eq "normal"} {
    550         event generate $w <<ListboxSelect>>
    551     }
    552 }