Ticket #14488: text.tcl

File text.tcl, 30.5 KB (added by mf2k (Frank Schima), 15 years ago)
Line 
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
457#if {[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}