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.9 2006/09/10 17:07:36 das 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 { [%W cget -state] eq "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}
279
280if {[tk windowingsystem] eq "classic" || [tk windowingsystem] eq "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
396if {[tk windowingsystem] eq "classic" || [tk windowingsystem] eq "aqua"} {
397bind Text <FocusIn> {
398    %W configure -selectbackground systemHighlight -selectforeground systemHighlightText
399}
400bind Text <FocusOut> {
401    %W configure -selectbackground systemHighlightSecondary -selectforeground systemHighlightText
402}
403bind Text <Option-Left> {
404    tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord]
405}
406bind Text <Option-Right> {
407    tk::TextSetCursor %W [tk::TextNextWord %W insert]
408}
409bind Text <Option-Up> {
410    tk::TextSetCursor %W [tk::TextPrevPara %W insert]
411}
412bind Text <Option-Down> {
413    tk::TextSetCursor %W [tk::TextNextPara %W insert]
414}
415bind Text <Shift-Option-Left> {
416    tk::TextKeySelect %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord]
417}
418bind Text <Shift-Option-Right> {
419    tk::TextKeySelect %W [tk::TextNextWord %W insert]
420}
421bind Text <Shift-Option-Up> {
422    tk::TextKeySelect %W [tk::TextPrevPara %W insert]
423}
424bind Text <Shift-Option-Down> {
425    tk::TextKeySelect %W [tk::TextNextPara %W insert]
426}
427
428# End of Mac only bindings
429}
430
431# A few additional bindings of my own.
432
433bind Text <Control-h> {
434    if {!$tk_strictMotif} {
435	if {[%W compare insert != 1.0]} {
436	    %W delete insert-1c
437	    %W see insert
438	}
439    }
440}
441bind Text <2> {
442    if {!$tk_strictMotif} {
443	tk::TextScanMark %W %x %y
444    }
445}
446bind Text <B2-Motion> {
447    if {!$tk_strictMotif} {
448	tk::TextScanDrag %W %x %y
449    }
450}
451set ::tk::Priv(prevPos) {}
452
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.
456
457if {[tk windowingsystem] eq "classic" || [tk windowingsystem] eq "aqua"} {
458    bind Text <MouseWheel> {
459        %W yview scroll [expr {- (%D)}] units
460    }
461    bind Text <Option-MouseWheel> {
462        %W yview scroll [expr {-10 * (%D)}] units
463    }
464    bind Text <Shift-MouseWheel> {
465        %W xview scroll [expr {- (%D)}] units
466    }
467    bind Text <Shift-Option-MouseWheel> {
468        %W xview scroll [expr {-10 * (%D)}] units
469    }
470} else {
471    bind Text <MouseWheel> {
472        %W yview scroll [expr {- (%D / 120) * 4}] units
473    }
474}
475
476if {"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
484	}
485    }
486    bind Text <5> {
487	if {!$tk_strictMotif} {
488	    %W yview scroll 5 units
489	}
490    }
491}
492
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.
497#
498# Arguments:
499# w -		The text window.
500# x -		X-coordinate within the window.
501# y -		Y-coordinate within the window.
502
503proc ::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
508    }
509    if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} {
510	return $pos
511    }
512    $w index "$pos + 1 char"
513}
514
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.
519#
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.
524
525proc ::tk::TextButton1 {w x y} {
526    variable ::tk::Priv
527
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}
537}
538
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.
545#
546# Arguments:
547# w -		The text window in which the button was pressed.
548# x -		Mouse x position.
549# y - 		Mouse y position.
550
551proc ::tk::TextSelectTo {w x y {extend 0}} {
552    global tcl_platform
553    variable ::tk::Priv
554
555    set cur [TextClosestGap $w $x $y]
556    if {[catch {$w index anchor}]} {
557	$w mark set anchor $cur
558    }
559    set anchor [$w index anchor]
560    if {[$w compare $cur != $anchor] || (abs($Priv(pressX) - $x) >= 3)} {
561	set Priv(mouseMoved) 1
562    }
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
571	    }
572	}
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
580		}
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
587		}
588	    }
589	}
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"]
597	    }
598	}
599    }
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
606    }
607}
608
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.
613#
614# Arguments:
615# w -		The text window.
616# index -	The point to which the selection is to be extended.
617
618proc ::tk::TextKeyExtend {w index} {
619
620    set cur [$w index $index]
621    if {[catch {$w index anchor}]} {
622	$w mark set anchor $cur
623    }
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
631    }
632    $w tag remove sel 0.0 $first
633    $w tag add sel $first $last
634    $w tag remove sel $last end
635}
636
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.
640#
641# Arguments:
642# w -		The text window.
643# x, y - 	Position of the mouse.
644
645proc ::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
652	}
653	$w insert insert $sel
654	if {$oldSeparator} {
655	    $w edit separator
656	    $w configure -autoseparators 1
657	}
658    }
659    if {[$w cget -state] eq "normal"} {focus $w}
660}
661
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.
669#
670# Arguments:
671# w -		The text window.
672
673proc ::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
686    }
687    TextSelectTo $w $Priv(x) $Priv(y)
688    set Priv(afterId) [after 50 [list tk::TextAutoScan $w]]
689}
690
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.
696#
697# Arguments:
698# w -		The text window.
699# pos -		The desired new position for the cursor in the window.
700
701proc ::tk::TextSetCursor {w pos} {
702
703    if {[$w compare $pos == end]} {
704	set pos {end - 1 chars}
705    }
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}
710}
711
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.
716#
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).
721
722proc ::tk::TextKeySelect {w new} {
723
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
729	}
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
738	}
739	$w tag remove sel 1.0 $first
740	$w tag add sel $first $last
741	$w tag remove sel $last end
742    }
743    $w mark set insert $new
744    $w see insert
745    update idletasks
746}
747
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.
756#
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.
761
762proc ::tk::TextResetAnchor {w index} {
763
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
770    }
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
777    }
778    if {[$w compare $a > $c]} {
779	$w mark set anchor sel.first
780	return
781    }
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
789	}
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
794	}
795	return
796    }
797    if {($lineA-$lineB) < ($lineC-$lineA)} {
798	$w mark set anchor sel.last
799    } else {
800	$w mark set anchor sel.first
801    }
802}
803
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.
808#
809# Arguments:
810# w -		The text window in which to insert the string
811# s -		The string to insert (usually just a single character)
812
813proc ::tk::TextInsert {w s} {
814    if {$s eq "" || [$w cget -state] eq "disabled"} {
815	return
816    }
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
826            }
827	    $w delete sel.first sel.last
828	}
829    }
830    $w insert insert $s
831    $w see insert
832    if { $compound && $oldSeparator } {
833        $w edit separator
834        $w configure -autoseparators 1
835    }
836}
837
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.
845#
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.
850
851proc ::tk::TextUpDownLine {w n} {
852    variable ::tk::Priv
853
854    set i [$w index insert]
855    scan $i "%d.%d" line char
856    if {$Priv(prevPos) ne $i} {
857	set Priv(char) $char
858    }
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
862    }
863    set Priv(prevPos) $new
864    return $new
865}
866
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).
871#
872# Arguments:
873# w -		The text window in which the cursor is to move.
874# pos -		Position at which to start search.
875
876proc ::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"]
884	    }
885	    if {[$w compare $pos != insert] || [lindex [split $pos .] 0] == 1} {
886		return $pos
887	    }
888	}
889	set pos [$w index "$pos - 1 line"]
890    }
891}
892
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).
897#
898# Arguments:
899# w -		The text window in which the cursor is to move.
900# start -	Position at which to start search.
901
902proc ::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"]
907	}
908	set pos [$w index "$pos + 1 line"]
909    }
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"]
914	}
915    }
916    if {[regexp -indices {^[ 	]+(.)} [$w get $pos "$pos lineend"] \
917	    dummy index]} {
918	return [$w index "$pos + [lindex $index 0] chars"]
919    }
920    return $pos
921}
922
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.
929#
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.
934
935proc ::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]
940    }
941    return [$w index @[lindex $bbox 0],[lindex $bbox 1]]
942}
943
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.
950#
951# Arguments:
952# w -		Text window in which to transpose.
953
954proc ::tk::TextTranspose w {
955    set pos insert
956    if {[$w compare $pos != "$pos lineend"]} {
957	set pos [$w index "$pos + 1 char"]
958    }
959    set new [$w get "$pos - 1 char"][$w get  "$pos - 2 char"]
960    if {[$w compare "$pos - 1 char" == 1.0]} {
961	return
962    }
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
968    }
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
975    }
976}
977
978# ::tk_textCopy --
979# This procedure copies the selection from a text widget into the
980# clipboard.
981#
982# Arguments:
983# w -		Name of a text widget.
984
985proc ::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
989    }
990}
991
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).
996#
997# Arguments:
998# w -		Name of a text widget.
999
1000proc ::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
1005    }
1006}
1007
1008# ::tk_textPaste --
1009# This procedure pastes the contents of the clipboard to the insertion
1010# point in a text widget.
1011#
1012# Arguments:
1013# w -		Name of a text widget.
1014
1015proc ::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
1023	}
1024	if {[tk windowingsystem] ne "x11"} {
1025	    catch { $w delete sel.first sel.last }
1026	}
1027	$w insert insert $sel
1028	if { $oldSeparator } {
1029	    $w edit separator
1030	    $w configure -autoseparators 1
1031	}
1032    }
1033}
1034
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.
1040#
1041# Arguments:
1042# w -		The text window in which the cursor is to move.
1043# start -	Position at which to start search.
1044
1045if {$tcl_platform(platform) eq "windows"}  {
1046    proc ::tk::TextNextWord {w start} {
1047	TextNextPos $w [TextNextPos $w $start tcl_endOfWord] \
1048	    tcl_startOfNextWord
1049    }
1050} else {
1051    proc ::tk::TextNextWord {w start} {
1052	TextNextPos $w $start tcl_endOfWord
1053    }
1054}
1055
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.
1059#
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.
1064
1065proc ::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)}]
1077	    }
1078	    return [$w index "$start + $pos c"]
1079	}
1080	set cur [$w index "$cur lineend +1c"]
1081    }
1082    return end
1083}
1084
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.
1088#
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.
1093
1094proc ::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
1110		}
1111		set pos [expr {$pos + ([llength $dump]/3)}]
1112	    }
1113	    return [$w index "$cur linestart - 1c + $pos c"]
1114	}
1115	set cur [$w index "$cur linestart - 1c"]
1116    }
1117    return 0.0
1118}
1119
1120# ::tk::TextScanMark --
1121#
1122# Marks the start of a possible scan drag operation
1123#
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
1128
1129proc ::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
1134}
1135
1136# ::tk::TextScanDrag --
1137#
1138# Marks the start of a possible scan drag operation
1139#
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
1144
1145proc ::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
1152    }
1153    if {[info exists ::tk::Priv(mouseMoved)] && $::tk::Priv(mouseMoved)} {
1154	$w scan dragto $x $y
1155    }
1156}
1157