Merge branch 'master' of http://repo.or.cz/r/msysgit into devel
[msysgit/historical-msysgit.git] / mingw / lib / tk8.4 / text.tcl
blob6b045a5cec1e7f945e95301417466c4a283fddc6
1 # text.tcl --
3 # This file defines the default bindings for Tk text widgets and provides
4 # procedures that help in implementing the bindings.
6 # RCS: @(#) $Id: text.tcl,v 1.24.2.9 2006/09/10 17:07:36 das Exp $
8 # Copyright (c) 1992-1994 The Regents of the University of California.
9 # Copyright (c) 1994-1997 Sun Microsystems, Inc.
10 # Copyright (c) 1998 by Scriptics Corporation.
12 # See the file "license.terms" for information on usage and redistribution
13 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
16 #-------------------------------------------------------------------------
17 # Elements of ::tk::Priv that are used in this file:
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 # char - Character position on the line; kept in order
23 # to allow moving up or down past short lines while
24 # still remembering the desired position.
25 # mouseMoved - Non-zero means the mouse has moved a significant
26 # amount since the button went down (so, for example,
27 # start dragging out a selection).
28 # prevPos - Used when moving up or down lines via the keyboard.
29 # Keeps track of the previous insert position, so
30 # we can distinguish a series of ups and downs, all
31 # in a row, from a new up or down.
32 # selectMode - The style of selection currently underway:
33 # char, word, or line.
34 # x, y - Last known mouse coordinates for scanning
35 # and auto-scanning.
36 #-------------------------------------------------------------------------
38 #-------------------------------------------------------------------------
39 # The code below creates the default class bindings for text widgets.
40 #-------------------------------------------------------------------------
42 # Standard Motif bindings:
44 bind Text <1> {
45 tk::TextButton1 %W %x %y
46 %W tag remove sel 0.0 end
48 bind Text <B1-Motion> {
49 set tk::Priv(x) %x
50 set tk::Priv(y) %y
51 tk::TextSelectTo %W %x %y
53 bind Text <Double-1> {
54 set tk::Priv(selectMode) word
55 tk::TextSelectTo %W %x %y
56 catch {%W mark set insert sel.last}
58 bind Text <Triple-1> {
59 set tk::Priv(selectMode) line
60 tk::TextSelectTo %W %x %y
61 catch {%W mark set insert sel.last}
63 bind Text <Shift-1> {
64 tk::TextResetAnchor %W @%x,%y
65 set tk::Priv(selectMode) char
66 tk::TextSelectTo %W %x %y
68 bind Text <Double-Shift-1> {
69 set tk::Priv(selectMode) word
70 tk::TextSelectTo %W %x %y 1
72 bind Text <Triple-Shift-1> {
73 set tk::Priv(selectMode) line
74 tk::TextSelectTo %W %x %y
76 bind Text <B1-Leave> {
77 set tk::Priv(x) %x
78 set tk::Priv(y) %y
79 tk::TextAutoScan %W
81 bind Text <B1-Enter> {
82 tk::CancelRepeat
84 bind Text <ButtonRelease-1> {
85 tk::CancelRepeat
87 bind Text <Control-1> {
88 %W mark set insert @%x,%y
90 bind Text <Left> {
91 tk::TextSetCursor %W insert-1c
93 bind Text <Right> {
94 tk::TextSetCursor %W insert+1c
96 bind Text <Up> {
97 tk::TextSetCursor %W [tk::TextUpDownLine %W -1]
99 bind Text <Down> {
100 tk::TextSetCursor %W [tk::TextUpDownLine %W 1]
102 bind Text <Shift-Left> {
103 tk::TextKeySelect %W [%W index {insert - 1c}]
105 bind Text <Shift-Right> {
106 tk::TextKeySelect %W [%W index {insert + 1c}]
108 bind Text <Shift-Up> {
109 tk::TextKeySelect %W [tk::TextUpDownLine %W -1]
111 bind Text <Shift-Down> {
112 tk::TextKeySelect %W [tk::TextUpDownLine %W 1]
114 bind Text <Control-Left> {
115 tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord]
117 bind Text <Control-Right> {
118 tk::TextSetCursor %W [tk::TextNextWord %W insert]
120 bind Text <Control-Up> {
121 tk::TextSetCursor %W [tk::TextPrevPara %W insert]
123 bind Text <Control-Down> {
124 tk::TextSetCursor %W [tk::TextNextPara %W insert]
126 bind Text <Shift-Control-Left> {
127 tk::TextKeySelect %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord]
129 bind Text <Shift-Control-Right> {
130 tk::TextKeySelect %W [tk::TextNextWord %W insert]
132 bind Text <Shift-Control-Up> {
133 tk::TextKeySelect %W [tk::TextPrevPara %W insert]
135 bind Text <Shift-Control-Down> {
136 tk::TextKeySelect %W [tk::TextNextPara %W insert]
138 bind Text <Prior> {
139 tk::TextSetCursor %W [tk::TextScrollPages %W -1]
141 bind Text <Shift-Prior> {
142 tk::TextKeySelect %W [tk::TextScrollPages %W -1]
144 bind Text <Next> {
145 tk::TextSetCursor %W [tk::TextScrollPages %W 1]
147 bind Text <Shift-Next> {
148 tk::TextKeySelect %W [tk::TextScrollPages %W 1]
150 bind Text <Control-Prior> {
151 %W xview scroll -1 page
153 bind Text <Control-Next> {
154 %W xview scroll 1 page
157 bind Text <Home> {
158 tk::TextSetCursor %W {insert linestart}
160 bind Text <Shift-Home> {
161 tk::TextKeySelect %W {insert linestart}
163 bind Text <End> {
164 tk::TextSetCursor %W {insert lineend}
166 bind Text <Shift-End> {
167 tk::TextKeySelect %W {insert lineend}
169 bind Text <Control-Home> {
170 tk::TextSetCursor %W 1.0
172 bind Text <Control-Shift-Home> {
173 tk::TextKeySelect %W 1.0
175 bind Text <Control-End> {
176 tk::TextSetCursor %W {end - 1 char}
178 bind Text <Control-Shift-End> {
179 tk::TextKeySelect %W {end - 1 char}
182 bind Text <Tab> {
183 if { [%W cget -state] eq "normal" } {
184 tk::TextInsert %W \t
185 focus %W
186 break
189 bind Text <Shift-Tab> {
190 # Needed only to keep <Tab> binding from triggering; doesn't
191 # have to actually do anything.
192 break
194 bind Text <Control-Tab> {
195 focus [tk_focusNext %W]
197 bind Text <Control-Shift-Tab> {
198 focus [tk_focusPrev %W]
200 bind Text <Control-i> {
201 tk::TextInsert %W \t
203 bind Text <Return> {
204 tk::TextInsert %W \n
205 if {[%W cget -autoseparators]} {%W edit separator}
207 bind Text <Delete> {
208 if {[%W tag nextrange sel 1.0 end] ne ""} {
209 %W delete sel.first sel.last
210 } else {
211 %W delete insert
212 %W see insert
215 bind Text <BackSpace> {
216 if {[%W tag nextrange sel 1.0 end] ne ""} {
217 %W delete sel.first sel.last
218 } elseif {[%W compare insert != 1.0]} {
219 %W delete insert-1c
220 %W see insert
224 bind Text <Control-space> {
225 %W mark set anchor insert
227 bind Text <Select> {
228 %W mark set anchor insert
230 bind Text <Control-Shift-space> {
231 set tk::Priv(selectMode) char
232 tk::TextKeyExtend %W insert
234 bind Text <Shift-Select> {
235 set tk::Priv(selectMode) char
236 tk::TextKeyExtend %W insert
238 bind Text <Control-slash> {
239 %W tag add sel 1.0 end
241 bind Text <Control-backslash> {
242 %W tag remove sel 1.0 end
244 bind Text <<Cut>> {
245 tk_textCut %W
247 bind Text <<Copy>> {
248 tk_textCopy %W
250 bind Text <<Paste>> {
251 tk_textPaste %W
253 bind Text <<Clear>> {
254 catch {%W delete sel.first sel.last}
256 bind Text <<PasteSelection>> {
257 if {$tk_strictMotif || ![info exists tk::Priv(mouseMoved)]
258 || !$tk::Priv(mouseMoved)} {
259 tk::TextPasteSelection %W %x %y
262 bind Text <Insert> {
263 catch {tk::TextInsert %W [::tk::GetSelection %W PRIMARY]}
265 bind Text <KeyPress> {
266 tk::TextInsert %W %A
269 # Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
270 # Otherwise, if a widget binding for one of these is defined, the
271 # <KeyPress> class binding will also fire and insert the character,
272 # which is wrong. Ditto for <Escape>.
274 bind Text <Alt-KeyPress> {# nothing }
275 bind Text <Meta-KeyPress> {# nothing}
276 bind Text <Control-KeyPress> {# nothing}
277 bind Text <Escape> {# nothing}
278 bind Text <KP_Enter> {# nothing}
280 if {[tk windowingsystem] eq "classic" || [tk windowingsystem] eq "aqua"} {
281 bind Text <Command-KeyPress> {# nothing}
284 # Additional emacs-like bindings:
286 bind Text <Control-a> {
287 if {!$tk_strictMotif} {
288 tk::TextSetCursor %W {insert linestart}
291 bind Text <Control-b> {
292 if {!$tk_strictMotif} {
293 tk::TextSetCursor %W insert-1c
296 bind Text <Control-d> {
297 if {!$tk_strictMotif} {
298 %W delete insert
301 bind Text <Control-e> {
302 if {!$tk_strictMotif} {
303 tk::TextSetCursor %W {insert lineend}
306 bind Text <Control-f> {
307 if {!$tk_strictMotif} {
308 tk::TextSetCursor %W insert+1c
311 bind Text <Control-k> {
312 if {!$tk_strictMotif} {
313 if {[%W compare insert == {insert lineend}]} {
314 %W delete insert
315 } else {
316 %W delete insert {insert lineend}
320 bind Text <Control-n> {
321 if {!$tk_strictMotif} {
322 tk::TextSetCursor %W [tk::TextUpDownLine %W 1]
325 bind Text <Control-o> {
326 if {!$tk_strictMotif} {
327 %W insert insert \n
328 %W mark set insert insert-1c
331 bind Text <Control-p> {
332 if {!$tk_strictMotif} {
333 tk::TextSetCursor %W [tk::TextUpDownLine %W -1]
336 bind Text <Control-t> {
337 if {!$tk_strictMotif} {
338 tk::TextTranspose %W
342 bind Text <<Undo>> {
343 catch { %W edit undo }
346 bind Text <<Redo>> {
347 catch { %W edit redo }
350 if {$tcl_platform(platform) ne "windows"} {
351 bind Text <Control-v> {
352 if {!$tk_strictMotif} {
353 tk::TextScrollPages %W 1
358 bind Text <Meta-b> {
359 if {!$tk_strictMotif} {
360 tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord]
363 bind Text <Meta-d> {
364 if {!$tk_strictMotif} {
365 %W delete insert [tk::TextNextWord %W insert]
368 bind Text <Meta-f> {
369 if {!$tk_strictMotif} {
370 tk::TextSetCursor %W [tk::TextNextWord %W insert]
373 bind Text <Meta-less> {
374 if {!$tk_strictMotif} {
375 tk::TextSetCursor %W 1.0
378 bind Text <Meta-greater> {
379 if {!$tk_strictMotif} {
380 tk::TextSetCursor %W end-1c
383 bind Text <Meta-BackSpace> {
384 if {!$tk_strictMotif} {
385 %W delete [tk::TextPrevPos %W insert tcl_startOfPreviousWord] insert
388 bind Text <Meta-Delete> {
389 if {!$tk_strictMotif} {
390 %W delete [tk::TextPrevPos %W insert tcl_startOfPreviousWord] insert
394 # Macintosh only bindings:
396 if {[tk windowingsystem] eq "classic" || [tk windowingsystem] eq "aqua"} {
397 bind Text <FocusIn> {
398 %W configure -selectbackground systemHighlight -selectforeground systemHighlightText
400 bind Text <FocusOut> {
401 %W configure -selectbackground systemHighlightSecondary -selectforeground systemHighlightText
403 bind Text <Option-Left> {
404 tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord]
406 bind Text <Option-Right> {
407 tk::TextSetCursor %W [tk::TextNextWord %W insert]
409 bind Text <Option-Up> {
410 tk::TextSetCursor %W [tk::TextPrevPara %W insert]
412 bind Text <Option-Down> {
413 tk::TextSetCursor %W [tk::TextNextPara %W insert]
415 bind Text <Shift-Option-Left> {
416 tk::TextKeySelect %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord]
418 bind Text <Shift-Option-Right> {
419 tk::TextKeySelect %W [tk::TextNextWord %W insert]
421 bind Text <Shift-Option-Up> {
422 tk::TextKeySelect %W [tk::TextPrevPara %W insert]
424 bind Text <Shift-Option-Down> {
425 tk::TextKeySelect %W [tk::TextNextPara %W insert]
428 # End of Mac only bindings
431 # A few additional bindings of my own.
433 bind Text <Control-h> {
434 if {!$tk_strictMotif} {
435 if {[%W compare insert != 1.0]} {
436 %W delete insert-1c
437 %W see insert
441 bind Text <2> {
442 if {!$tk_strictMotif} {
443 tk::TextScanMark %W %x %y
446 bind Text <B2-Motion> {
447 if {!$tk_strictMotif} {
448 tk::TextScanDrag %W %x %y
451 set ::tk::Priv(prevPos) {}
453 # The MouseWheel will typically only fire on Windows and MacOS X.
454 # However, someone could use the "event generate" command to produce
455 # one on other platforms.
457 if {[tk windowingsystem] eq "classic" || [tk windowingsystem] eq "aqua"} {
458 bind Text <MouseWheel> {
459 %W yview scroll [expr {- (%D)}] units
461 bind Text <Option-MouseWheel> {
462 %W yview scroll [expr {-10 * (%D)}] units
464 bind Text <Shift-MouseWheel> {
465 %W xview scroll [expr {- (%D)}] units
467 bind Text <Shift-Option-MouseWheel> {
468 %W xview scroll [expr {-10 * (%D)}] units
470 } else {
471 bind Text <MouseWheel> {
472 %W yview scroll [expr {- (%D / 120) * 4}] units
476 if {"x11" eq [tk windowingsystem]} {
477 # Support for mousewheels on Linux/Unix commonly comes through mapping
478 # the wheel to the extended buttons. If you have a mousewheel, find
479 # Linux configuration info at:
480 # http://www.inria.fr/koala/colas/mouse-wheel-scroll/
481 bind Text <4> {
482 if {!$tk_strictMotif} {
483 %W yview scroll -5 units
486 bind Text <5> {
487 if {!$tk_strictMotif} {
488 %W yview scroll 5 units
493 # ::tk::TextClosestGap --
494 # Given x and y coordinates, this procedure finds the closest boundary
495 # between characters to the given coordinates and returns the index
496 # of the character just after the boundary.
498 # Arguments:
499 # w - The text window.
500 # x - X-coordinate within the window.
501 # y - Y-coordinate within the window.
503 proc ::tk::TextClosestGap {w x y} {
504 set pos [$w index @$x,$y]
505 set bbox [$w bbox $pos]
506 if {$bbox eq ""} {
507 return $pos
509 if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} {
510 return $pos
512 $w index "$pos + 1 char"
515 # ::tk::TextButton1 --
516 # This procedure is invoked to handle button-1 presses in text
517 # widgets. It moves the insertion cursor, sets the selection anchor,
518 # and claims the input focus.
520 # Arguments:
521 # w - The text window in which the button was pressed.
522 # x - The x-coordinate of the button press.
523 # y - The x-coordinate of the button press.
525 proc ::tk::TextButton1 {w x y} {
526 variable ::tk::Priv
528 set Priv(selectMode) char
529 set Priv(mouseMoved) 0
530 set Priv(pressX) $x
531 $w mark set insert [TextClosestGap $w $x $y]
532 $w mark set anchor insert
533 # Allow focus in any case on Windows, because that will let the
534 # selection be displayed even for state disabled text widgets.
535 if {$::tcl_platform(platform) eq "windows" || [$w cget -state] eq "normal"} {focus $w}
536 if {[$w cget -autoseparators]} {$w edit separator}
539 # ::tk::TextSelectTo --
540 # This procedure is invoked to extend the selection, typically when
541 # dragging it with the mouse. Depending on the selection mode (character,
542 # word, line) it selects in different-sized units. This procedure
543 # ignores mouse motions initially until the mouse has moved from
544 # one character to another or until there have been multiple clicks.
546 # Arguments:
547 # w - The text window in which the button was pressed.
548 # x - Mouse x position.
549 # y - Mouse y position.
551 proc ::tk::TextSelectTo {w x y {extend 0}} {
552 global tcl_platform
553 variable ::tk::Priv
555 set cur [TextClosestGap $w $x $y]
556 if {[catch {$w index anchor}]} {
557 $w mark set anchor $cur
559 set anchor [$w index anchor]
560 if {[$w compare $cur != $anchor] || (abs($Priv(pressX) - $x) >= 3)} {
561 set Priv(mouseMoved) 1
563 switch $Priv(selectMode) {
564 char {
565 if {[$w compare $cur < anchor]} {
566 set first $cur
567 set last anchor
568 } else {
569 set first anchor
570 set last $cur
573 word {
574 if {[$w compare $cur < anchor]} {
575 set first [TextPrevPos $w "$cur + 1c" tcl_wordBreakBefore]
576 if { !$extend } {
577 set last [TextNextPos $w "anchor" tcl_wordBreakAfter]
578 } else {
579 set last anchor
581 } else {
582 set last [TextNextPos $w "$cur - 1c" tcl_wordBreakAfter]
583 if { !$extend } {
584 set first [TextPrevPos $w anchor tcl_wordBreakBefore]
585 } else {
586 set first anchor
590 line {
591 if {[$w compare $cur < anchor]} {
592 set first [$w index "$cur linestart"]
593 set last [$w index "anchor - 1c lineend + 1c"]
594 } else {
595 set first [$w index "anchor linestart"]
596 set last [$w index "$cur lineend + 1c"]
600 if {$Priv(mouseMoved) || $Priv(selectMode) ne "char"} {
601 $w tag remove sel 0.0 end
602 $w mark set insert $cur
603 $w tag add sel $first $last
604 $w tag remove sel $last end
605 update idletasks
609 # ::tk::TextKeyExtend --
610 # This procedure handles extending the selection from the keyboard,
611 # where the point to extend to is really the boundary between two
612 # characters rather than a particular character.
614 # Arguments:
615 # w - The text window.
616 # index - The point to which the selection is to be extended.
618 proc ::tk::TextKeyExtend {w index} {
620 set cur [$w index $index]
621 if {[catch {$w index anchor}]} {
622 $w mark set anchor $cur
624 set anchor [$w index anchor]
625 if {[$w compare $cur < anchor]} {
626 set first $cur
627 set last anchor
628 } else {
629 set first anchor
630 set last $cur
632 $w tag remove sel 0.0 $first
633 $w tag add sel $first $last
634 $w tag remove sel $last end
637 # ::tk::TextPasteSelection --
638 # This procedure sets the insertion cursor to the mouse position,
639 # inserts the selection, and sets the focus to the window.
641 # Arguments:
642 # w - The text window.
643 # x, y - Position of the mouse.
645 proc ::tk::TextPasteSelection {w x y} {
646 $w mark set insert [TextClosestGap $w $x $y]
647 if {![catch {::tk::GetSelection $w PRIMARY} sel]} {
648 set oldSeparator [$w cget -autoseparators]
649 if {$oldSeparator} {
650 $w configure -autoseparators 0
651 $w edit separator
653 $w insert insert $sel
654 if {$oldSeparator} {
655 $w edit separator
656 $w configure -autoseparators 1
659 if {[$w cget -state] eq "normal"} {focus $w}
662 # ::tk::TextAutoScan --
663 # This procedure is invoked when the mouse leaves a text window
664 # with button 1 down. It scrolls the window up, down, left, or right,
665 # depending on where the mouse is (this information was saved in
666 # ::tk::Priv(x) and ::tk::Priv(y)), and reschedules itself as an "after"
667 # command so that the window continues to scroll until the mouse
668 # moves back into the window or the mouse button is released.
670 # Arguments:
671 # w - The text window.
673 proc ::tk::TextAutoScan {w} {
674 variable ::tk::Priv
675 if {![winfo exists $w]} return
676 if {$Priv(y) >= [winfo height $w]} {
677 $w yview scroll 2 units
678 } elseif {$Priv(y) < 0} {
679 $w yview scroll -2 units
680 } elseif {$Priv(x) >= [winfo width $w]} {
681 $w xview scroll 2 units
682 } elseif {$Priv(x) < 0} {
683 $w xview scroll -2 units
684 } else {
685 return
687 TextSelectTo $w $Priv(x) $Priv(y)
688 set Priv(afterId) [after 50 [list tk::TextAutoScan $w]]
691 # ::tk::TextSetCursor
692 # Move the insertion cursor to a given position in a text. Also
693 # clears the selection, if there is one in the text, and makes sure
694 # that the insertion cursor is visible. Also, don't let the insertion
695 # cursor appear on the dummy last line of the text.
697 # Arguments:
698 # w - The text window.
699 # pos - The desired new position for the cursor in the window.
701 proc ::tk::TextSetCursor {w pos} {
703 if {[$w compare $pos == end]} {
704 set pos {end - 1 chars}
706 $w mark set insert $pos
707 $w tag remove sel 1.0 end
708 $w see insert
709 if {[$w cget -autoseparators]} {$w edit separator}
712 # ::tk::TextKeySelect
713 # This procedure is invoked when stroking out selections using the
714 # keyboard. It moves the cursor to a new position, then extends
715 # the selection to that position.
717 # Arguments:
718 # w - The text window.
719 # new - A new position for the insertion cursor (the cursor hasn't
720 # actually been moved to this position yet).
722 proc ::tk::TextKeySelect {w new} {
724 if {[$w tag nextrange sel 1.0 end] eq ""} {
725 if {[$w compare $new < insert]} {
726 $w tag add sel $new insert
727 } else {
728 $w tag add sel insert $new
730 $w mark set anchor insert
731 } else {
732 if {[$w compare $new < anchor]} {
733 set first $new
734 set last anchor
735 } else {
736 set first anchor
737 set last $new
739 $w tag remove sel 1.0 $first
740 $w tag add sel $first $last
741 $w tag remove sel $last end
743 $w mark set insert $new
744 $w see insert
745 update idletasks
748 # ::tk::TextResetAnchor --
749 # Set the selection anchor to whichever end is farthest from the
750 # index argument. One special trick: if the selection has two or
751 # fewer characters, just leave the anchor where it is. In this
752 # case it doesn't matter which point gets chosen for the anchor,
753 # and for the things like Shift-Left and Shift-Right this produces
754 # better behavior when the cursor moves back and forth across the
755 # anchor.
757 # Arguments:
758 # w - The text widget.
759 # index - Position at which mouse button was pressed, which determines
760 # which end of selection should be used as anchor point.
762 proc ::tk::TextResetAnchor {w index} {
764 if {[$w tag ranges sel] eq ""} {
765 # Don't move the anchor if there is no selection now; this makes
766 # the widget behave "correctly" when the user clicks once, then
767 # shift-clicks somewhere -- ie, the area between the two clicks will be
768 # selected. [Bug: 5929].
769 return
771 set a [$w index $index]
772 set b [$w index sel.first]
773 set c [$w index sel.last]
774 if {[$w compare $a < $b]} {
775 $w mark set anchor sel.last
776 return
778 if {[$w compare $a > $c]} {
779 $w mark set anchor sel.first
780 return
782 scan $a "%d.%d" lineA chA
783 scan $b "%d.%d" lineB chB
784 scan $c "%d.%d" lineC chC
785 if {$lineB < $lineC+2} {
786 set total [string length [$w get $b $c]]
787 if {$total <= 2} {
788 return
790 if {[string length [$w get $b $a]] < ($total/2)} {
791 $w mark set anchor sel.last
792 } else {
793 $w mark set anchor sel.first
795 return
797 if {($lineA-$lineB) < ($lineC-$lineA)} {
798 $w mark set anchor sel.last
799 } else {
800 $w mark set anchor sel.first
804 # ::tk::TextInsert --
805 # Insert a string into a text at the point of the insertion cursor.
806 # If there is a selection in the text, and it covers the point of the
807 # insertion cursor, then delete the selection before inserting.
809 # Arguments:
810 # w - The text window in which to insert the string
811 # s - The string to insert (usually just a single character)
813 proc ::tk::TextInsert {w s} {
814 if {$s eq "" || [$w cget -state] eq "disabled"} {
815 return
817 set compound 0
818 catch {
819 if {[$w compare sel.first <= insert] \
820 && [$w compare sel.last >= insert]} {
821 set oldSeparator [$w cget -autoseparators]
822 if { $oldSeparator } {
823 $w configure -autoseparators 0
824 $w edit separator
825 set compound 1
827 $w delete sel.first sel.last
830 $w insert insert $s
831 $w see insert
832 if { $compound && $oldSeparator } {
833 $w edit separator
834 $w configure -autoseparators 1
838 # ::tk::TextUpDownLine --
839 # Returns the index of the character one line above or below the
840 # insertion cursor. There are two tricky things here. First,
841 # we want to maintain the original column across repeated operations,
842 # even though some lines that will get passed through don't have
843 # enough characters to cover the original column. Second, don't
844 # try to scroll past the beginning or end of the text.
846 # Arguments:
847 # w - The text window in which the cursor is to move.
848 # n - The number of lines to move: -1 for up one line,
849 # +1 for down one line.
851 proc ::tk::TextUpDownLine {w n} {
852 variable ::tk::Priv
854 set i [$w index insert]
855 scan $i "%d.%d" line char
856 if {$Priv(prevPos) ne $i} {
857 set Priv(char) $char
859 set new [$w index [expr {$line + $n}].$Priv(char)]
860 if {[$w compare $new == end] || [$w compare $new == "insert linestart"]} {
861 set new $i
863 set Priv(prevPos) $new
864 return $new
867 # ::tk::TextPrevPara --
868 # Returns the index of the beginning of the paragraph just before a given
869 # position in the text (the beginning of a paragraph is the first non-blank
870 # character after a blank line).
872 # Arguments:
873 # w - The text window in which the cursor is to move.
874 # pos - Position at which to start search.
876 proc ::tk::TextPrevPara {w pos} {
877 set pos [$w index "$pos linestart"]
878 while {1} {
879 if {([$w get "$pos - 1 line"] eq "\n" \
880 && [$w get $pos] ne "\n") || $pos eq "1.0"} {
881 if {[regexp -indices {^[ ]+(.)} [$w get $pos "$pos lineend"] \
882 dummy index]} {
883 set pos [$w index "$pos + [lindex $index 0] chars"]
885 if {[$w compare $pos != insert] || [lindex [split $pos .] 0] == 1} {
886 return $pos
889 set pos [$w index "$pos - 1 line"]
893 # ::tk::TextNextPara --
894 # Returns the index of the beginning of the paragraph just after a given
895 # position in the text (the beginning of a paragraph is the first non-blank
896 # character after a blank line).
898 # Arguments:
899 # w - The text window in which the cursor is to move.
900 # start - Position at which to start search.
902 proc ::tk::TextNextPara {w start} {
903 set pos [$w index "$start linestart + 1 line"]
904 while {[$w get $pos] ne "\n"} {
905 if {[$w compare $pos == end]} {
906 return [$w index "end - 1c"]
908 set pos [$w index "$pos + 1 line"]
910 while {[$w get $pos] eq "\n"} {
911 set pos [$w index "$pos + 1 line"]
912 if {[$w compare $pos == end]} {
913 return [$w index "end - 1c"]
916 if {[regexp -indices {^[ ]+(.)} [$w get $pos "$pos lineend"] \
917 dummy index]} {
918 return [$w index "$pos + [lindex $index 0] chars"]
920 return $pos
923 # ::tk::TextScrollPages --
924 # This is a utility procedure used in bindings for moving up and down
925 # pages and possibly extending the selection along the way. It scrolls
926 # the view in the widget by the number of pages, and it returns the
927 # index of the character that is at the same position in the new view
928 # as the insertion cursor used to be in the old view.
930 # Arguments:
931 # w - The text window in which the cursor is to move.
932 # count - Number of pages forward to scroll; may be negative
933 # to scroll backwards.
935 proc ::tk::TextScrollPages {w count} {
936 set bbox [$w bbox insert]
937 $w yview scroll $count pages
938 if {$bbox eq ""} {
939 return [$w index @[expr {[winfo height $w]/2}],0]
941 return [$w index @[lindex $bbox 0],[lindex $bbox 1]]
944 # ::tk::TextTranspose --
945 # This procedure implements the "transpose" function for text widgets.
946 # It tranposes the characters on either side of the insertion cursor,
947 # unless the cursor is at the end of the line. In this case it
948 # transposes the two characters to the left of the cursor. In either
949 # case, the cursor ends up to the right of the transposed characters.
951 # Arguments:
952 # w - Text window in which to transpose.
954 proc ::tk::TextTranspose w {
955 set pos insert
956 if {[$w compare $pos != "$pos lineend"]} {
957 set pos [$w index "$pos + 1 char"]
959 set new [$w get "$pos - 1 char"][$w get "$pos - 2 char"]
960 if {[$w compare "$pos - 1 char" == 1.0]} {
961 return
963 # ensure this is seen as an atomic op to undo
964 set autosep [$w cget -autoseparators]
965 if {$autosep} {
966 $w configure -autoseparators 0
967 $w edit separator
969 $w delete "$pos - 2 char" $pos
970 $w insert insert $new
971 $w see insert
972 if {$autosep} {
973 $w edit separator
974 $w configure -autoseparators $autosep
978 # ::tk_textCopy --
979 # This procedure copies the selection from a text widget into the
980 # clipboard.
982 # Arguments:
983 # w - Name of a text widget.
985 proc ::tk_textCopy w {
986 if {![catch {set data [$w get sel.first sel.last]}]} {
987 clipboard clear -displayof $w
988 clipboard append -displayof $w $data
992 # ::tk_textCut --
993 # This procedure copies the selection from a text widget into the
994 # clipboard, then deletes the selection (if it exists in the given
995 # widget).
997 # Arguments:
998 # w - Name of a text widget.
1000 proc ::tk_textCut w {
1001 if {![catch {set data [$w get sel.first sel.last]}]} {
1002 clipboard clear -displayof $w
1003 clipboard append -displayof $w $data
1004 $w delete sel.first sel.last
1008 # ::tk_textPaste --
1009 # This procedure pastes the contents of the clipboard to the insertion
1010 # point in a text widget.
1012 # Arguments:
1013 # w - Name of a text widget.
1015 proc ::tk_textPaste w {
1016 global tcl_platform
1017 if {![catch {::tk::GetSelection $w CLIPBOARD} sel]} {
1018 # ensure this is seen as an atomic op to undo
1019 set oldSeparator [$w cget -autoseparators]
1020 if { $oldSeparator } {
1021 $w configure -autoseparators 0
1022 $w edit separator
1024 if {[tk windowingsystem] ne "x11"} {
1025 catch { $w delete sel.first sel.last }
1027 $w insert insert $sel
1028 if { $oldSeparator } {
1029 $w edit separator
1030 $w configure -autoseparators 1
1035 # ::tk::TextNextWord --
1036 # Returns the index of the next word position after a given position in the
1037 # text. The next word is platform dependent and may be either the next
1038 # end-of-word position or the next start-of-word position after the next
1039 # end-of-word position.
1041 # Arguments:
1042 # w - The text window in which the cursor is to move.
1043 # start - Position at which to start search.
1045 if {$tcl_platform(platform) eq "windows"} {
1046 proc ::tk::TextNextWord {w start} {
1047 TextNextPos $w [TextNextPos $w $start tcl_endOfWord] \
1048 tcl_startOfNextWord
1050 } else {
1051 proc ::tk::TextNextWord {w start} {
1052 TextNextPos $w $start tcl_endOfWord
1056 # ::tk::TextNextPos --
1057 # Returns the index of the next position after the given starting
1058 # position in the text as computed by a specified function.
1060 # Arguments:
1061 # w - The text window in which the cursor is to move.
1062 # start - Position at which to start search.
1063 # op - Function to use to find next position.
1065 proc ::tk::TextNextPos {w start op} {
1066 set text ""
1067 set cur $start
1068 while {[$w compare $cur < end]} {
1069 set text $text[$w get $cur "$cur lineend + 1c"]
1070 set pos [$op $text 0]
1071 if {$pos >= 0} {
1072 ## Adjust for embedded windows and images
1073 ## dump gives us 3 items per window/image
1074 set dump [$w dump -image -window $start "$start + $pos c"]
1075 if {[llength $dump]} {
1076 set pos [expr {$pos + ([llength $dump]/3)}]
1078 return [$w index "$start + $pos c"]
1080 set cur [$w index "$cur lineend +1c"]
1082 return end
1085 # ::tk::TextPrevPos --
1086 # Returns the index of the previous position before the given starting
1087 # position in the text as computed by a specified function.
1089 # Arguments:
1090 # w - The text window in which the cursor is to move.
1091 # start - Position at which to start search.
1092 # op - Function to use to find next position.
1094 proc ::tk::TextPrevPos {w start op} {
1095 set text ""
1096 set cur $start
1097 while {[$w compare $cur > 0.0]} {
1098 set text [$w get "$cur linestart - 1c" $cur]$text
1099 set pos [$op $text end]
1100 if {$pos >= 0} {
1101 ## Adjust for embedded windows and images
1102 ## dump gives us 3 items per window/image
1103 set dump [$w dump -image -window "$cur linestart" "$start - 1c"]
1104 if {[llength $dump]} {
1105 ## This is a hokey extra hack for control-arrow movement
1106 ## that should be in a while loop to be correct (hobbs)
1107 if {[$w compare [lindex $dump 2] > \
1108 "$cur linestart - 1c + $pos c"]} {
1109 incr pos -1
1111 set pos [expr {$pos + ([llength $dump]/3)}]
1113 return [$w index "$cur linestart - 1c + $pos c"]
1115 set cur [$w index "$cur linestart - 1c"]
1117 return 0.0
1120 # ::tk::TextScanMark --
1122 # Marks the start of a possible scan drag operation
1124 # Arguments:
1125 # w - The text window from which the text to get
1126 # x - x location on screen
1127 # y - y location on screen
1129 proc ::tk::TextScanMark {w x y} {
1130 $w scan mark $x $y
1131 set ::tk::Priv(x) $x
1132 set ::tk::Priv(y) $y
1133 set ::tk::Priv(mouseMoved) 0
1136 # ::tk::TextScanDrag --
1138 # Marks the start of a possible scan drag operation
1140 # Arguments:
1141 # w - The text window from which the text to get
1142 # x - x location on screen
1143 # y - y location on screen
1145 proc ::tk::TextScanDrag {w x y} {
1146 # Make sure these exist, as some weird situations can trigger the
1147 # motion binding without the initial press. [Bug #220269]
1148 if {![info exists ::tk::Priv(x)]} { set ::tk::Priv(x) $x }
1149 if {![info exists ::tk::Priv(y)]} { set ::tk::Priv(y) $y }
1150 if {($x != $::tk::Priv(x)) || ($y != $::tk::Priv(y))} {
1151 set ::tk::Priv(mouseMoved) 1
1153 if {[info exists ::tk::Priv(mouseMoved)] && $::tk::Priv(mouseMoved)} {
1154 $w scan dragto $x $y