Initial commit of OpenSPARC T2 design and verification files.
[OpenSPARC-T2-DV] / tools / src / nas,5.n2.os.2 / lib / python / lib / tk8.4 / text.tcl
CommitLineData
86530b38
AT
1# text.tcl --
2#
3# This file defines the default bindings for Tk text widgets and provides
4# procedures that help in implementing the bindings.
5#
6# RCS: @(#) $Id: text.tcl,v 1.24.2.6 2005/05/13 13:48:21 vincentdarley Exp $
7#
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.
11#
12# See the file "license.terms" for information on usage and redistribution
13# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
14#
15
16#-------------------------------------------------------------------------
17# Elements of ::tk::Priv that are used in this file:
18#
19# afterId - If non-null, it means that auto-scanning is underway
20# and it gives the "after" id for the next auto-scan
21# command to be executed.
22# 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#-------------------------------------------------------------------------
37
38#-------------------------------------------------------------------------
39# The code below creates the default class bindings for text widgets.
40#-------------------------------------------------------------------------
41
42# Standard Motif bindings:
43
44bind Text <1> {
45 tk::TextButton1 %W %x %y
46 %W tag remove sel 0.0 end
47}
48bind Text <B1-Motion> {
49 set tk::Priv(x) %x
50 set tk::Priv(y) %y
51 tk::TextSelectTo %W %x %y
52}
53bind Text <Double-1> {
54 set tk::Priv(selectMode) word
55 tk::TextSelectTo %W %x %y
56 catch {%W mark set insert sel.last}
57}
58bind Text <Triple-1> {
59 set tk::Priv(selectMode) line
60 tk::TextSelectTo %W %x %y
61 catch {%W mark set insert sel.last}
62}
63bind Text <Shift-1> {
64 tk::TextResetAnchor %W @%x,%y
65 set tk::Priv(selectMode) char
66 tk::TextSelectTo %W %x %y
67}
68bind Text <Double-Shift-1> {
69 set tk::Priv(selectMode) word
70 tk::TextSelectTo %W %x %y 1
71}
72bind Text <Triple-Shift-1> {
73 set tk::Priv(selectMode) line
74 tk::TextSelectTo %W %x %y
75}
76bind Text <B1-Leave> {
77 set tk::Priv(x) %x
78 set tk::Priv(y) %y
79 tk::TextAutoScan %W
80}
81bind Text <B1-Enter> {
82 tk::CancelRepeat
83}
84bind Text <ButtonRelease-1> {
85 tk::CancelRepeat
86}
87bind Text <Control-1> {
88 %W mark set insert @%x,%y
89}
90bind Text <Left> {
91 tk::TextSetCursor %W insert-1c
92}
93bind Text <Right> {
94 tk::TextSetCursor %W insert+1c
95}
96bind Text <Up> {
97 tk::TextSetCursor %W [tk::TextUpDownLine %W -1]
98}
99bind Text <Down> {
100 tk::TextSetCursor %W [tk::TextUpDownLine %W 1]
101}
102bind Text <Shift-Left> {
103 tk::TextKeySelect %W [%W index {insert - 1c}]
104}
105bind Text <Shift-Right> {
106 tk::TextKeySelect %W [%W index {insert + 1c}]
107}
108bind Text <Shift-Up> {
109 tk::TextKeySelect %W [tk::TextUpDownLine %W -1]
110}
111bind Text <Shift-Down> {
112 tk::TextKeySelect %W [tk::TextUpDownLine %W 1]
113}
114bind Text <Control-Left> {
115 tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord]
116}
117bind Text <Control-Right> {
118 tk::TextSetCursor %W [tk::TextNextWord %W insert]
119}
120bind Text <Control-Up> {
121 tk::TextSetCursor %W [tk::TextPrevPara %W insert]
122}
123bind Text <Control-Down> {
124 tk::TextSetCursor %W [tk::TextNextPara %W insert]
125}
126bind Text <Shift-Control-Left> {
127 tk::TextKeySelect %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord]
128}
129bind Text <Shift-Control-Right> {
130 tk::TextKeySelect %W [tk::TextNextWord %W insert]
131}
132bind Text <Shift-Control-Up> {
133 tk::TextKeySelect %W [tk::TextPrevPara %W insert]
134}
135bind Text <Shift-Control-Down> {
136 tk::TextKeySelect %W [tk::TextNextPara %W insert]
137}
138bind Text <Prior> {
139 tk::TextSetCursor %W [tk::TextScrollPages %W -1]
140}
141bind Text <Shift-Prior> {
142 tk::TextKeySelect %W [tk::TextScrollPages %W -1]
143}
144bind Text <Next> {
145 tk::TextSetCursor %W [tk::TextScrollPages %W 1]
146}
147bind Text <Shift-Next> {
148 tk::TextKeySelect %W [tk::TextScrollPages %W 1]
149}
150bind Text <Control-Prior> {
151 %W xview scroll -1 page
152}
153bind Text <Control-Next> {
154 %W xview scroll 1 page
155}
156
157bind Text <Home> {
158 tk::TextSetCursor %W {insert linestart}
159}
160bind Text <Shift-Home> {
161 tk::TextKeySelect %W {insert linestart}
162}
163bind Text <End> {
164 tk::TextSetCursor %W {insert lineend}
165}
166bind Text <Shift-End> {
167 tk::TextKeySelect %W {insert lineend}
168}
169bind Text <Control-Home> {
170 tk::TextSetCursor %W 1.0
171}
172bind Text <Control-Shift-Home> {
173 tk::TextKeySelect %W 1.0
174}
175bind Text <Control-End> {
176 tk::TextSetCursor %W {end - 1 char}
177}
178bind Text <Control-Shift-End> {
179 tk::TextKeySelect %W {end - 1 char}
180}
181
182bind Text <Tab> {
183 if { [string equal [%W cget -state] "normal"] } {
184 tk::TextInsert %W \t
185 focus %W
186 break
187 }
188}
189bind Text <Shift-Tab> {
190 # Needed only to keep <Tab> binding from triggering; doesn't
191 # have to actually do anything.
192 break
193}
194bind Text <Control-Tab> {
195 focus [tk_focusNext %W]
196}
197bind Text <Control-Shift-Tab> {
198 focus [tk_focusPrev %W]
199}
200bind Text <Control-i> {
201 tk::TextInsert %W \t
202}
203bind Text <Return> {
204 tk::TextInsert %W \n
205 if {[%W cget -autoseparators]} {%W edit separator}
206}
207bind 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
213 }
214}
215bind 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
221 }
222}
223
224bind Text <Control-space> {
225 %W mark set anchor insert
226}
227bind Text <Select> {
228 %W mark set anchor insert
229}
230bind Text <Control-Shift-space> {
231 set tk::Priv(selectMode) char
232 tk::TextKeyExtend %W insert
233}
234bind Text <Shift-Select> {
235 set tk::Priv(selectMode) char
236 tk::TextKeyExtend %W insert
237}
238bind Text <Control-slash> {
239 %W tag add sel 1.0 end
240}
241bind Text <Control-backslash> {
242 %W tag remove sel 1.0 end
243}
244bind Text <<Cut>> {
245 tk_textCut %W
246}
247bind Text <<Copy>> {
248 tk_textCopy %W
249}
250bind Text <<Paste>> {
251 tk_textPaste %W
252}
253bind Text <<Clear>> {
254 catch {%W delete sel.first sel.last}
255}
256bind Text <<PasteSelection>> {
257 if {$tk_strictMotif || ![info exists tk::Priv(mouseMoved)]
258 || !$tk::Priv(mouseMoved)} {
259 tk::TextPasteSelection %W %x %y
260 }
261}
262bind Text <Insert> {
263 catch {tk::TextInsert %W [::tk::GetSelection %W PRIMARY]}
264}
265bind Text <KeyPress> {
266 tk::TextInsert %W %A
267}
268
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>.
273
274bind Text <Alt-KeyPress> {# nothing }
275bind Text <Meta-KeyPress> {# nothing}
276bind Text <Control-KeyPress> {# nothing}
277bind Text <Escape> {# nothing}
278bind Text <KP_Enter> {# nothing}
279if {[string equal [tk windowingsystem] "classic"]
280 || [string equal [tk windowingsystem] "aqua"]} {
281 bind Text <Command-KeyPress> {# nothing}
282}
283
284# Additional emacs-like bindings:
285
286bind Text <Control-a> {
287 if {!$tk_strictMotif} {
288 tk::TextSetCursor %W {insert linestart}
289 }
290}
291bind Text <Control-b> {
292 if {!$tk_strictMotif} {
293 tk::TextSetCursor %W insert-1c
294 }
295}
296bind Text <Control-d> {
297 if {!$tk_strictMotif} {
298 %W delete insert
299 }
300}
301bind Text <Control-e> {
302 if {!$tk_strictMotif} {
303 tk::TextSetCursor %W {insert lineend}
304 }
305}
306bind Text <Control-f> {
307 if {!$tk_strictMotif} {
308 tk::TextSetCursor %W insert+1c
309 }
310}
311bind 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}
317 }
318 }
319}
320bind Text <Control-n> {
321 if {!$tk_strictMotif} {
322 tk::TextSetCursor %W [tk::TextUpDownLine %W 1]
323 }
324}
325bind Text <Control-o> {
326 if {!$tk_strictMotif} {
327 %W insert insert \n
328 %W mark set insert insert-1c
329 }
330}
331bind Text <Control-p> {
332 if {!$tk_strictMotif} {
333 tk::TextSetCursor %W [tk::TextUpDownLine %W -1]
334 }
335}
336bind Text <Control-t> {
337 if {!$tk_strictMotif} {
338 tk::TextTranspose %W
339 }
340}
341
342bind Text <<Undo>> {
343 catch { %W edit undo }
344}
345
346bind Text <<Redo>> {
347 catch { %W edit redo }
348}
349
350if {$tcl_platform(platform) ne "windows"} {
351bind Text <Control-v> {
352 if {!$tk_strictMotif} {
353 tk::TextScrollPages %W 1
354 }
355}
356}
357
358bind Text <Meta-b> {
359 if {!$tk_strictMotif} {
360 tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord]
361 }
362}
363bind Text <Meta-d> {
364 if {!$tk_strictMotif} {
365 %W delete insert [tk::TextNextWord %W insert]
366 }
367}
368bind Text <Meta-f> {
369 if {!$tk_strictMotif} {
370 tk::TextSetCursor %W [tk::TextNextWord %W insert]
371 }
372}
373bind Text <Meta-less> {
374 if {!$tk_strictMotif} {
375 tk::TextSetCursor %W 1.0
376 }
377}
378bind Text <Meta-greater> {
379 if {!$tk_strictMotif} {
380 tk::TextSetCursor %W end-1c
381 }
382}
383bind Text <Meta-BackSpace> {
384 if {!$tk_strictMotif} {
385 %W delete [tk::TextPrevPos %W insert tcl_startOfPreviousWord] insert
386 }
387}
388bind Text <Meta-Delete> {
389 if {!$tk_strictMotif} {
390 %W delete [tk::TextPrevPos %W insert tcl_startOfPreviousWord] insert
391 }
392}
393
394# Macintosh only bindings:
395
396# if text black & highlight black -> text white, other text the same
397if {[string equal [tk windowingsystem] "classic"]
398 || [string equal [tk windowingsystem] "aqua"]} {
399bind Text <FocusIn> {
400 %W tag configure sel -borderwidth 0
401 %W configure -selectbackground systemHighlight -selectforeground systemHighlightText
402}
403bind Text <FocusOut> {
404 %W tag configure sel -borderwidth 1
405 %W configure -selectbackground white -selectforeground black
406}
407bind Text <Option-Left> {
408 tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord]
409}
410bind Text <Option-Right> {
411 tk::TextSetCursor %W [tk::TextNextWord %W insert]
412}
413bind Text <Option-Up> {
414 tk::TextSetCursor %W [tk::TextPrevPara %W insert]
415}
416bind Text <Option-Down> {
417 tk::TextSetCursor %W [tk::TextNextPara %W insert]
418}
419bind Text <Shift-Option-Left> {
420 tk::TextKeySelect %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord]
421}
422bind Text <Shift-Option-Right> {
423 tk::TextKeySelect %W [tk::TextNextWord %W insert]
424}
425bind Text <Shift-Option-Up> {
426 tk::TextKeySelect %W [tk::TextPrevPara %W insert]
427}
428bind Text <Shift-Option-Down> {
429 tk::TextKeySelect %W [tk::TextNextPara %W insert]
430}
431
432# End of Mac only bindings
433}
434
435# A few additional bindings of my own.
436
437bind Text <Control-h> {
438 if {!$tk_strictMotif} {
439 if {[%W compare insert != 1.0]} {
440 %W delete insert-1c
441 %W see insert
442 }
443 }
444}
445bind Text <2> {
446 if {!$tk_strictMotif} {
447 tk::TextScanMark %W %x %y
448 }
449}
450bind Text <B2-Motion> {
451 if {!$tk_strictMotif} {
452 tk::TextScanDrag %W %x %y
453 }
454}
455set ::tk::Priv(prevPos) {}
456
457# The MouseWheel will typically only fire on Windows. However,
458# someone could use the "event generate" command to produce one
459# on other platforms.
460
461if {[string equal [tk windowingsystem] "classic"]
462 || [string equal [tk windowingsystem] "aqua"]} {
463 bind Text <MouseWheel> {
464 %W yview scroll [expr {- (%D)}] units
465 }
466 bind Text <Option-MouseWheel> {
467 %W yview scroll [expr {-10 * (%D)}] units
468 }
469 bind Text <Shift-MouseWheel> {
470 %W xview scroll [expr {- (%D)}] units
471 }
472 bind Text <Shift-Option-MouseWheel> {
473 %W xview scroll [expr {-10 * (%D)}] units
474 }
475} else {
476 bind Text <MouseWheel> {
477 %W yview scroll [expr {- (%D / 120) * 4}] units
478 }
479}
480
481if {[string equal "x11" [tk windowingsystem]]} {
482 # Support for mousewheels on Linux/Unix commonly comes through mapping
483 # the wheel to the extended buttons. If you have a mousewheel, find
484 # Linux configuration info at:
485 # http://www.inria.fr/koala/colas/mouse-wheel-scroll/
486 bind Text <4> {
487 if {!$tk_strictMotif} {
488 %W yview scroll -5 units
489 }
490 }
491 bind Text <5> {
492 if {!$tk_strictMotif} {
493 %W yview scroll 5 units
494 }
495 }
496}
497
498# ::tk::TextClosestGap --
499# Given x and y coordinates, this procedure finds the closest boundary
500# between characters to the given coordinates and returns the index
501# of the character just after the boundary.
502#
503# Arguments:
504# w - The text window.
505# x - X-coordinate within the window.
506# y - Y-coordinate within the window.
507
508proc ::tk::TextClosestGap {w x y} {
509 set pos [$w index @$x,$y]
510 set bbox [$w bbox $pos]
511 if {[string equal $bbox ""]} {
512 return $pos
513 }
514 if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} {
515 return $pos
516 }
517 $w index "$pos + 1 char"
518}
519
520# ::tk::TextButton1 --
521# This procedure is invoked to handle button-1 presses in text
522# widgets. It moves the insertion cursor, sets the selection anchor,
523# and claims the input focus.
524#
525# Arguments:
526# w - The text window in which the button was pressed.
527# x - The x-coordinate of the button press.
528# y - The x-coordinate of the button press.
529
530proc ::tk::TextButton1 {w x y} {
531 variable ::tk::Priv
532
533 set Priv(selectMode) char
534 set Priv(mouseMoved) 0
535 set Priv(pressX) $x
536 $w mark set insert [TextClosestGap $w $x $y]
537 $w mark set anchor insert
538 # Allow focus in any case on Windows, because that will let the
539 # selection be displayed even for state disabled text widgets.
540 if {[string equal $::tcl_platform(platform) "windows"] \
541 || [string equal [$w cget -state] "normal"]} {focus $w}
542 if {[$w cget -autoseparators]} {$w edit separator}
543}
544
545# ::tk::TextSelectTo --
546# This procedure is invoked to extend the selection, typically when
547# dragging it with the mouse. Depending on the selection mode (character,
548# word, line) it selects in different-sized units. This procedure
549# ignores mouse motions initially until the mouse has moved from
550# one character to another or until there have been multiple clicks.
551#
552# Arguments:
553# w - The text window in which the button was pressed.
554# x - Mouse x position.
555# y - Mouse y position.
556
557proc ::tk::TextSelectTo {w x y {extend 0}} {
558 global tcl_platform
559 variable ::tk::Priv
560
561 set cur [TextClosestGap $w $x $y]
562 if {[catch {$w index anchor}]} {
563 $w mark set anchor $cur
564 }
565 set anchor [$w index anchor]
566 if {[$w compare $cur != $anchor] || (abs($Priv(pressX) - $x) >= 3)} {
567 set Priv(mouseMoved) 1
568 }
569 switch $Priv(selectMode) {
570 char {
571 if {[$w compare $cur < anchor]} {
572 set first $cur
573 set last anchor
574 } else {
575 set first anchor
576 set last $cur
577 }
578 }
579 word {
580 if {[$w compare $cur < anchor]} {
581 set first [TextPrevPos $w "$cur + 1c" tcl_wordBreakBefore]
582 if { !$extend } {
583 set last [TextNextPos $w "anchor" tcl_wordBreakAfter]
584 } else {
585 set last anchor
586 }
587 } else {
588 set last [TextNextPos $w "$cur - 1c" tcl_wordBreakAfter]
589 if { !$extend } {
590 set first [TextPrevPos $w anchor tcl_wordBreakBefore]
591 } else {
592 set first anchor
593 }
594 }
595 }
596 line {
597 if {[$w compare $cur < anchor]} {
598 set first [$w index "$cur linestart"]
599 set last [$w index "anchor - 1c lineend + 1c"]
600 } else {
601 set first [$w index "anchor linestart"]
602 set last [$w index "$cur lineend + 1c"]
603 }
604 }
605 }
606 if {$Priv(mouseMoved) || $Priv(selectMode) ne "char"} {
607 $w tag remove sel 0.0 end
608 $w mark set insert $cur
609 $w tag add sel $first $last
610 $w tag remove sel $last end
611 update idletasks
612 }
613}
614
615# ::tk::TextKeyExtend --
616# This procedure handles extending the selection from the keyboard,
617# where the point to extend to is really the boundary between two
618# characters rather than a particular character.
619#
620# Arguments:
621# w - The text window.
622# index - The point to which the selection is to be extended.
623
624proc ::tk::TextKeyExtend {w index} {
625
626 set cur [$w index $index]
627 if {[catch {$w index anchor}]} {
628 $w mark set anchor $cur
629 }
630 set anchor [$w index anchor]
631 if {[$w compare $cur < anchor]} {
632 set first $cur
633 set last anchor
634 } else {
635 set first anchor
636 set last $cur
637 }
638 $w tag remove sel 0.0 $first
639 $w tag add sel $first $last
640 $w tag remove sel $last end
641}
642
643# ::tk::TextPasteSelection --
644# This procedure sets the insertion cursor to the mouse position,
645# inserts the selection, and sets the focus to the window.
646#
647# Arguments:
648# w - The text window.
649# x, y - Position of the mouse.
650
651proc ::tk::TextPasteSelection {w x y} {
652 $w mark set insert [TextClosestGap $w $x $y]
653 if {![catch {::tk::GetSelection $w PRIMARY} sel]} {
654 set oldSeparator [$w cget -autoseparators]
655 if {$oldSeparator} {
656 $w configure -autoseparators 0
657 $w edit separator
658 }
659 $w insert insert $sel
660 if {$oldSeparator} {
661 $w edit separator
662 $w configure -autoseparators 1
663 }
664 }
665 if {[string equal [$w cget -state] "normal"]} {focus $w}
666}
667
668# ::tk::TextAutoScan --
669# This procedure is invoked when the mouse leaves a text window
670# with button 1 down. It scrolls the window up, down, left, or right,
671# depending on where the mouse is (this information was saved in
672# ::tk::Priv(x) and ::tk::Priv(y)), and reschedules itself as an "after"
673# command so that the window continues to scroll until the mouse
674# moves back into the window or the mouse button is released.
675#
676# Arguments:
677# w - The text window.
678
679proc ::tk::TextAutoScan {w} {
680 variable ::tk::Priv
681 if {![winfo exists $w]} return
682 if {$Priv(y) >= [winfo height $w]} {
683 $w yview scroll 2 units
684 } elseif {$Priv(y) < 0} {
685 $w yview scroll -2 units
686 } elseif {$Priv(x) >= [winfo width $w]} {
687 $w xview scroll 2 units
688 } elseif {$Priv(x) < 0} {
689 $w xview scroll -2 units
690 } else {
691 return
692 }
693 TextSelectTo $w $Priv(x) $Priv(y)
694 set Priv(afterId) [after 50 [list tk::TextAutoScan $w]]
695}
696
697# ::tk::TextSetCursor
698# Move the insertion cursor to a given position in a text. Also
699# clears the selection, if there is one in the text, and makes sure
700# that the insertion cursor is visible. Also, don't let the insertion
701# cursor appear on the dummy last line of the text.
702#
703# Arguments:
704# w - The text window.
705# pos - The desired new position for the cursor in the window.
706
707proc ::tk::TextSetCursor {w pos} {
708
709 if {[$w compare $pos == end]} {
710 set pos {end - 1 chars}
711 }
712 $w mark set insert $pos
713 $w tag remove sel 1.0 end
714 $w see insert
715 if {[$w cget -autoseparators]} {$w edit separator}
716}
717
718# ::tk::TextKeySelect
719# This procedure is invoked when stroking out selections using the
720# keyboard. It moves the cursor to a new position, then extends
721# the selection to that position.
722#
723# Arguments:
724# w - The text window.
725# new - A new position for the insertion cursor (the cursor hasn't
726# actually been moved to this position yet).
727
728proc ::tk::TextKeySelect {w new} {
729
730 if {[string equal [$w tag nextrange sel 1.0 end] ""]} {
731 if {[$w compare $new < insert]} {
732 $w tag add sel $new insert
733 } else {
734 $w tag add sel insert $new
735 }
736 $w mark set anchor insert
737 } else {
738 if {[$w compare $new < anchor]} {
739 set first $new
740 set last anchor
741 } else {
742 set first anchor
743 set last $new
744 }
745 $w tag remove sel 1.0 $first
746 $w tag add sel $first $last
747 $w tag remove sel $last end
748 }
749 $w mark set insert $new
750 $w see insert
751 update idletasks
752}
753
754# ::tk::TextResetAnchor --
755# Set the selection anchor to whichever end is farthest from the
756# index argument. One special trick: if the selection has two or
757# fewer characters, just leave the anchor where it is. In this
758# case it doesn't matter which point gets chosen for the anchor,
759# and for the things like Shift-Left and Shift-Right this produces
760# better behavior when the cursor moves back and forth across the
761# anchor.
762#
763# Arguments:
764# w - The text widget.
765# index - Position at which mouse button was pressed, which determines
766# which end of selection should be used as anchor point.
767
768proc ::tk::TextResetAnchor {w index} {
769
770 if {[string equal [$w tag ranges sel] ""]} {
771 # Don't move the anchor if there is no selection now; this makes
772 # the widget behave "correctly" when the user clicks once, then
773 # shift-clicks somewhere -- ie, the area between the two clicks will be
774 # selected. [Bug: 5929].
775 return
776 }
777 set a [$w index $index]
778 set b [$w index sel.first]
779 set c [$w index sel.last]
780 if {[$w compare $a < $b]} {
781 $w mark set anchor sel.last
782 return
783 }
784 if {[$w compare $a > $c]} {
785 $w mark set anchor sel.first
786 return
787 }
788 scan $a "%d.%d" lineA chA
789 scan $b "%d.%d" lineB chB
790 scan $c "%d.%d" lineC chC
791 if {$lineB < $lineC+2} {
792 set total [string length [$w get $b $c]]
793 if {$total <= 2} {
794 return
795 }
796 if {[string length [$w get $b $a]] < ($total/2)} {
797 $w mark set anchor sel.last
798 } else {
799 $w mark set anchor sel.first
800 }
801 return
802 }
803 if {($lineA-$lineB) < ($lineC-$lineA)} {
804 $w mark set anchor sel.last
805 } else {
806 $w mark set anchor sel.first
807 }
808}
809
810# ::tk::TextInsert --
811# Insert a string into a text at the point of the insertion cursor.
812# If there is a selection in the text, and it covers the point of the
813# insertion cursor, then delete the selection before inserting.
814#
815# Arguments:
816# w - The text window in which to insert the string
817# s - The string to insert (usually just a single character)
818
819proc ::tk::TextInsert {w s} {
820 if {[string equal $s ""] || [string equal [$w cget -state] "disabled"]} {
821 return
822 }
823 set compound 0
824 catch {
825 if {[$w compare sel.first <= insert] \
826 && [$w compare sel.last >= insert]} {
827 set oldSeparator [$w cget -autoseparators]
828 if { $oldSeparator } {
829 $w configure -autoseparators 0
830 $w edit separator
831 set compound 1
832 }
833 $w delete sel.first sel.last
834 }
835 }
836 $w insert insert $s
837 $w see insert
838 if { $compound && $oldSeparator } {
839 $w edit separator
840 $w configure -autoseparators 1
841 }
842}
843
844# ::tk::TextUpDownLine --
845# Returns the index of the character one line above or below the
846# insertion cursor. There are two tricky things here. First,
847# we want to maintain the original column across repeated operations,
848# even though some lines that will get passed through don't have
849# enough characters to cover the original column. Second, don't
850# try to scroll past the beginning or end of the text.
851#
852# Arguments:
853# w - The text window in which the cursor is to move.
854# n - The number of lines to move: -1 for up one line,
855# +1 for down one line.
856
857proc ::tk::TextUpDownLine {w n} {
858 variable ::tk::Priv
859
860 set i [$w index insert]
861 scan $i "%d.%d" line char
862 if {$Priv(prevPos) ne $i} {
863 set Priv(char) $char
864 }
865 set new [$w index [expr {$line + $n}].$Priv(char)]
866 if {[$w compare $new == end] || [$w compare $new == "insert linestart"]} {
867 set new $i
868 }
869 set Priv(prevPos) $new
870 return $new
871}
872
873# ::tk::TextPrevPara --
874# Returns the index of the beginning of the paragraph just before a given
875# position in the text (the beginning of a paragraph is the first non-blank
876# character after a blank line).
877#
878# Arguments:
879# w - The text window in which the cursor is to move.
880# pos - Position at which to start search.
881
882proc ::tk::TextPrevPara {w pos} {
883 set pos [$w index "$pos linestart"]
884 while {1} {
885 if {([string equal [$w get "$pos - 1 line"] "\n"] \
886 && [$w get $pos] ne "\n") || [string equal $pos 1.0]} {
887 if {[regexp -indices {^[ ]+(.)} [$w get $pos "$pos lineend"] \
888 dummy index]} {
889 set pos [$w index "$pos + [lindex $index 0] chars"]
890 }
891 if {[$w compare $pos != insert] || [lindex [split $pos .] 0] == 1} {
892 return $pos
893 }
894 }
895 set pos [$w index "$pos - 1 line"]
896 }
897}
898
899# ::tk::TextNextPara --
900# Returns the index of the beginning of the paragraph just after a given
901# position in the text (the beginning of a paragraph is the first non-blank
902# character after a blank line).
903#
904# Arguments:
905# w - The text window in which the cursor is to move.
906# start - Position at which to start search.
907
908proc ::tk::TextNextPara {w start} {
909 set pos [$w index "$start linestart + 1 line"]
910 while {[$w get $pos] ne "\n"} {
911 if {[$w compare $pos == end]} {
912 return [$w index "end - 1c"]
913 }
914 set pos [$w index "$pos + 1 line"]
915 }
916 while {[$w get $pos] eq "\n"} {
917 set pos [$w index "$pos + 1 line"]
918 if {[$w compare $pos == end]} {
919 return [$w index "end - 1c"]
920 }
921 }
922 if {[regexp -indices {^[ ]+(.)} [$w get $pos "$pos lineend"] \
923 dummy index]} {
924 return [$w index "$pos + [lindex $index 0] chars"]
925 }
926 return $pos
927}
928
929# ::tk::TextScrollPages --
930# This is a utility procedure used in bindings for moving up and down
931# pages and possibly extending the selection along the way. It scrolls
932# the view in the widget by the number of pages, and it returns the
933# index of the character that is at the same position in the new view
934# as the insertion cursor used to be in the old view.
935#
936# Arguments:
937# w - The text window in which the cursor is to move.
938# count - Number of pages forward to scroll; may be negative
939# to scroll backwards.
940
941proc ::tk::TextScrollPages {w count} {
942 set bbox [$w bbox insert]
943 $w yview scroll $count pages
944 if {[string equal $bbox ""]} {
945 return [$w index @[expr {[winfo height $w]/2}],0]
946 }
947 return [$w index @[lindex $bbox 0],[lindex $bbox 1]]
948}
949
950# ::tk::TextTranspose --
951# This procedure implements the "transpose" function for text widgets.
952# It tranposes the characters on either side of the insertion cursor,
953# unless the cursor is at the end of the line. In this case it
954# transposes the two characters to the left of the cursor. In either
955# case, the cursor ends up to the right of the transposed characters.
956#
957# Arguments:
958# w - Text window in which to transpose.
959
960proc ::tk::TextTranspose w {
961 set pos insert
962 if {[$w compare $pos != "$pos lineend"]} {
963 set pos [$w index "$pos + 1 char"]
964 }
965 set new [$w get "$pos - 1 char"][$w get "$pos - 2 char"]
966 if {[$w compare "$pos - 1 char" == 1.0]} {
967 return
968 }
969 # ensure this is seen as an atomic op to undo
970 set autosep [$w cget -autoseparators]
971 if {$autosep} {
972 $w configure -autoseparators 0
973 $w edit separator
974 }
975 $w delete "$pos - 2 char" $pos
976 $w insert insert $new
977 $w see insert
978 if {$autosep} {
979 $w edit separator
980 $w configure -autoseparators $autosep
981 }
982}
983
984# ::tk_textCopy --
985# This procedure copies the selection from a text widget into the
986# clipboard.
987#
988# Arguments:
989# w - Name of a text widget.
990
991proc ::tk_textCopy w {
992 if {![catch {set data [$w get sel.first sel.last]}]} {
993 clipboard clear -displayof $w
994 clipboard append -displayof $w $data
995 }
996}
997
998# ::tk_textCut --
999# This procedure copies the selection from a text widget into the
1000# clipboard, then deletes the selection (if it exists in the given
1001# widget).
1002#
1003# Arguments:
1004# w - Name of a text widget.
1005
1006proc ::tk_textCut w {
1007 if {![catch {set data [$w get sel.first sel.last]}]} {
1008 clipboard clear -displayof $w
1009 clipboard append -displayof $w $data
1010 $w delete sel.first sel.last
1011 }
1012}
1013
1014# ::tk_textPaste --
1015# This procedure pastes the contents of the clipboard to the insertion
1016# point in a text widget.
1017#
1018# Arguments:
1019# w - Name of a text widget.
1020
1021proc ::tk_textPaste w {
1022 global tcl_platform
1023 if {![catch {::tk::GetSelection $w CLIPBOARD} sel]} {
1024 # ensure this is seen as an atomic op to undo
1025 set oldSeparator [$w cget -autoseparators]
1026 if { $oldSeparator } {
1027 $w configure -autoseparators 0
1028 $w edit separator
1029 }
1030 if {[tk windowingsystem] ne "x11"} {
1031 catch { $w delete sel.first sel.last }
1032 }
1033 $w insert insert $sel
1034 if { $oldSeparator } {
1035 $w edit separator
1036 $w configure -autoseparators 1
1037 }
1038 }
1039}
1040
1041# ::tk::TextNextWord --
1042# Returns the index of the next word position after a given position in the
1043# text. The next word is platform dependent and may be either the next
1044# end-of-word position or the next start-of-word position after the next
1045# end-of-word position.
1046#
1047# Arguments:
1048# w - The text window in which the cursor is to move.
1049# start - Position at which to start search.
1050
1051if {[string equal $tcl_platform(platform) "windows"]} {
1052 proc ::tk::TextNextWord {w start} {
1053 TextNextPos $w [TextNextPos $w $start tcl_endOfWord] \
1054 tcl_startOfNextWord
1055 }
1056} else {
1057 proc ::tk::TextNextWord {w start} {
1058 TextNextPos $w $start tcl_endOfWord
1059 }
1060}
1061
1062# ::tk::TextNextPos --
1063# Returns the index of the next position after the given starting
1064# position in the text as computed by a specified function.
1065#
1066# Arguments:
1067# w - The text window in which the cursor is to move.
1068# start - Position at which to start search.
1069# op - Function to use to find next position.
1070
1071proc ::tk::TextNextPos {w start op} {
1072 set text ""
1073 set cur $start
1074 while {[$w compare $cur < end]} {
1075 set text $text[$w get $cur "$cur lineend + 1c"]
1076 set pos [$op $text 0]
1077 if {$pos >= 0} {
1078 ## Adjust for embedded windows and images
1079 ## dump gives us 3 items per window/image
1080 set dump [$w dump -image -window $start "$start + $pos c"]
1081 if {[llength $dump]} {
1082 set pos [expr {$pos + ([llength $dump]/3)}]
1083 }
1084 return [$w index "$start + $pos c"]
1085 }
1086 set cur [$w index "$cur lineend +1c"]
1087 }
1088 return end
1089}
1090
1091# ::tk::TextPrevPos --
1092# Returns the index of the previous position before the given starting
1093# position in the text as computed by a specified function.
1094#
1095# Arguments:
1096# w - The text window in which the cursor is to move.
1097# start - Position at which to start search.
1098# op - Function to use to find next position.
1099
1100proc ::tk::TextPrevPos {w start op} {
1101 set text ""
1102 set cur $start
1103 while {[$w compare $cur > 0.0]} {
1104 set text [$w get "$cur linestart - 1c" $cur]$text
1105 set pos [$op $text end]
1106 if {$pos >= 0} {
1107 ## Adjust for embedded windows and images
1108 ## dump gives us 3 items per window/image
1109 set dump [$w dump -image -window "$cur linestart" "$start - 1c"]
1110 if {[llength $dump]} {
1111 ## This is a hokey extra hack for control-arrow movement
1112 ## that should be in a while loop to be correct (hobbs)
1113 if {[$w compare [lindex $dump 2] > \
1114 "$cur linestart - 1c + $pos c"]} {
1115 incr pos -1
1116 }
1117 set pos [expr {$pos + ([llength $dump]/3)}]
1118 }
1119 return [$w index "$cur linestart - 1c + $pos c"]
1120 }
1121 set cur [$w index "$cur linestart - 1c"]
1122 }
1123 return 0.0
1124}
1125
1126# ::tk::TextScanMark --
1127#
1128# Marks the start of a possible scan drag operation
1129#
1130# Arguments:
1131# w - The text window from which the text to get
1132# x - x location on screen
1133# y - y location on screen
1134
1135proc ::tk::TextScanMark {w x y} {
1136 $w scan mark $x $y
1137 set ::tk::Priv(x) $x
1138 set ::tk::Priv(y) $y
1139 set ::tk::Priv(mouseMoved) 0
1140}
1141
1142# ::tk::TextScanDrag --
1143#
1144# Marks the start of a possible scan drag operation
1145#
1146# Arguments:
1147# w - The text window from which the text to get
1148# x - x location on screen
1149# y - y location on screen
1150
1151proc ::tk::TextScanDrag {w x y} {
1152 # Make sure these exist, as some weird situations can trigger the
1153 # motion binding without the initial press. [Bug #220269]
1154 if {![info exists ::tk::Priv(x)]} { set ::tk::Priv(x) $x }
1155 if {![info exists ::tk::Priv(y)]} { set ::tk::Priv(y) $y }
1156 if {($x != $::tk::Priv(x)) || ($y != $::tk::Priv(y))} {
1157 set ::tk::Priv(mouseMoved) 1
1158 }
1159 if {[info exists ::tk::Priv(mouseMoved)] && $::tk::Priv(mouseMoved)} {
1160 $w scan dragto $x $y
1161 }
1162}