Update tk to version 8.5.11
[msysgit.git] / mingw / lib / tk8.5 / ttk / entry.tcl
blobe60df90d76a72c92026d901caee2412cf43edf5e
2 # DERIVED FROM: tk/library/entry.tcl r1.22
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
8 # See the file "license.terms" for information on usage and redistribution
9 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
12 namespace eval ttk {
13 namespace eval entry {
14 variable State
16 set State(x) 0
17 set State(selectMode) char
18 set State(anchor) 0
19 set State(scanX) 0
20 set State(scanIndex) 0
21 set State(scanMoved) 0
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.
29 set State(scanNum) 1
30 set State(scanDen) 1
31 set State(deadband) 3 ;# #pixels for mouse-moved deadband.
35 ### Option database settings.
37 option add *TEntry.cursor [ttk::cursor text]
39 ### Bindings.
41 # Removed the following standard Tk bindings:
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.
61 ## Clipboard events:
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 }
68 ## Button1 bindings:
69 # Used for selection and navigation.
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 }
77 bind TEntry <B1-Leave> { ttk::Repeatedly ttk::entry::AutoScroll %W }
78 bind TEntry <B1-Enter> { ttk::CancelRepeat }
79 bind TEntry <ButtonRelease-1> { ttk::CancelRepeat }
81 bind TEntry <Control-ButtonPress-1> {
82 %W instate {!readonly !disabled} { %W icursor @%x ; focus %W }
85 ## Button2 bindings:
86 # Used for scanning and primary transfer.
87 # Note: ButtonRelease-2 is mapped to <<PasteSelection>> in tk.tcl.
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 }
94 ## Keyboard navigation bindings:
96 bind TEntry <Key-Left> { ttk::entry::Move %W prevchar }
97 bind TEntry <Key-Right> { ttk::entry::Move %W nextchar }
98 bind TEntry <Control-Key-Left> { ttk::entry::Move %W prevword }
99 bind TEntry <Control-Key-Right> { ttk::entry::Move %W nextword }
100 bind TEntry <Key-Home> { ttk::entry::Move %W home }
101 bind TEntry <Key-End> { ttk::entry::Move %W end }
103 bind TEntry <Shift-Key-Left> { ttk::entry::Extend %W prevchar }
104 bind TEntry <Shift-Key-Right> { ttk::entry::Extend %W nextchar }
105 bind TEntry <Shift-Control-Key-Left> { ttk::entry::Extend %W prevword }
106 bind TEntry <Shift-Control-Key-Right> { ttk::entry::Extend %W nextword }
107 bind TEntry <Shift-Key-Home> { ttk::entry::Extend %W home }
108 bind TEntry <Shift-Key-End> { ttk::entry::Extend %W end }
110 bind TEntry <Control-Key-slash> { %W selection range 0 end }
111 bind TEntry <Control-Key-backslash> { %W selection clear }
113 bind TEntry <<TraverseIn>> { %W selection range 0 end; %W icursor end }
115 ## Edit bindings:
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 }
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.
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}
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}
138 # Tk-on-Cocoa generates characters for these two keys. [Bug 2971663]
139 bind TEntry <Down> {# nothing}
140 bind TEntry <Up> {# nothing}
142 ## Additional emacs-like bindings:
144 bind TEntry <Control-Key-a> { ttk::entry::Move %W home }
145 bind TEntry <Control-Key-b> { ttk::entry::Move %W prevchar }
146 bind TEntry <Control-Key-d> { ttk::entry::Delete %W }
147 bind TEntry <Control-Key-e> { ttk::entry::Move %W end }
148 bind TEntry <Control-Key-f> { ttk::entry::Move %W nextchar }
149 bind TEntry <Control-Key-h> { ttk::entry::Backspace %W }
150 bind TEntry <Control-Key-k> { %W delete insert end }
152 ### Clipboard procedures.
155 ## EntrySelection -- Return the selected text of the entry.
156 # Raises an error if there is no selection.
158 proc ttk::entry::EntrySelection {w} {
159 set entryString [string range [$w get] [$w index sel.first] \
160 [expr {[$w index sel.last] - 1}]]
161 if {[$w cget -show] ne ""} {
162 return [string repeat [string index [$w cget -show] 0] \
163 [string length $entryString]]
165 return $entryString
168 ## Paste -- Insert clipboard contents at current insert point.
170 proc ttk::entry::Paste {w} {
171 catch {
172 set clipboard [::tk::GetSelection $w CLIPBOARD]
173 PendingDelete $w
174 $w insert insert $clipboard
175 See $w insert
179 ## Copy -- Copy selection to clipboard.
181 proc ttk::entry::Copy {w} {
182 if {![catch {EntrySelection $w} selection]} {
183 clipboard clear -displayof $w
184 clipboard append -displayof $w $selection
188 ## Clear -- Delete the selection.
190 proc ttk::entry::Clear {w} {
191 catch { $w delete sel.first sel.last }
194 ## Cut -- Copy selection to clipboard then delete it.
196 proc ttk::entry::Cut {w} {
197 Copy $w; Clear $w
200 ### Navigation procedures.
203 ## ClosestGap -- Find closest boundary between characters.
204 # Returns the index of the character just after the boundary.
206 proc ttk::entry::ClosestGap {w x} {
207 set pos [$w index @$x]
208 set bbox [$w bbox $pos]
209 if {$x - [lindex $bbox 0] > [lindex $bbox 2]/2} {
210 incr pos
212 return $pos
215 ## See $index -- Make sure that the character at $index is visible.
217 proc ttk::entry::See {w {index insert}} {
218 update idletasks ;# ensure scroll data up-to-date
219 set c [$w index $index]
220 # @@@ OR: check [$w index left] / [$w index right]
221 if {$c < [$w index @0] || $c >= [$w index @[winfo width $w]]} {
222 $w xview $c
226 ## NextWord -- Find the next word position.
227 # Note: The "next word position" follows platform conventions:
228 # either the next end-of-word position, or the start-of-word
229 # position following the next end-of-word position.
231 set ::ttk::entry::State(startNext) \
232 [string equal $::tcl_platform(platform) "windows"]
234 proc ttk::entry::NextWord {w start} {
235 variable State
236 set pos [tcl_endOfWord [$w get] [$w index $start]]
237 if {$pos >= 0 && $State(startNext)} {
238 set pos [tcl_startOfNextWord [$w get] $pos]
240 if {$pos < 0} {
241 return end
243 return $pos
246 ## PrevWord -- Find the previous word position.
248 proc ttk::entry::PrevWord {w start} {
249 set pos [tcl_startOfPreviousWord [$w get] [$w index $start]]
250 if {$pos < 0} {
251 return 0
253 return $pos
256 ## RelIndex -- Compute character/word/line-relative index.
258 proc ttk::entry::RelIndex {w where {index insert}} {
259 switch -- $where {
260 prevchar { expr {[$w index $index] - 1} }
261 nextchar { expr {[$w index $index] + 1} }
262 prevword { PrevWord $w $index }
263 nextword { NextWord $w $index }
264 home { return 0 }
265 end { $w index end }
266 default { error "Bad relative index $index" }
270 ## Move -- Move insert cursor to relative location.
271 # Also clears the selection, if any, and makes sure
272 # that the insert cursor is visible.
274 proc ttk::entry::Move {w where} {
275 $w icursor [RelIndex $w $where]
276 $w selection clear
277 See $w insert
280 ### Selection procedures.
283 ## ExtendTo -- Extend the selection to the specified index.
285 # The other end of the selection (the anchor) is determined as follows:
287 # (1) if there is no selection, the anchor is the insert cursor;
288 # (2) if the index is outside the selection, grow the selection;
289 # (3) if the insert cursor is at one end of the selection, anchor the other end
290 # (4) otherwise anchor the start of the selection
292 # The insert cursor is placed at the new end of the selection.
294 # Returns: selection anchor.
296 proc ttk::entry::ExtendTo {w index} {
297 set index [$w index $index]
298 set insert [$w index insert]
300 # Figure out selection anchor:
301 if {![$w selection present]} {
302 set anchor $insert
303 } else {
304 set selfirst [$w index sel.first]
305 set sellast [$w index sel.last]
307 if { ($index < $selfirst)
308 || ($insert == $selfirst && $index <= $sellast)
310 set anchor $sellast
311 } else {
312 set anchor $selfirst
316 # Extend selection:
317 if {$anchor < $index} {
318 $w selection range $anchor $index
319 } else {
320 $w selection range $index $anchor
323 $w icursor $index
324 return $anchor
327 ## Extend -- Extend the selection to a relative position, show insert cursor
329 proc ttk::entry::Extend {w where} {
330 ExtendTo $w [RelIndex $w $where]
331 See $w
334 ### Button 1 binding procedures.
336 # Double-clicking followed by a drag enters "word-select" mode.
337 # Triple-clicking enters "line-select" mode.
340 ## Press -- ButtonPress-1 binding.
341 # Set the insertion cursor, claim the input focus, set up for
342 # future drag operations.
344 proc ttk::entry::Press {w x} {
345 variable State
347 $w icursor [ClosestGap $w $x]
348 $w selection clear
349 $w instate !disabled { focus $w }
351 # Set up for future drag, double-click, or triple-click.
352 set State(x) $x
353 set State(selectMode) char
354 set State(anchor) [$w index insert]
357 ## Shift-Press -- Shift-ButtonPress-1 binding.
358 # Extends the selection, sets anchor for future drag operations.
360 proc ttk::entry::Shift-Press {w x} {
361 variable State
363 focus $w
364 set anchor [ExtendTo $w @$x]
366 set State(x) $x
367 set State(selectMode) char
368 set State(anchor) $anchor
371 ## Select $w $x $mode -- Binding for double- and triple- clicks.
372 # Selects a word or line (according to mode),
373 # and sets the selection mode for subsequent drag operations.
375 proc ttk::entry::Select {w x mode} {
376 variable State
377 set cur [ClosestGap $w $x]
379 switch -- $mode {
380 word { WordSelect $w $cur $cur }
381 line { LineSelect $w $cur $cur }
382 char { # no-op }
385 set State(anchor) $cur
386 set State(selectMode) $mode
389 ## Drag -- Button1 motion binding.
391 proc ttk::entry::Drag {w x} {
392 variable State
393 set State(x) $x
394 DragTo $w $x
397 ## DragTo $w $x -- Extend selection to $x based on current selection mode.
399 proc ttk::entry::DragTo {w x} {
400 variable State
402 set cur [ClosestGap $w $x]
403 switch $State(selectMode) {
404 char { CharSelect $w $State(anchor) $cur }
405 word { WordSelect $w $State(anchor) $cur }
406 line { LineSelect $w $State(anchor) $cur }
410 ## AutoScroll
411 # Called repeatedly when the mouse is outside an entry window
412 # with Button 1 down. Scroll the window left or right,
413 # depending on where the mouse is, and extend the selection
414 # according to the current selection mode.
416 # TODO: AutoScroll should repeat faster (50ms) than normal autorepeat.
417 # TODO: Need a way for Repeat scripts to cancel themselves.
419 proc ttk::entry::AutoScroll {w} {
420 variable State
421 if {![winfo exists $w]} return
422 set x $State(x)
423 if {$x > [winfo width $w]} {
424 $w xview scroll 2 units
425 DragTo $w $x
426 } elseif {$x < 0} {
427 $w xview scroll -2 units
428 DragTo $w $x
432 ## CharSelect -- select characters between index $from and $to
434 proc ttk::entry::CharSelect {w from to} {
435 if {$to <= $from} {
436 $w selection range $to $from
437 } else {
438 $w selection range $from $to
440 $w icursor $to
443 ## WordSelect -- Select whole words between index $from and $to
445 proc ttk::entry::WordSelect {w from to} {
446 if {$to < $from} {
447 set first [WordBack [$w get] $to]
448 set last [WordForward [$w get] $from]
449 $w icursor $first
450 } else {
451 set first [WordBack [$w get] $from]
452 set last [WordForward [$w get] $to]
453 $w icursor $last
455 $w selection range $first $last
458 ## WordBack, WordForward -- helper routines for WordSelect.
460 proc ttk::entry::WordBack {text index} {
461 if {[set pos [tcl_wordBreakBefore $text $index]] < 0} { return 0 }
462 return $pos
464 proc ttk::entry::WordForward {text index} {
465 if {[set pos [tcl_wordBreakAfter $text $index]] < 0} { return end }
466 return $pos
469 ## LineSelect -- Select the entire line.
471 proc ttk::entry::LineSelect {w _ _} {
472 variable State
473 $w selection range 0 end
474 $w icursor end
477 ### Button 2 binding procedures.
480 ## ScanMark -- ButtonPress-2 binding.
481 # Marks the start of a scan or primary transfer operation.
483 proc ttk::entry::ScanMark {w x} {
484 variable State
485 set State(scanX) $x
486 set State(scanIndex) [$w index @0]
487 set State(scanMoved) 0
490 ## ScanDrag -- Button2 motion binding.
492 proc ttk::entry::ScanDrag {w x} {
493 variable State
495 set dx [expr {$State(scanX) - $x}]
496 if {abs($dx) > $State(deadband)} {
497 set State(scanMoved) 1
499 set left [expr {$State(scanIndex) + ($dx*$State(scanNum))/$State(scanDen)}]
500 $w xview $left
502 if {$left != [set newLeft [$w index @0]]} {
503 # We've scanned past one end of the entry;
504 # reset the mark so that the text will start dragging again
505 # as soon as the mouse reverses direction.
507 set State(scanX) $x
508 set State(scanIndex) $newLeft
512 ## ScanRelease -- Button2 release binding.
513 # Do a primary transfer if the mouse has not moved since the button press.
515 proc ttk::entry::ScanRelease {w x} {
516 variable State
517 if {!$State(scanMoved)} {
518 $w instate {!disabled !readonly} {
519 $w icursor [ClosestGap $w $x]
520 catch {$w insert insert [::tk::GetSelection $w PRIMARY]}
525 ### Insertion and deletion procedures.
528 ## PendingDelete -- Delete selection prior to insert.
529 # If the entry currently has a selection, delete it and
530 # set the insert position to where the selection was.
531 # Returns: 1 if pending delete occurred, 0 if nothing was selected.
533 proc ttk::entry::PendingDelete {w} {
534 if {[$w selection present]} {
535 $w icursor sel.first
536 $w delete sel.first sel.last
537 return 1
539 return 0
542 ## Insert -- Insert text into the entry widget.
543 # If a selection is present, the new text replaces it.
544 # Otherwise, the new text is inserted at the insert cursor.
546 proc ttk::entry::Insert {w s} {
547 if {$s eq ""} { return }
548 PendingDelete $w
549 $w insert insert $s
550 See $w insert
553 ## Backspace -- Backspace over the character just before the insert cursor.
554 # If there is a selection, delete that instead.
555 # If the new insert position is offscreen to the left,
556 # scroll to place the cursor at about the middle of the window.
558 proc ttk::entry::Backspace {w} {
559 if {[PendingDelete $w]} {
560 See $w
561 return
563 set x [expr {[$w index insert] - 1}]
564 if {$x < 0} { return }
566 $w delete $x
568 if {[$w index @0] >= [$w index insert]} {
569 set range [$w xview]
570 set left [lindex $range 0]
571 set right [lindex $range 1]
572 $w xview moveto [expr {$left - ($right - $left)/2.0}]
576 ## Delete -- Delete the character after the insert cursor.
577 # If there is a selection, delete that instead.
579 proc ttk::entry::Delete {w} {
580 if {![PendingDelete $w]} {
581 $w delete insert
585 #*EOF*