figenc

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

entry.tcl (16396B)


      1 #
      2 # DERIVED FROM: tk/library/entry.tcl r1.22
      3 #
      4 # Copyright (c) 1992-1994 The Regents of the University of California.
      5 # Copyright (c) 1994-1997 Sun Microsystems, Inc.
      6 # Copyright (c) 2004, Joe English
      7 #
      8 # See the file "license.terms" for information on usage and redistribution
      9 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
     10 #
     11 
     12 namespace eval ttk {
     13     namespace eval entry {
     14 	variable State
     15 
     16 	set State(x) 0
     17 	set State(selectMode) none
     18 	set State(anchor) 0
     19 	set State(scanX) 0
     20 	set State(scanIndex) 0
     21 	set State(scanMoved) 0
     22 
     23 	# Button-2 scan speed is (scanNum/scanDen) characters
     24 	# per pixel of mouse movement.
     25 	# The standard Tk entry widget uses the equivalent of
     26 	# scanNum = 10, scanDen = average character width.
     27 	# I don't know why that was chosen.
     28 	#
     29 	set State(scanNum) 1
     30 	set State(scanDen) 1
     31 	set State(deadband) 3	;# #pixels for mouse-moved deadband.
     32     }
     33 }
     34 
     35 ### Option database settings.
     36 #
     37 option add *TEntry.cursor [ttk::cursor text]
     38 
     39 ### Bindings.
     40 #
     41 # Removed the following standard Tk bindings:
     42 #
     43 # <Control-Key-space>, <Control-Shift-Key-space>,
     44 # <Key-Select>,  <Shift-Key-Select>:
     45 #	Ttk entry widget doesn't use selection anchor.
     46 # <Key-Insert>:
     47 #	Inserts PRIMARY selection (on non-Windows platforms).
     48 #	This is inconsistent with typical platform bindings.
     49 # <Double-Shift-ButtonPress-1>, <Triple-Shift-ButtonPress-1>:
     50 #	These don't do the right thing to start with.
     51 # <Meta-Key-b>, <Meta-Key-d>, <Meta-Key-f>,
     52 # <Meta-Key-BackSpace>, <Meta-Key-Delete>:
     53 #	Judgment call.  If <Meta> happens to be assigned to the Alt key,
     54 #	these could conflict with application accelerators.
     55 #	(Plus, who has a Meta key these days?)
     56 # <Control-Key-t>:
     57 #	Another judgment call.  If anyone misses this, let me know
     58 #	and I'll put it back.
     59 #
     60 
     61 ## Clipboard events:
     62 #
     63 bind TEntry <<Cut>> 			{ ttk::entry::Cut %W }
     64 bind TEntry <<Copy>> 			{ ttk::entry::Copy %W }
     65 bind TEntry <<Paste>> 			{ ttk::entry::Paste %W }
     66 bind TEntry <<Clear>> 			{ ttk::entry::Clear %W }
     67 
     68 ## Button1 bindings:
     69 #	Used for selection and navigation.
     70 #
     71 bind TEntry <ButtonPress-1> 		{ ttk::entry::Press %W %x }
     72 bind TEntry <Shift-ButtonPress-1>	{ ttk::entry::Shift-Press %W %x }
     73 bind TEntry <Double-ButtonPress-1> 	{ ttk::entry::Select %W %x word }
     74 bind TEntry <Triple-ButtonPress-1> 	{ ttk::entry::Select %W %x line }
     75 bind TEntry <B1-Motion>			{ ttk::entry::Drag %W %x }
     76 
     77 bind TEntry <B1-Leave> 		{ ttk::entry::DragOut %W %m }
     78 bind TEntry <B1-Enter>		{ ttk::entry::DragIn %W }
     79 bind TEntry <ButtonRelease-1>	{ ttk::entry::Release %W }
     80 
     81 bind TEntry <<ToggleSelection>> {
     82     %W instate {!readonly !disabled} { %W icursor @%x ; focus %W }
     83 }
     84 
     85 ## Button2 bindings:
     86 #	Used for scanning and primary transfer.
     87 #	Note: ButtonRelease-2 is mapped to <<PasteSelection>> in tk.tcl.
     88 #
     89 bind TEntry <ButtonPress-2> 		{ ttk::entry::ScanMark %W %x }
     90 bind TEntry <B2-Motion> 		{ ttk::entry::ScanDrag %W %x }
     91 bind TEntry <ButtonRelease-2>		{ ttk::entry::ScanRelease %W %x }
     92 bind TEntry <<PasteSelection>>		{ ttk::entry::ScanRelease %W %x }
     93 
     94 ## Keyboard navigation bindings:
     95 #
     96 bind TEntry <<PrevChar>>		{ ttk::entry::Move %W prevchar }
     97 bind TEntry <<NextChar>> 		{ ttk::entry::Move %W nextchar }
     98 bind TEntry <<PrevWord>>		{ ttk::entry::Move %W prevword }
     99 bind TEntry <<NextWord>>		{ ttk::entry::Move %W nextword }
    100 bind TEntry <<LineStart>>		{ ttk::entry::Move %W home }
    101 bind TEntry <<LineEnd>>			{ ttk::entry::Move %W end }
    102 
    103 bind TEntry <<SelectPrevChar>> 		{ ttk::entry::Extend %W prevchar }
    104 bind TEntry <<SelectNextChar>>		{ ttk::entry::Extend %W nextchar }
    105 bind TEntry <<SelectPrevWord>>		{ ttk::entry::Extend %W prevword }
    106 bind TEntry <<SelectNextWord>>		{ ttk::entry::Extend %W nextword }
    107 bind TEntry <<SelectLineStart>>		{ ttk::entry::Extend %W home }
    108 bind TEntry <<SelectLineEnd>>		{ ttk::entry::Extend %W end }
    109 
    110 bind TEntry <<SelectAll>> 		{ %W selection range 0 end }
    111 bind TEntry <<SelectNone>> 		{ %W selection clear }
    112 
    113 bind TEntry <<TraverseIn>> 	{ %W selection range 0 end; %W icursor end }
    114 
    115 ## Edit bindings:
    116 #
    117 bind TEntry <KeyPress> 			{ ttk::entry::Insert %W %A }
    118 bind TEntry <Key-Delete>		{ ttk::entry::Delete %W }
    119 bind TEntry <Key-BackSpace> 		{ ttk::entry::Backspace %W }
    120 
    121 # Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
    122 # Otherwise, the <KeyPress> class binding will fire and insert the character.
    123 # Ditto for Escape, Return, and Tab.
    124 #
    125 bind TEntry <Alt-KeyPress>		{# nothing}
    126 bind TEntry <Meta-KeyPress>		{# nothing}
    127 bind TEntry <Control-KeyPress> 		{# nothing}
    128 bind TEntry <Key-Escape> 		{# nothing}
    129 bind TEntry <Key-Return> 		{# nothing}
    130 bind TEntry <Key-KP_Enter> 		{# nothing}
    131 bind TEntry <Key-Tab> 			{# nothing}
    132 
    133 # Argh.  Apparently on Windows, the NumLock modifier is interpreted
    134 # as a Command modifier.
    135 if {[tk windowingsystem] eq "aqua"} {
    136     bind TEntry <Command-KeyPress>	{# nothing}
    137 }
    138 # Tk-on-Cocoa generates characters for these two keys. [Bug 2971663]
    139 bind TEntry <<PrevLine>>		{# nothing}
    140 bind TEntry <<NextLine>>		{# nothing}
    141 
    142 ## Additional emacs-like bindings:
    143 #
    144 bind TEntry <Control-Key-d>		{ ttk::entry::Delete %W }
    145 bind TEntry <Control-Key-h>		{ ttk::entry::Backspace %W }
    146 bind TEntry <Control-Key-k>		{ %W delete insert end }
    147 
    148 ### Clipboard procedures.
    149 #
    150 
    151 ## EntrySelection -- Return the selected text of the entry.
    152 #	Raises an error if there is no selection.
    153 #
    154 proc ttk::entry::EntrySelection {w} {
    155     set entryString [string range [$w get] [$w index sel.first] \
    156 	    [expr {[$w index sel.last] - 1}]]
    157     if {[$w cget -show] ne ""} {
    158 	return [string repeat [string index [$w cget -show] 0] \
    159 		[string length $entryString]]
    160     }
    161     return $entryString
    162 }
    163 
    164 ## Paste -- Insert clipboard contents at current insert point.
    165 #
    166 proc ttk::entry::Paste {w} {
    167     catch {
    168 	set clipboard [::tk::GetSelection $w CLIPBOARD]
    169 	PendingDelete $w
    170 	$w insert insert $clipboard
    171 	See $w insert
    172     }
    173 }
    174 
    175 ## Copy -- Copy selection to clipboard.
    176 #
    177 proc ttk::entry::Copy {w} {
    178     if {![catch {EntrySelection $w} selection]} {
    179 	clipboard clear -displayof $w
    180 	clipboard append -displayof $w $selection
    181     }
    182 }
    183 
    184 ## Clear -- Delete the selection.
    185 #
    186 proc ttk::entry::Clear {w} {
    187     catch { $w delete sel.first sel.last }
    188 }
    189 
    190 ## Cut -- Copy selection to clipboard then delete it.
    191 #
    192 proc ttk::entry::Cut {w} {
    193     Copy $w; Clear $w
    194 }
    195 
    196 ### Navigation procedures.
    197 #
    198 
    199 ## ClosestGap -- Find closest boundary between characters.
    200 # 	Returns the index of the character just after the boundary.
    201 #
    202 proc ttk::entry::ClosestGap {w x} {
    203     set pos [$w index @$x]
    204     set bbox [$w bbox $pos]
    205     if {$x - [lindex $bbox 0] > [lindex $bbox 2]/2} {
    206 	incr pos
    207     }
    208     return $pos
    209 }
    210 
    211 ## See $index -- Make sure that the character at $index is visible.
    212 #
    213 proc ttk::entry::See {w {index insert}} {
    214     update idletasks	;# ensure scroll data up-to-date
    215     set c [$w index $index]
    216     # @@@ OR: check [$w index left] / [$w index right]
    217     if {$c < [$w index @0] || $c >= [$w index @[winfo width $w]]} {
    218 	$w xview $c
    219     }
    220 }
    221 
    222 ## NextWord -- Find the next word position.
    223 #	Note: The "next word position" follows platform conventions:
    224 #	either the next end-of-word position, or the start-of-word
    225 #	position following the next end-of-word position.
    226 #
    227 set ::ttk::entry::State(startNext) \
    228 	[string equal [tk windowingsystem] "win32"]
    229 
    230 proc ttk::entry::NextWord {w start} {
    231     variable State
    232     set pos [tcl_endOfWord [$w get] [$w index $start]]
    233     if {$pos >= 0 && $State(startNext)} {
    234 	set pos [tcl_startOfNextWord [$w get] $pos]
    235     }
    236     if {$pos < 0} {
    237 	return end
    238     }
    239     return $pos
    240 }
    241 
    242 ## PrevWord -- Find the previous word position.
    243 #
    244 proc ttk::entry::PrevWord {w start} {
    245     set pos [tcl_startOfPreviousWord [$w get] [$w index $start]]
    246     if {$pos < 0} {
    247 	return 0
    248     }
    249     return $pos
    250 }
    251 
    252 ## RelIndex -- Compute character/word/line-relative index.
    253 #
    254 proc ttk::entry::RelIndex {w where {index insert}} {
    255     switch -- $where {
    256 	prevchar	{ expr {[$w index $index] - 1} }
    257     	nextchar	{ expr {[$w index $index] + 1} }
    258 	prevword	{ PrevWord $w $index }
    259 	nextword	{ NextWord $w $index }
    260 	home		{ return 0 }
    261 	end		{ $w index end }
    262 	default		{ error "Bad relative index $index" }
    263     }
    264 }
    265 
    266 ## Move -- Move insert cursor to relative location.
    267 #	Also clears the selection, if any, and makes sure
    268 #	that the insert cursor is visible.
    269 #
    270 proc ttk::entry::Move {w where} {
    271     $w icursor [RelIndex $w $where]
    272     $w selection clear
    273     See $w insert
    274 }
    275 
    276 ### Selection procedures.
    277 #
    278 
    279 ## ExtendTo -- Extend the selection to the specified index.
    280 #
    281 # The other end of the selection (the anchor) is determined as follows:
    282 #
    283 # (1) if there is no selection, the anchor is the insert cursor;
    284 # (2) if the index is outside the selection, grow the selection;
    285 # (3) if the insert cursor is at one end of the selection, anchor the other end
    286 # (4) otherwise anchor the start of the selection
    287 #
    288 # The insert cursor is placed at the new end of the selection.
    289 #
    290 # Returns: selection anchor.
    291 #
    292 proc ttk::entry::ExtendTo {w index} {
    293     set index [$w index $index]
    294     set insert [$w index insert]
    295 
    296     # Figure out selection anchor:
    297     if {![$w selection present]} {
    298     	set anchor $insert
    299     } else {
    300     	set selfirst [$w index sel.first]
    301 	set sellast  [$w index sel.last]
    302 
    303 	if {   ($index < $selfirst)
    304 	    || ($insert == $selfirst && $index <= $sellast)
    305 	} {
    306 	    set anchor $sellast
    307 	} else {
    308 	    set anchor $selfirst
    309 	}
    310     }
    311 
    312     # Extend selection:
    313     if {$anchor < $index} {
    314 	$w selection range $anchor $index
    315     } else {
    316     	$w selection range $index $anchor
    317     }
    318 
    319     $w icursor $index
    320     return $anchor
    321 }
    322 
    323 ## Extend -- Extend the selection to a relative position, show insert cursor
    324 #
    325 proc ttk::entry::Extend {w where} {
    326     ExtendTo $w [RelIndex $w $where]
    327     See $w
    328 }
    329 
    330 ### Button 1 binding procedures.
    331 #
    332 # Double-clicking followed by a drag enters "word-select" mode.
    333 # Triple-clicking enters "line-select" mode.
    334 #
    335 
    336 ## Press -- ButtonPress-1 binding.
    337 #	Set the insertion cursor, claim the input focus, set up for
    338 #	future drag operations.
    339 #
    340 proc ttk::entry::Press {w x} {
    341     variable State
    342 
    343     $w icursor [ClosestGap $w $x]
    344     $w selection clear
    345     $w instate !disabled { focus $w }
    346 
    347     # Set up for future drag, double-click, or triple-click.
    348     set State(x) $x
    349     set State(selectMode) char
    350     set State(anchor) [$w index insert]
    351 }
    352 
    353 ## Shift-Press -- Shift-ButtonPress-1 binding.
    354 #	Extends the selection, sets anchor for future drag operations.
    355 #
    356 proc ttk::entry::Shift-Press {w x} {
    357     variable State
    358 
    359     focus $w
    360     set anchor [ExtendTo $w @$x]
    361 
    362     set State(x) $x
    363     set State(selectMode) char
    364     set State(anchor) $anchor
    365 }
    366 
    367 ## Select $w $x $mode -- Binding for double- and triple- clicks.
    368 #	Selects a word or line (according to mode),
    369 #	and sets the selection mode for subsequent drag operations.
    370 #
    371 proc ttk::entry::Select {w x mode} {
    372     variable State
    373     set cur [ClosestGap $w $x]
    374 
    375     switch -- $mode {
    376     	word	{ WordSelect $w $cur $cur }
    377     	line	{ LineSelect $w $cur $cur }
    378 	char	{ # no-op }
    379     }
    380 
    381     set State(anchor) $cur
    382     set State(selectMode) $mode
    383 }
    384 
    385 ## Drag -- Button1 motion binding.
    386 #
    387 proc ttk::entry::Drag {w x} {
    388     variable State
    389     set State(x) $x
    390     DragTo $w $x
    391 }
    392 
    393 ## DragTo $w $x -- Extend selection to $x based on current selection mode.
    394 #
    395 proc ttk::entry::DragTo {w x} {
    396     variable State
    397 
    398     set cur [ClosestGap $w $x]
    399     switch $State(selectMode) {
    400 	char { CharSelect $w $State(anchor) $cur }
    401 	word { WordSelect $w $State(anchor) $cur }
    402 	line { LineSelect $w $State(anchor) $cur }
    403 	none { # no-op }
    404     }
    405 }
    406 
    407 ## <B1-Leave> binding:
    408 #	Begin autoscroll.
    409 #
    410 proc ttk::entry::DragOut {w mode} {
    411     variable State
    412     if {$State(selectMode) ne "none" && $mode eq "NotifyNormal"} {
    413 	ttk::Repeatedly ttk::entry::AutoScroll $w
    414     }
    415 }
    416 
    417 ## <B1-Enter> binding
    418 # 	Suspend autoscroll.
    419 #
    420 proc ttk::entry::DragIn {w} {
    421     ttk::CancelRepeat 
    422 }
    423 
    424 ## <ButtonRelease-1> binding
    425 #
    426 proc ttk::entry::Release {w} {
    427     variable State
    428     set State(selectMode) none
    429     ttk::CancelRepeat 	;# suspend autoscroll
    430 }
    431 
    432 ## AutoScroll
    433 #	Called repeatedly when the mouse is outside an entry window
    434 #	with Button 1 down.  Scroll the window left or right,
    435 #	depending on where the mouse left the window, and extend 
    436 #	the selection according to the current selection mode.
    437 #
    438 # TODO: AutoScroll should repeat faster (50ms) than normal autorepeat.
    439 # TODO: Need a way for Repeat scripts to cancel themselves.
    440 #
    441 proc ttk::entry::AutoScroll {w} {
    442     variable State
    443     if {![winfo exists $w]} return
    444     set x $State(x)
    445     if {$x > [winfo width $w]} {
    446 	$w xview scroll 2 units
    447 	DragTo $w $x
    448     } elseif {$x < 0} {
    449 	$w xview scroll -2 units
    450 	DragTo $w $x
    451     }
    452 }
    453 
    454 ## CharSelect -- select characters between index $from and $to
    455 #
    456 proc ttk::entry::CharSelect {w from to} {
    457     if {$to <= $from} {
    458 	$w selection range $to $from
    459     } else {
    460 	$w selection range $from $to
    461     }
    462     $w icursor $to
    463 }
    464 
    465 ## WordSelect -- Select whole words between index $from and $to
    466 #
    467 proc ttk::entry::WordSelect {w from to} {
    468     if {$to < $from} {
    469 	set first [WordBack [$w get] $to]
    470 	set last [WordForward [$w get] $from]
    471 	$w icursor $first
    472     } else {
    473 	set first [WordBack [$w get] $from]
    474 	set last [WordForward [$w get] $to]
    475 	$w icursor $last
    476     }
    477     $w selection range $first $last
    478 }
    479 
    480 ## WordBack, WordForward -- helper routines for WordSelect.
    481 #
    482 proc ttk::entry::WordBack {text index} {
    483     if {[set pos [tcl_wordBreakBefore $text $index]] < 0} { return 0 }
    484     return $pos
    485 }
    486 proc ttk::entry::WordForward {text index} {
    487     if {[set pos [tcl_wordBreakAfter $text $index]] < 0} { return end }
    488     return $pos
    489 }
    490 
    491 ## LineSelect -- Select the entire line.
    492 #
    493 proc ttk::entry::LineSelect {w _ _} {
    494     variable State
    495     $w selection range 0 end
    496     $w icursor end
    497 }
    498 
    499 ### Button 2 binding procedures.
    500 #
    501 
    502 ## ScanMark -- ButtonPress-2 binding.
    503 #	Marks the start of a scan or primary transfer operation.
    504 #
    505 proc ttk::entry::ScanMark {w x} {
    506     variable State
    507     set State(scanX) $x
    508     set State(scanIndex) [$w index @0]
    509     set State(scanMoved) 0
    510 }
    511 
    512 ## ScanDrag -- Button2 motion binding.
    513 #
    514 proc ttk::entry::ScanDrag {w x} {
    515     variable State
    516 
    517     set dx [expr {$State(scanX) - $x}]
    518     if {abs($dx) > $State(deadband)} {
    519 	set State(scanMoved) 1
    520     }
    521     set left [expr {$State(scanIndex) + ($dx*$State(scanNum))/$State(scanDen)}]
    522     $w xview $left
    523 
    524     if {$left != [set newLeft [$w index @0]]} {
    525     	# We've scanned past one end of the entry;
    526 	# reset the mark so that the text will start dragging again
    527 	# as soon as the mouse reverses direction.
    528 	#
    529 	set State(scanX) $x
    530 	set State(scanIndex) $newLeft
    531     }
    532 }
    533 
    534 ## ScanRelease -- Button2 release binding.
    535 #	Do a primary transfer if the mouse has not moved since the button press.
    536 #
    537 proc ttk::entry::ScanRelease {w x} {
    538     variable State
    539     if {!$State(scanMoved)} {
    540 	$w instate {!disabled !readonly} {
    541 	    $w icursor [ClosestGap $w $x]
    542 	    catch {$w insert insert [::tk::GetSelection $w PRIMARY]}
    543 	}
    544     }
    545 }
    546 
    547 ### Insertion and deletion procedures.
    548 #
    549 
    550 ## PendingDelete -- Delete selection prior to insert.
    551 #	If the entry currently has a selection, delete it and
    552 #	set the insert position to where the selection was.
    553 #	Returns: 1 if pending delete occurred, 0 if nothing was selected.
    554 #
    555 proc ttk::entry::PendingDelete {w} {
    556     if {[$w selection present]} {
    557 	$w icursor sel.first
    558 	$w delete sel.first sel.last
    559 	return 1
    560     }
    561     return 0
    562 }
    563 
    564 ## Insert -- Insert text into the entry widget.
    565 #	If a selection is present, the new text replaces it.
    566 #	Otherwise, the new text is inserted at the insert cursor.
    567 #
    568 proc ttk::entry::Insert {w s} {
    569     if {$s eq ""} { return }
    570     PendingDelete $w
    571     $w insert insert $s
    572     See $w insert
    573 }
    574 
    575 ## Backspace -- Backspace over the character just before the insert cursor.
    576 #	If there is a selection, delete that instead.
    577 #	If the new insert position is offscreen to the left,
    578 #	scroll to place the cursor at about the middle of the window.
    579 #
    580 proc ttk::entry::Backspace {w} {
    581     if {[PendingDelete $w]} {
    582     	See $w
    583 	return
    584     }
    585     set x [expr {[$w index insert] - 1}]
    586     if {$x < 0} { return }
    587 
    588     $w delete $x
    589 
    590     if {[$w index @0] >= [$w index insert]} {
    591 	set range [$w xview]
    592 	set left [lindex $range 0]
    593 	set right [lindex $range 1]
    594 	$w xview moveto [expr {$left - ($right - $left)/2.0}]
    595     }
    596 }
    597 
    598 ## Delete -- Delete the character after the insert cursor.
    599 #	If there is a selection, delete that instead.
    600 #
    601 proc ttk::entry::Delete {w} {
    602     if {![PendingDelete $w]} {
    603 	$w delete insert
    604     }
    605 }
    606 
    607 #*EOF*