figenc

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

entry.tcl (16950B)


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