figenc

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

spinbox.tcl (15640B)


      1 # spinbox.tcl --
      2 #
      3 # This file defines the default bindings for Tk spinbox widgets and provides
      4 # procedures that help in implementing those bindings.  The spinbox builds
      5 # off the entry widget, so it can reuse Entry bindings and procedures.
      6 #
      7 # Copyright (c) 1992-1994 The Regents of the University of California.
      8 # Copyright (c) 1994-1997 Sun Microsystems, Inc.
      9 # Copyright (c) 1999-2000 Jeffrey Hobbs
     10 # Copyright (c) 2000 Ajuba Solutions
     11 #
     12 # See the file "license.terms" for information on usage and redistribution
     13 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
     14 #
     15 
     16 #-------------------------------------------------------------------------
     17 # Elements of tk::Priv that are used in this file:
     18 #
     19 # afterId -		If non-null, it means that auto-scanning is underway
     20 #			and it gives the "after" id for the next auto-scan
     21 #			command to be executed.
     22 # mouseMoved -		Non-zero means the mouse has moved a significant
     23 #			amount since the button went down (so, for example,
     24 #			start dragging out a selection).
     25 # pressX -		X-coordinate at which the mouse button was pressed.
     26 # selectMode -		The style of selection currently underway:
     27 #			char, word, or line.
     28 # x, y -		Last known mouse coordinates for scanning
     29 #			and auto-scanning.
     30 # data -		Used for Cut and Copy
     31 #-------------------------------------------------------------------------
     32 
     33 # Initialize namespace
     34 namespace eval ::tk::spinbox {}
     35 
     36 #-------------------------------------------------------------------------
     37 # The code below creates the default class bindings for entries.
     38 #-------------------------------------------------------------------------
     39 bind Spinbox <<Cut>> {
     40     if {![catch {::tk::spinbox::GetSelection %W} tk::Priv(data)]} {
     41 	clipboard clear -displayof %W
     42 	clipboard append -displayof %W $tk::Priv(data)
     43 	%W delete sel.first sel.last
     44 	unset tk::Priv(data)
     45     }
     46 }
     47 bind Spinbox <<Copy>> {
     48     if {![catch {::tk::spinbox::GetSelection %W} tk::Priv(data)]} {
     49 	clipboard clear -displayof %W
     50 	clipboard append -displayof %W $tk::Priv(data)
     51 	unset tk::Priv(data)
     52     }
     53 }
     54 bind Spinbox <<Paste>> {
     55     catch {
     56 	if {[tk windowingsystem] ne "x11"} {
     57 	    catch {
     58 		%W delete sel.first sel.last
     59 	    }
     60 	}
     61 	%W insert insert [::tk::GetSelection %W CLIPBOARD]
     62 	::tk::EntrySeeInsert %W
     63     }
     64 }
     65 bind Spinbox <<Clear>> {
     66     %W delete sel.first sel.last
     67 }
     68 bind Spinbox <<PasteSelection>> {
     69     if {$tk_strictMotif || ![info exists tk::Priv(mouseMoved)]
     70 	|| !$tk::Priv(mouseMoved)} {
     71 	::tk::spinbox::Paste %W %x
     72     }
     73 }
     74 
     75 bind Spinbox <<TraverseIn>> {
     76     %W selection range 0 end
     77     %W icursor end
     78 }
     79 
     80 # Standard Motif bindings:
     81 
     82 bind Spinbox <1> {
     83     ::tk::spinbox::ButtonDown %W %x %y
     84 }
     85 bind Spinbox <B1-Motion> {
     86     ::tk::spinbox::Motion %W %x %y
     87 }
     88 bind Spinbox <Double-1> {
     89     ::tk::spinbox::ArrowPress %W %x %y
     90     set tk::Priv(selectMode) word
     91     ::tk::spinbox::MouseSelect %W %x sel.first
     92 }
     93 bind Spinbox <Triple-1> {
     94     ::tk::spinbox::ArrowPress %W %x %y
     95     set tk::Priv(selectMode) line
     96     ::tk::spinbox::MouseSelect %W %x 0
     97 }
     98 bind Spinbox <Shift-1> {
     99     set tk::Priv(selectMode) char
    100     %W selection adjust @%x
    101 }
    102 bind Spinbox <Double-Shift-1> {
    103     set tk::Priv(selectMode) word
    104     ::tk::spinbox::MouseSelect %W %x
    105 }
    106 bind Spinbox <Triple-Shift-1> {
    107     set tk::Priv(selectMode) line
    108     ::tk::spinbox::MouseSelect %W %x
    109 }
    110 bind Spinbox <B1-Leave> {
    111     set tk::Priv(x) %x
    112     ::tk::spinbox::AutoScan %W
    113 }
    114 bind Spinbox <B1-Enter> {
    115     tk::CancelRepeat
    116 }
    117 bind Spinbox <ButtonRelease-1> {
    118     ::tk::spinbox::ButtonUp %W %x %y
    119 }
    120 bind Spinbox <Control-1> {
    121     %W icursor @%x
    122 }
    123 
    124 bind Spinbox <<PrevLine>> {
    125     %W invoke buttonup
    126 }
    127 bind Spinbox <<NextLine>> {
    128     %W invoke buttondown
    129 }
    130 
    131 bind Spinbox <<PrevChar>> {
    132     ::tk::EntrySetCursor %W [expr {[%W index insert] - 1}]
    133 }
    134 bind Spinbox <<NextChar>> {
    135     ::tk::EntrySetCursor %W [expr {[%W index insert] + 1}]
    136 }
    137 bind Spinbox <<SelectPrevChar>> {
    138     ::tk::EntryKeySelect %W [expr {[%W index insert] - 1}]
    139     ::tk::EntrySeeInsert %W
    140 }
    141 bind Spinbox <<SelectNextChar>> {
    142     ::tk::EntryKeySelect %W [expr {[%W index insert] + 1}]
    143     ::tk::EntrySeeInsert %W
    144 }
    145 bind Spinbox <<PrevWord>> {
    146     ::tk::EntrySetCursor %W [::tk::EntryPreviousWord %W insert]
    147 }
    148 bind Spinbox <<NextWord>> {
    149     ::tk::EntrySetCursor %W [::tk::EntryNextWord %W insert]
    150 }
    151 bind Spinbox <<SelectPrevWord>> {
    152     ::tk::EntryKeySelect %W [::tk::EntryPreviousWord %W insert]
    153     ::tk::EntrySeeInsert %W
    154 }
    155 bind Spinbox <<SelectNextWord>> {
    156     ::tk::EntryKeySelect %W [::tk::EntryNextWord %W insert]
    157     ::tk::EntrySeeInsert %W
    158 }
    159 bind Spinbox <<LineStart>> {
    160     ::tk::EntrySetCursor %W 0
    161 }
    162 bind Spinbox <<SelectLineStart>> {
    163     ::tk::EntryKeySelect %W 0
    164     ::tk::EntrySeeInsert %W
    165 }
    166 bind Spinbox <<LineEnd>> {
    167     ::tk::EntrySetCursor %W end
    168 }
    169 bind Spinbox <<SelectLineEnd>> {
    170     ::tk::EntryKeySelect %W end
    171     ::tk::EntrySeeInsert %W
    172 }
    173 
    174 bind Spinbox <Delete> {
    175     if {[%W selection present]} {
    176 	%W delete sel.first sel.last
    177     } else {
    178 	%W delete insert
    179     }
    180 }
    181 bind Spinbox <BackSpace> {
    182     ::tk::EntryBackspace %W
    183 }
    184 
    185 bind Spinbox <Control-space> {
    186     %W selection from insert
    187 }
    188 bind Spinbox <Select> {
    189     %W selection from insert
    190 }
    191 bind Spinbox <Control-Shift-space> {
    192     %W selection adjust insert
    193 }
    194 bind Spinbox <Shift-Select> {
    195     %W selection adjust insert
    196 }
    197 bind Spinbox <<SelectAll>> {
    198     %W selection range 0 end
    199 }
    200 bind Spinbox <<SelectNone>> {
    201     %W selection clear
    202 }
    203 bind Spinbox <KeyPress> {
    204     ::tk::EntryInsert %W %A
    205 }
    206 
    207 # Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
    208 # Otherwise, if a widget binding for one of these is defined, the
    209 # <KeyPress> class binding will also fire and insert the character,
    210 # which is wrong.  Ditto for Escape, Return, and Tab.
    211 
    212 bind Spinbox <Alt-KeyPress> {# nothing}
    213 bind Spinbox <Meta-KeyPress> {# nothing}
    214 bind Spinbox <Control-KeyPress> {# nothing}
    215 bind Spinbox <Escape> {# nothing}
    216 bind Spinbox <Return> {# nothing}
    217 bind Spinbox <KP_Enter> {# nothing}
    218 bind Spinbox <Tab> {# nothing}
    219 bind Spinbox <Prior> {# nothing}
    220 bind Spinbox <Next> {# nothing}
    221 if {[tk windowingsystem] eq "aqua"} {
    222     bind Spinbox <Command-KeyPress> {# nothing}
    223 }
    224 
    225 # On Windows, paste is done using Shift-Insert.  Shift-Insert already
    226 # generates the <<Paste>> event, so we don't need to do anything here.
    227 if {[tk windowingsystem] ne "win32"} {
    228     bind Spinbox <Insert> {
    229 	catch {::tk::EntryInsert %W [::tk::GetSelection %W PRIMARY]}
    230     }
    231 }
    232 
    233 # Additional emacs-like bindings:
    234 
    235 bind Spinbox <Control-d> {
    236     if {!$tk_strictMotif} {
    237 	%W delete insert
    238     }
    239 }
    240 bind Spinbox <Control-h> {
    241     if {!$tk_strictMotif} {
    242 	::tk::EntryBackspace %W
    243     }
    244 }
    245 bind Spinbox <Control-k> {
    246     if {!$tk_strictMotif} {
    247 	%W delete insert end
    248     }
    249 }
    250 bind Spinbox <Control-t> {
    251     if {!$tk_strictMotif} {
    252 	::tk::EntryTranspose %W
    253     }
    254 }
    255 bind Spinbox <Meta-b> {
    256     if {!$tk_strictMotif} {
    257 	::tk::EntrySetCursor %W [::tk::EntryPreviousWord %W insert]
    258     }
    259 }
    260 bind Spinbox <Meta-d> {
    261     if {!$tk_strictMotif} {
    262 	%W delete insert [::tk::EntryNextWord %W insert]
    263     }
    264 }
    265 bind Spinbox <Meta-f> {
    266     if {!$tk_strictMotif} {
    267 	::tk::EntrySetCursor %W [::tk::EntryNextWord %W insert]
    268     }
    269 }
    270 bind Spinbox <Meta-BackSpace> {
    271     if {!$tk_strictMotif} {
    272 	%W delete [::tk::EntryPreviousWord %W insert] insert
    273     }
    274 }
    275 bind Spinbox <Meta-Delete> {
    276     if {!$tk_strictMotif} {
    277 	%W delete [::tk::EntryPreviousWord %W insert] insert
    278     }
    279 }
    280 
    281 # A few additional bindings of my own.
    282 
    283 bind Spinbox <2> {
    284     if {!$tk_strictMotif} {
    285 	::tk::EntryScanMark %W %x
    286     }
    287 }
    288 bind Spinbox <B2-Motion> {
    289     if {!$tk_strictMotif} {
    290 	::tk::EntryScanDrag %W %x
    291     }
    292 }
    293 
    294 # ::tk::spinbox::Invoke --
    295 # Invoke an element of the spinbox
    296 #
    297 # Arguments:
    298 # w -		The spinbox window.
    299 # elem -	Element to invoke
    300 
    301 proc ::tk::spinbox::Invoke {w elem} {
    302     variable ::tk::Priv
    303 
    304     if {![winfo exists $w]} {
    305       return
    306     }
    307 
    308     if {![info exists Priv(outsideElement)]} {
    309 	$w invoke $elem
    310 	incr Priv(repeated)
    311     }
    312     set delay [$w cget -repeatinterval]
    313     if {$delay > 0} {
    314 	set Priv(afterId) [after $delay \
    315 		[list ::tk::spinbox::Invoke $w $elem]]
    316     }
    317 }
    318 
    319 # ::tk::spinbox::ClosestGap --
    320 # Given x and y coordinates, this procedure finds the closest boundary
    321 # between characters to the given coordinates and returns the index
    322 # of the character just after the boundary.
    323 #
    324 # Arguments:
    325 # w -		The spinbox window.
    326 # x -		X-coordinate within the window.
    327 
    328 proc ::tk::spinbox::ClosestGap {w x} {
    329     set pos [$w index @$x]
    330     set bbox [$w bbox $pos]
    331     if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} {
    332 	return $pos
    333     }
    334     incr pos
    335 }
    336 
    337 # ::tk::spinbox::ArrowPress --
    338 # This procedure is invoked to handle button-1 presses in buttonup
    339 # or buttondown elements of spinbox widgets.
    340 #
    341 # Arguments:
    342 # w -		The spinbox window in which the button was pressed.
    343 # x -		The x-coordinate of the button press.
    344 # y -		The y-coordinate of the button press.
    345 
    346 proc ::tk::spinbox::ArrowPress {w x y} {
    347     variable ::tk::Priv
    348 
    349     if {[$w cget -state] ne "disabled" && \
    350             [string match "button*" $Priv(element)]} {
    351         $w selection element $Priv(element)
    352         set Priv(repeated) 0
    353         set Priv(relief) [$w cget -$Priv(element)relief]
    354         catch {after cancel $Priv(afterId)}
    355         set delay [$w cget -repeatdelay]
    356         if {$delay > 0} {
    357             set Priv(afterId) [after $delay \
    358                     [list ::tk::spinbox::Invoke $w $Priv(element)]]
    359         }
    360         if {[info exists Priv(outsideElement)]} {
    361             unset Priv(outsideElement)
    362         }
    363     }
    364 }
    365 
    366 # ::tk::spinbox::ButtonDown --
    367 # This procedure is invoked to handle button-1 presses in spinbox
    368 # widgets.  It moves the insertion cursor, sets the selection anchor,
    369 # and claims the input focus.
    370 #
    371 # Arguments:
    372 # w -		The spinbox window in which the button was pressed.
    373 # x -		The x-coordinate of the button press.
    374 # y -		The y-coordinate of the button press.
    375 
    376 proc ::tk::spinbox::ButtonDown {w x y} {
    377     variable ::tk::Priv
    378 
    379     # Get the element that was clicked in.  If we are not directly over
    380     # the spinbox, default to entry.  This is necessary for spinbox grabs.
    381     #
    382     set Priv(element) [$w identify $x $y]
    383     if {$Priv(element) eq ""} {
    384 	set Priv(element) "entry"
    385     }
    386 
    387     switch -exact $Priv(element) {
    388 	"buttonup" - "buttondown" {
    389 	    ::tk::spinbox::ArrowPress $w $x $y
    390 	}
    391 	"entry" {
    392 	    set Priv(selectMode) char
    393 	    set Priv(mouseMoved) 0
    394 	    set Priv(pressX) $x
    395 	    $w icursor [::tk::spinbox::ClosestGap $w $x]
    396 	    $w selection from insert
    397 	    if {"disabled" ne [$w cget -state]} {focus $w}
    398 	    $w selection clear
    399 	}
    400 	default {
    401 	    return -code error -errorcode {TK SPINBOX UNKNOWN_ELEMENT} \
    402 		"unknown spinbox element \"$Priv(element)\""
    403 	}
    404     }
    405 }
    406 
    407 # ::tk::spinbox::ButtonUp --
    408 # This procedure is invoked to handle button-1 releases in spinbox
    409 # widgets.
    410 #
    411 # Arguments:
    412 # w -		The spinbox window in which the button was pressed.
    413 # x -		The x-coordinate of the button press.
    414 # y -		The y-coordinate of the button press.
    415 
    416 proc ::tk::spinbox::ButtonUp {w x y} {
    417     variable ::tk::Priv
    418 
    419     ::tk::CancelRepeat
    420 
    421     # Priv(relief) may not exist if the ButtonUp is not paired with
    422     # a preceding ButtonDown
    423     if {[info exists Priv(element)] && [info exists Priv(relief)] && \
    424 	    [string match "button*" $Priv(element)]} {
    425 	if {[info exists Priv(repeated)] && !$Priv(repeated)} {
    426 	    $w invoke $Priv(element)
    427 	}
    428 	$w configure -$Priv(element)relief $Priv(relief)
    429 	$w selection element none
    430     }
    431 }
    432 
    433 # ::tk::spinbox::MouseSelect --
    434 # This procedure is invoked when dragging out a selection with
    435 # the mouse.  Depending on the selection mode (character, word,
    436 # line) it selects in different-sized units.  This procedure
    437 # ignores mouse motions initially until the mouse has moved from
    438 # one character to another or until there have been multiple clicks.
    439 #
    440 # Arguments:
    441 # w -		The spinbox window in which the button was pressed.
    442 # x -		The x-coordinate of the mouse.
    443 # cursor -	optional place to set cursor.
    444 
    445 proc ::tk::spinbox::MouseSelect {w x {cursor {}}} {
    446     variable ::tk::Priv
    447 
    448     if {$Priv(element) ne "entry"} {
    449 	# The ButtonUp command triggered by ButtonRelease-1 handles
    450 	# invoking one of the spinbuttons.
    451 	return
    452     }
    453     set cur [::tk::spinbox::ClosestGap $w $x]
    454     set anchor [$w index anchor]
    455     if {($cur ne $anchor) || (abs($Priv(pressX) - $x) >= 3)} {
    456 	set Priv(mouseMoved) 1
    457     }
    458     switch $Priv(selectMode) {
    459 	char {
    460 	    if {$Priv(mouseMoved)} {
    461 		if {$cur < $anchor} {
    462 		    $w selection range $cur $anchor
    463 		} elseif {$cur > $anchor} {
    464 		    $w selection range $anchor $cur
    465 		} else {
    466 		    $w selection clear
    467 		}
    468 	    }
    469 	}
    470 	word {
    471 	    if {$cur < [$w index anchor]} {
    472 		set before [tcl_wordBreakBefore [$w get] $cur]
    473 		set after [tcl_wordBreakAfter [$w get] [expr {$anchor-1}]]
    474 	    } else {
    475 		set before [tcl_wordBreakBefore [$w get] $anchor]
    476 		set after [tcl_wordBreakAfter [$w get] [expr {$cur - 1}]]
    477 	    }
    478 	    if {$before < 0} {
    479 		set before 0
    480 	    }
    481 	    if {$after < 0} {
    482 		set after end
    483 	    }
    484 	    $w selection range $before $after
    485 	}
    486 	line {
    487 	    $w selection range 0 end
    488 	}
    489     }
    490     if {$cursor ne {} && $cursor ne "ignore"} {
    491 	catch {$w icursor $cursor}
    492     }
    493     update idletasks
    494 }
    495 
    496 # ::tk::spinbox::Paste --
    497 # This procedure sets the insertion cursor to the current mouse position,
    498 # pastes the selection there, and sets the focus to the window.
    499 #
    500 # Arguments:
    501 # w -		The spinbox window.
    502 # x -		X position of the mouse.
    503 
    504 proc ::tk::spinbox::Paste {w x} {
    505     $w icursor [::tk::spinbox::ClosestGap $w $x]
    506     catch {$w insert insert [::tk::GetSelection $w PRIMARY]}
    507     if {"disabled" eq [$w cget -state]} {
    508 	focus $w
    509     }
    510 }
    511 
    512 # ::tk::spinbox::Motion --
    513 # This procedure is invoked when the mouse moves in a spinbox window
    514 # with button 1 down.
    515 #
    516 # Arguments:
    517 # w -		The spinbox window.
    518 # x -		The x-coordinate of the mouse.
    519 # y -		The y-coordinate of the mouse.
    520 
    521 proc ::tk::spinbox::Motion {w x y} {
    522     variable ::tk::Priv
    523 
    524     if {![info exists Priv(element)]} {
    525 	set Priv(element) [$w identify $x $y]
    526     }
    527 
    528     set Priv(x) $x
    529     if {"entry" eq $Priv(element)} {
    530 	::tk::spinbox::MouseSelect $w $x ignore
    531     } elseif {[$w identify $x $y] ne $Priv(element)} {
    532 	if {![info exists Priv(outsideElement)]} {
    533 	    # We've wandered out of the spin button
    534 	    # setting outside element will cause ::tk::spinbox::Invoke to
    535 	    # loop without doing anything
    536 	    set Priv(outsideElement) ""
    537 	    $w selection element none
    538 	}
    539     } elseif {[info exists Priv(outsideElement)]} {
    540 	unset Priv(outsideElement)
    541 	$w selection element $Priv(element)
    542     }
    543 }
    544 
    545 # ::tk::spinbox::AutoScan --
    546 # This procedure is invoked when the mouse leaves an spinbox window
    547 # with button 1 down.  It scrolls the window left or right,
    548 # depending on where the mouse is, and reschedules itself as an
    549 # "after" command so that the window continues to scroll until the
    550 # mouse moves back into the window or the mouse button is released.
    551 #
    552 # Arguments:
    553 # w -		The spinbox window.
    554 
    555 proc ::tk::spinbox::AutoScan {w} {
    556     variable ::tk::Priv
    557 
    558     set x $Priv(x)
    559     if {$x >= [winfo width $w]} {
    560 	$w xview scroll 2 units
    561 	::tk::spinbox::MouseSelect $w $x ignore
    562     } elseif {$x < 0} {
    563 	$w xview scroll -2 units
    564 	::tk::spinbox::MouseSelect $w $x ignore
    565     }
    566     set Priv(afterId) [after 50 [list ::tk::spinbox::AutoScan $w]]
    567 }
    568 
    569 # ::tk::spinbox::GetSelection --
    570 #
    571 # Returns the selected text of the spinbox.  Differs from entry in that
    572 # a spinbox has no -show option to obscure contents.
    573 #
    574 # Arguments:
    575 # w -         The spinbox window from which the text to get
    576 
    577 proc ::tk::spinbox::GetSelection {w} {
    578     return [string range [$w get] [$w index sel.first] \
    579 	    [expr {[$w index sel.last] - 1}]]
    580 }