figenc

text.tcl (33087B)

---

 # text.tcl --
 #
 # This file defines the default bindings for Tk text widgets and provides
 # procedures that help in implementing the bindings.
 #
 # Copyright (c) 1992-1994 The Regents of the University of California.
 # Copyright (c) 1994-1997 Sun Microsystems, Inc.
 # Copyright (c) 1998 by Scriptics Corporation.
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
 
 #-------------------------------------------------------------------------
 # Elements of ::tk::Priv that are used in this file:
 #
 # afterId -		If non-null, it means that auto-scanning is underway
 #			and it gives the "after" id for the next auto-scan
 #			command to be executed.
 # char -		Character position on the line;  kept in order
 #			to allow moving up or down past short lines while
 #			still remembering the desired position.
 # mouseMoved -		Non-zero means the mouse has moved a significant
 #			amount since the button went down (so, for example,
 #			start dragging out a selection).
 # prevPos -		Used when moving up or down lines via the keyboard.
 #			Keeps track of the previous insert position, so
 #			we can distinguish a series of ups and downs, all
 #			in a row, from a new up or down.
 # selectMode -		The style of selection currently underway:
 #			char, word, or line.
 # x, y -		Last known mouse coordinates for scanning
 #			and auto-scanning.
 #
 #-------------------------------------------------------------------------
 
 #-------------------------------------------------------------------------
 # The code below creates the default class bindings for text widgets.
 #-------------------------------------------------------------------------
 
 # Standard Motif bindings:
 
 bind Text <1> {
     tk::TextButton1 %W %x %y
     %W tag remove sel 0.0 end
 }
 bind Text <B1-Motion> {
     set tk::Priv(x) %x
     set tk::Priv(y) %y
     tk::TextSelectTo %W %x %y
 }
 bind Text <Double-1> {
     set tk::Priv(selectMode) word
     tk::TextSelectTo %W %x %y
     catch {%W mark set insert sel.first}
 }
 bind Text <Triple-1> {
     set tk::Priv(selectMode) line
     tk::TextSelectTo %W %x %y
     catch {%W mark set insert sel.first}
 }
 bind Text <Shift-1> {
     tk::TextResetAnchor %W @%x,%y
     set tk::Priv(selectMode) char
     tk::TextSelectTo %W %x %y
 }
 bind Text <Double-Shift-1>	{
     set tk::Priv(selectMode) word
     tk::TextSelectTo %W %x %y 1
 }
 bind Text <Triple-Shift-1>	{
     set tk::Priv(selectMode) line
     tk::TextSelectTo %W %x %y
 }
 bind Text <B1-Leave> {
     set tk::Priv(x) %x
     set tk::Priv(y) %y
     tk::TextAutoScan %W
 }
 bind Text <B1-Enter> {
     tk::CancelRepeat
 }
 bind Text <ButtonRelease-1> {
     tk::CancelRepeat
 }
 bind Text <Control-1> {
     %W mark set insert @%x,%y
     # An operation that moves the insert mark without making it
     # one end of the selection must insert an autoseparator
     if {[%W cget -autoseparators]} {
 	%W edit separator
     }
 }
 # stop an accidental double click triggering <Double-Button-1>
 bind Text <Double-Control-1> { # nothing }
 # stop an accidental movement triggering <B1-Motion>
 bind Text <Control-B1-Motion> { # nothing }
 bind Text <<PrevChar>> {
     tk::TextSetCursor %W insert-1displayindices
 }
 bind Text <<NextChar>> {
     tk::TextSetCursor %W insert+1displayindices
 }
 bind Text <<PrevLine>> {
     tk::TextSetCursor %W [tk::TextUpDownLine %W -1]
 }
 bind Text <<NextLine>> {
     tk::TextSetCursor %W [tk::TextUpDownLine %W 1]
 }
 bind Text <<SelectPrevChar>> {
     tk::TextKeySelect %W [%W index {insert - 1displayindices}]
 }
 bind Text <<SelectNextChar>> {
     tk::TextKeySelect %W [%W index {insert + 1displayindices}]
 }
 bind Text <<SelectPrevLine>> {
     tk::TextKeySelect %W [tk::TextUpDownLine %W -1]
 }
 bind Text <<SelectNextLine>> {
     tk::TextKeySelect %W [tk::TextUpDownLine %W 1]
 }
 bind Text <<PrevWord>> {
     tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord]
 }
 bind Text <<NextWord>> {
     tk::TextSetCursor %W [tk::TextNextWord %W insert]
 }
 bind Text <<PrevPara>> {
     tk::TextSetCursor %W [tk::TextPrevPara %W insert]
 }
 bind Text <<NextPara>> {
     tk::TextSetCursor %W [tk::TextNextPara %W insert]
 }
 bind Text <<SelectPrevWord>> {
     tk::TextKeySelect %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord]
 }
 bind Text <<SelectNextWord>> {
     tk::TextKeySelect %W [tk::TextNextWord %W insert]
 }
 bind Text <<SelectPrevPara>> {
     tk::TextKeySelect %W [tk::TextPrevPara %W insert]
 }
 bind Text <<SelectNextPara>> {
     tk::TextKeySelect %W [tk::TextNextPara %W insert]
 }
 bind Text <Prior> {
     tk::TextSetCursor %W [tk::TextScrollPages %W -1]
 }
 bind Text <Shift-Prior> {
     tk::TextKeySelect %W [tk::TextScrollPages %W -1]
 }
 bind Text <Next> {
     tk::TextSetCursor %W [tk::TextScrollPages %W 1]
 }
 bind Text <Shift-Next> {
     tk::TextKeySelect %W [tk::TextScrollPages %W 1]
 }
 bind Text <Control-Prior> {
     %W xview scroll -1 page
 }
 bind Text <Control-Next> {
     %W xview scroll 1 page
 }
 
 bind Text <<LineStart>> {
     tk::TextSetCursor %W {insert display linestart}
 }
 bind Text <<SelectLineStart>> {
     tk::TextKeySelect %W {insert display linestart}
 }
 bind Text <<LineEnd>> {
     tk::TextSetCursor %W {insert display lineend}
 }
 bind Text <<SelectLineEnd>> {
     tk::TextKeySelect %W {insert display lineend}
 }
 bind Text <Control-Home> {
     tk::TextSetCursor %W 1.0
 }
 bind Text <Control-Shift-Home> {
     tk::TextKeySelect %W 1.0
 }
 bind Text <Control-End> {
     tk::TextSetCursor %W {end - 1 indices}
 }
 bind Text <Control-Shift-End> {
     tk::TextKeySelect %W {end - 1 indices}
 }
 
 bind Text <Tab> {
     if {[%W cget -state] eq "normal"} {
 	tk::TextInsert %W \t
 	focus %W
 	break
     }
 }
 bind Text <Shift-Tab> {
     # Needed only to keep <Tab> binding from triggering;  doesn't
     # have to actually do anything.
     break
 }
 bind Text <Control-Tab> {
     focus [tk_focusNext %W]
 }
 bind Text <Control-Shift-Tab> {
     focus [tk_focusPrev %W]
 }
 bind Text <Control-i> {
     tk::TextInsert %W \t
 }
 bind Text <Return> {
     tk::TextInsert %W \n
     if {[%W cget -autoseparators]} {
 	%W edit separator
     }
 }
 bind Text <Delete> {
     if {[tk::TextCursorInSelection %W]} {
 	%W delete sel.first sel.last
     } else {
 	if {[%W compare end != insert+1c]} {
 	    %W delete insert
 	}
 	%W see insert
     }
 }
 bind Text <BackSpace> {
     if {[tk::TextCursorInSelection %W]} {
 	%W delete sel.first sel.last
     } else {
 	if {[%W compare insert != 1.0]} {
 	    %W delete insert-1c
 	}
 	%W see insert
     }
 }
 
 bind Text <Control-space> {
     %W mark set [tk::TextAnchor %W] insert
 }
 bind Text <Select> {
     %W mark set [tk::TextAnchor %W] insert
 }
 bind Text <Control-Shift-space> {
     set tk::Priv(selectMode) char
     tk::TextKeyExtend %W insert
 }
 bind Text <Shift-Select> {
     set tk::Priv(selectMode) char
     tk::TextKeyExtend %W insert
 }
 bind Text <<SelectAll>> {
     %W tag add sel 1.0 end
 }
 bind Text <<SelectNone>> {
     %W tag remove sel 1.0 end
     # An operation that clears the selection must insert an autoseparator,
     # because the selection operation may have moved the insert mark
     if {[%W cget -autoseparators]} {
 	%W edit separator
     }
 }
 bind Text <<Cut>> {
     tk_textCut %W
 }
 bind Text <<Copy>> {
     tk_textCopy %W
 }
 bind Text <<Paste>> {
     tk_textPaste %W
 }
 bind Text <<Clear>> {
     # Make <<Clear>> an atomic operation on the Undo stack,
     # i.e. separate it from other delete operations on either side
     if {[%W cget -autoseparators]} {
 	%W edit separator
     }
     catch {%W delete sel.first sel.last}
     if {[%W cget -autoseparators]} {
 	%W edit separator
     }
 }
 bind Text <<PasteSelection>> {
     if {$tk_strictMotif || ![info exists tk::Priv(mouseMoved)]
 	    || !$tk::Priv(mouseMoved)} {
 	tk::TextPasteSelection %W %x %y
     }
 }
 bind Text <Insert> {
     catch {tk::TextInsert %W [::tk::GetSelection %W PRIMARY]}
 }
 bind Text <KeyPress> {
     tk::TextInsert %W %A
 }
 
 # Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
 # Otherwise, if a widget binding for one of these is defined, the
 # <KeyPress> class binding will also fire and insert the character,
 # which is wrong.  Ditto for <Escape>.
 
 bind Text <Alt-KeyPress> {# nothing }
 bind Text <Meta-KeyPress> {# nothing}
 bind Text <Control-KeyPress> {# nothing}
 bind Text <Escape> {# nothing}
 bind Text <KP_Enter> {# nothing}
 if {[tk windowingsystem] eq "aqua"} {
     bind Text <Command-KeyPress> {# nothing}
 }
 
 # Additional emacs-like bindings:
 
 bind Text <Control-d> {
     if {!$tk_strictMotif && [%W compare end != insert+1c]} {
 	%W delete insert
     }
 }
 bind Text <Control-k> {
     if {!$tk_strictMotif && [%W compare end != insert+1c]} {
 	if {[%W compare insert == {insert lineend}]} {
 	    %W delete insert
 	} else {
 	    %W delete insert {insert lineend}
 	}
     }
 }
 bind Text <Control-o> {
     if {!$tk_strictMotif} {
 	%W insert insert \n
 	%W mark set insert insert-1c
     }
 }
 bind Text <Control-t> {
     if {!$tk_strictMotif} {
 	tk::TextTranspose %W
     }
 }
 
 bind Text <<Undo>> {
     # An Undo operation may remove the separator at the top of the Undo stack.
     # Then the item at the top of the stack gets merged with the subsequent changes.
     # Place separators before and after Undo to prevent this.
     if {[%W cget -autoseparators]} {
 	%W edit separator
     }
     catch { %W edit undo }
     if {[%W cget -autoseparators]} {
 	%W edit separator
     }
 }
 
 bind Text <<Redo>> {
     catch { %W edit redo }
 }
 
 bind Text <Meta-b> {
     if {!$tk_strictMotif} {
 	tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord]
     }
 }
 bind Text <Meta-d> {
     if {!$tk_strictMotif && [%W compare end != insert+1c]} {
 	%W delete insert [tk::TextNextWord %W insert]
     }
 }
 bind Text <Meta-f> {
     if {!$tk_strictMotif} {
 	tk::TextSetCursor %W [tk::TextNextWord %W insert]
     }
 }
 bind Text <Meta-less> {
     if {!$tk_strictMotif} {
 	tk::TextSetCursor %W 1.0
     }
 }
 bind Text <Meta-greater> {
     if {!$tk_strictMotif} {
 	tk::TextSetCursor %W end-1c
     }
 }
 bind Text <Meta-BackSpace> {
     if {!$tk_strictMotif} {
 	%W delete [tk::TextPrevPos %W insert tcl_startOfPreviousWord] insert
     }
 }
 bind Text <Meta-Delete> {
     if {!$tk_strictMotif} {
 	%W delete [tk::TextPrevPos %W insert tcl_startOfPreviousWord] insert
     }
 }
 
 # Macintosh only bindings:
 
 if {[tk windowingsystem] eq "aqua"} {
 bind Text <Control-v> {
     tk::TextScrollPages %W 1
 }
 
 # End of Mac only bindings
 }
 
 # A few additional bindings of my own.
 
 bind Text <Control-h> {
     if {!$tk_strictMotif && [%W compare insert != 1.0]} {
 	%W delete insert-1c
 	%W see insert
     }
 }
 bind Text <2> {
     if {!$tk_strictMotif} {
 	tk::TextScanMark %W %x %y
     }
 }
 bind Text <B2-Motion> {
     if {!$tk_strictMotif} {
 	tk::TextScanDrag %W %x %y
     }
 }
 set ::tk::Priv(prevPos) {}
 
 # The MouseWheel will typically only fire on Windows and MacOS X.
 # However, someone could use the "event generate" command to produce one
 # on other platforms.  We must be careful not to round -ve values of %D
 # down to zero.
 
 if {[tk windowingsystem] eq "aqua"} {
     bind Text <MouseWheel> {
         %W yview scroll [expr {-15 * (%D)}] pixels
     }
     bind Text <Option-MouseWheel> {
         %W yview scroll [expr {-150 * (%D)}] pixels
     }
     bind Text <Shift-MouseWheel> {
         %W xview scroll [expr {-15 * (%D)}] pixels
     }
     bind Text <Shift-Option-MouseWheel> {
         %W xview scroll [expr {-150 * (%D)}] pixels
     }
 } else {
     # We must make sure that positive and negative movements are rounded
     # equally to integers, avoiding the problem that
     #     (int)1/3 = 0,
     # but
     #     (int)-1/3 = -1
     # The following code ensure equal +/- behaviour.
     bind Text <MouseWheel> {
 	if {%D >= 0} {
 	    %W yview scroll [expr {-%D/3}] pixels
 	} else {
 	    %W yview scroll [expr {(2-%D)/3}] pixels
 	}
     }
     bind Text <Shift-MouseWheel> {
 	if {%D >= 0} {
 	    %W xview scroll [expr {-%D/3}] pixels
 	} else {
 	    %W xview scroll [expr {(2-%D)/3}] pixels
 	}
     }
 }
 
 if {"x11" eq [tk windowingsystem]} {
     # Support for mousewheels on Linux/Unix commonly comes through mapping
     # the wheel to the extended buttons.  If you have a mousewheel, find
     # Linux configuration info at:
     #	http://linuxreviews.org/howtos/xfree/mouse/
     bind Text <4> {
 	if {!$tk_strictMotif} {
 	    %W yview scroll -50 pixels
 	}
     }
     bind Text <5> {
 	if {!$tk_strictMotif} {
 	    %W yview scroll 50 pixels
 	}
     }
     bind Text <Shift-4> {
 	if {!$tk_strictMotif} {
 	    %W xview scroll -50 pixels
 	}
     }
     bind Text <Shift-5> {
 	if {!$tk_strictMotif} {
 	    %W xview scroll 50 pixels
 	}
     }
 }
 
 # ::tk::TextClosestGap --
 # Given x and y coordinates, this procedure finds the closest boundary
 # between characters to the given coordinates and returns the index
 # of the character just after the boundary.
 #
 # Arguments:
 # w -		The text window.
 # x -		X-coordinate within the window.
 # y -		Y-coordinate within the window.
 
 proc ::tk::TextClosestGap {w x y} {
     set pos [$w index @$x,$y]
     set bbox [$w bbox $pos]
     if {$bbox eq ""} {
 	return $pos
     }
     if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} {
 	return $pos
     }
     $w index "$pos + 1 char"
 }
 
 # ::tk::TextButton1 --
 # This procedure is invoked to handle button-1 presses in text
 # widgets.  It moves the insertion cursor, sets the selection anchor,
 # and claims the input focus.
 #
 # Arguments:
 # w -		The text window in which the button was pressed.
 # x -		The x-coordinate of the button press.
 # y -		The x-coordinate of the button press.
 
 proc ::tk::TextButton1 {w x y} {
     variable ::tk::Priv
 
     set Priv(selectMode) char
     set Priv(mouseMoved) 0
     set Priv(pressX) $x
     set anchorname [tk::TextAnchor $w]
     $w mark set insert [TextClosestGap $w $x $y]
     $w mark set $anchorname insert
     # Set the anchor mark's gravity depending on the click position
     # relative to the gap
     set bbox [$w bbox [$w index $anchorname]]
     if {$x > [lindex $bbox 0]} {
 	$w mark gravity $anchorname right
     } else {
 	$w mark gravity $anchorname left
     }
     # Allow focus in any case on Windows, because that will let the
     # selection be displayed even for state disabled text widgets.
     if {[tk windowingsystem] eq "win32" \
 	    || [$w cget -state] eq "normal"} {
 	focus $w
     }
     if {[$w cget -autoseparators]} {
 	$w edit separator
     }
 }
 
 # ::tk::TextSelectTo --
 # This procedure is invoked to extend the selection, typically when
 # dragging it with the mouse.  Depending on the selection mode (character,
 # word, line) it selects in different-sized units.  This procedure
 # ignores mouse motions initially until the mouse has moved from
 # one character to another or until there have been multiple clicks.
 #
 # Note that the 'anchor' is implemented programmatically using
 # a text widget mark, and uses a name that will be unique for each
 # text widget (even when there are multiple peers).  Currently the
 # anchor is considered private to Tk, hence the name 'tk::anchor$w'.
 #
 # Arguments:
 # w -		The text window in which the button was pressed.
 # x -		Mouse x position.
 # y - 		Mouse y position.
 
 set ::tk::Priv(textanchoruid) 0
 
 proc ::tk::TextAnchor {w} {
     variable Priv
     if {![info exists Priv(textanchor,$w)]} {
         set Priv(textanchor,$w) tk::anchor[incr Priv(textanchoruid)]
     }
     return $Priv(textanchor,$w)
 }
 
 proc ::tk::TextSelectTo {w x y {extend 0}} {
     variable ::tk::Priv
 
     set anchorname [tk::TextAnchor $w]
     set cur [TextClosestGap $w $x $y]
     if {[catch {$w index $anchorname}]} {
 	$w mark set $anchorname $cur
     }
     set anchor [$w index $anchorname]
     if {[$w compare $cur != $anchor] || (abs($Priv(pressX) - $x) >= 3)} {
 	set Priv(mouseMoved) 1
     }
     switch -- $Priv(selectMode) {
 	char {
 	    if {[$w compare $cur < $anchorname]} {
 		set first $cur
 		set last $anchorname
 	    } else {
 		set first $anchorname
 		set last $cur
 	    }
 	}
 	word {
 	    # Set initial range based only on the anchor (1 char min width)
 	    if {[$w mark gravity $anchorname] eq "right"} {
 		set first $anchorname
 		set last "$anchorname + 1c"
 	    } else {
 		set first "$anchorname - 1c"
 		set last $anchorname
 	    }
 	    # Extend range (if necessary) based on the current point
 	    if {[$w compare $cur < $first]} {
 		set first $cur
 	    } elseif {[$w compare $cur > $last]} {
 		set last $cur
 	    }
 
 	    # Now find word boundaries
 	    set first [TextPrevPos $w "$first + 1c" tcl_wordBreakBefore]
 	    set last [TextNextPos $w "$last - 1c" tcl_wordBreakAfter]
 	}
 	line {
 	    # Set initial range based only on the anchor
 	    set first "$anchorname linestart"
 	    set last "$anchorname lineend"
 
 	    # Extend range (if necessary) based on the current point
 	    if {[$w compare $cur < $first]} {
 		set first "$cur linestart"
 	    } elseif {[$w compare $cur > $last]} {
 		set last "$cur lineend"
 	    }
 	    set first [$w index $first]
 	    set last [$w index "$last + 1c"]
 	}
     }
     if {$Priv(mouseMoved) || ($Priv(selectMode) ne "char")} {
 	$w tag remove sel 0.0 end
 	$w mark set insert $cur
 	$w tag add sel $first $last
 	$w tag remove sel $last end
 	update idletasks
     }
 }
 
 # ::tk::TextKeyExtend --
 # This procedure handles extending the selection from the keyboard,
 # where the point to extend to is really the boundary between two
 # characters rather than a particular character.
 #
 # Arguments:
 # w -		The text window.
 # index -	The point to which the selection is to be extended.
 
 proc ::tk::TextKeyExtend {w index} {
 
     set anchorname [tk::TextAnchor $w]
     set cur [$w index $index]
     if {[catch {$w index $anchorname}]} {
 	$w mark set $anchorname $cur
     }
     set anchor [$w index $anchorname]
     if {[$w compare $cur < $anchorname]} {
 	set first $cur
 	set last $anchorname
     } else {
 	set first $anchorname
 	set last $cur
     }
     $w tag remove sel 0.0 $first
     $w tag add sel $first $last
     $w tag remove sel $last end
 }
 
 # ::tk::TextPasteSelection --
 # This procedure sets the insertion cursor to the mouse position,
 # inserts the selection, and sets the focus to the window.
 #
 # Arguments:
 # w -		The text window.
 # x, y - 	Position of the mouse.
 
 proc ::tk::TextPasteSelection {w x y} {
     $w mark set insert [TextClosestGap $w $x $y]
     if {![catch {::tk::GetSelection $w PRIMARY} sel]} {
 	set oldSeparator [$w cget -autoseparators]
 	if {$oldSeparator} {
 	    $w configure -autoseparators 0
 	    $w edit separator
 	}
 	$w insert insert $sel
 	if {$oldSeparator} {
 	    $w edit separator
 	    $w configure -autoseparators 1
 	}
     }
     if {[$w cget -state] eq "normal"} {
 	focus $w
     }
 }
 
 # ::tk::TextAutoScan --
 # This procedure is invoked when the mouse leaves a text window
 # with button 1 down.  It scrolls the window up, down, left, or right,
 # depending on where the mouse is (this information was saved in
 # ::tk::Priv(x) and ::tk::Priv(y)), and reschedules itself as an "after"
 # command so that the window continues to scroll until the mouse
 # moves back into the window or the mouse button is released.
 #
 # Arguments:
 # w -		The text window.
 
 proc ::tk::TextAutoScan {w} {
     variable ::tk::Priv
     if {![winfo exists $w]} {
 	return
     }
     if {$Priv(y) >= [winfo height $w]} {
 	$w yview scroll [expr {1 + $Priv(y) - [winfo height $w]}] pixels
     } elseif {$Priv(y) < 0} {
 	$w yview scroll [expr {-1 + $Priv(y)}] pixels
     } elseif {$Priv(x) >= [winfo width $w]} {
 	$w xview scroll 2 units
     } elseif {$Priv(x) < 0} {
 	$w xview scroll -2 units
     } else {
 	return
     }
     TextSelectTo $w $Priv(x) $Priv(y)
     set Priv(afterId) [after 50 [list tk::TextAutoScan $w]]
 }
 
 # ::tk::TextSetCursor
 # Move the insertion cursor to a given position in a text.  Also
 # clears the selection, if there is one in the text, and makes sure
 # that the insertion cursor is visible.  Also, don't let the insertion
 # cursor appear on the dummy last line of the text.
 #
 # Arguments:
 # w -		The text window.
 # pos -		The desired new position for the cursor in the window.
 
 proc ::tk::TextSetCursor {w pos} {
     if {[$w compare $pos == end]} {
 	set pos {end - 1 chars}
     }
     $w mark set insert $pos
     $w tag remove sel 1.0 end
     $w see insert
     if {[$w cget -autoseparators]} {
 	$w edit separator
     }
 }
 
 # ::tk::TextKeySelect
 # This procedure is invoked when stroking out selections using the
 # keyboard.  It moves the cursor to a new position, then extends
 # the selection to that position.
 #
 # Arguments:
 # w -		The text window.
 # new -		A new position for the insertion cursor (the cursor hasn't
 #		actually been moved to this position yet).
 
 proc ::tk::TextKeySelect {w new} {
     set anchorname [tk::TextAnchor $w]
     if {[$w tag nextrange sel 1.0 end] eq ""} {
 	if {[$w compare $new < insert]} {
 	    $w tag add sel $new insert
 	} else {
 	    $w tag add sel insert $new
 	}
 	$w mark set $anchorname insert
     } else {
         if {[catch {$w index $anchorname}]} {
             $w mark set $anchorname insert
         }
 	if {[$w compare $new < $anchorname]} {
 	    set first $new
 	    set last $anchorname
 	} else {
 	    set first $anchorname
 	    set last $new
 	}
 	$w tag remove sel 1.0 $first
 	$w tag add sel $first $last
 	$w tag remove sel $last end
     }
     $w mark set insert $new
     $w see insert
     update idletasks
 }
 
 # ::tk::TextResetAnchor --
 # Set the selection anchor to whichever end is farthest from the
 # index argument.  One special trick: if the selection has two or
 # fewer characters, just leave the anchor where it is.  In this
 # case it doesn't matter which point gets chosen for the anchor,
 # and for the things like Shift-Left and Shift-Right this produces
 # better behavior when the cursor moves back and forth across the
 # anchor.
 #
 # Arguments:
 # w -		The text widget.
 # index -	Position at which mouse button was pressed, which determines
 #		which end of selection should be used as anchor point.
 
 proc ::tk::TextResetAnchor {w index} {
     if {[$w tag ranges sel] eq ""} {
 	# Don't move the anchor if there is no selection now; this
 	# makes the widget behave "correctly" when the user clicks
 	# once, then shift-clicks somewhere -- ie, the area between
 	# the two clicks will be selected. [Bug: 5929].
 	return
     }
     set anchorname [tk::TextAnchor $w]
     set a [$w index $index]
     set b [$w index sel.first]
     set c [$w index sel.last]
     if {[$w compare $a < $b]} {
 	$w mark set $anchorname sel.last
 	return
     }
     if {[$w compare $a > $c]} {
 	$w mark set $anchorname sel.first
 	return
     }
     scan $a "%d.%d" lineA chA
     scan $b "%d.%d" lineB chB
     scan $c "%d.%d" lineC chC
     if {$lineB < $lineC+2} {
 	set total [string length [$w get $b $c]]
 	if {$total <= 2} {
 	    return
 	}
 	if {[string length [$w get $b $a]] < ($total/2)} {
 	    $w mark set $anchorname sel.last
 	} else {
 	    $w mark set $anchorname sel.first
 	}
 	return
     }
     if {($lineA-$lineB) < ($lineC-$lineA)} {
 	$w mark set $anchorname sel.last
     } else {
 	$w mark set $anchorname sel.first
     }
 }
 
 # ::tk::TextCursorInSelection --
 # Check whether the selection exists and contains the insertion cursor. Note
 # that it assumes that the selection is contiguous.
 #
 # Arguments:
 # w -		The text widget whose selection is to be checked
 
 proc ::tk::TextCursorInSelection {w} {
     expr {
 	[llength [$w tag ranges sel]]
 	&& [$w compare sel.first <= insert]
 	&& [$w compare sel.last >= insert]
     }
 }
 
 # ::tk::TextInsert --
 # Insert a string into a text at the point of the insertion cursor.
 # If there is a selection in the text, and it covers the point of the
 # insertion cursor, then delete the selection before inserting.
 #
 # Arguments:
 # w -		The text window in which to insert the string
 # s -		The string to insert (usually just a single character)
 
 proc ::tk::TextInsert {w s} {
     if {$s eq "" || [$w cget -state] eq "disabled"} {
 	return
     }
     set compound 0
     if {[TextCursorInSelection $w]} {
 	set oldSeparator [$w cget -autoseparators]
 	if {$oldSeparator} {
 	    $w configure -autoseparators 0
 	    $w edit separator
 	    set compound 1
 	}
 	$w delete sel.first sel.last
     }
     $w insert insert $s
     $w see insert
     if {$compound && $oldSeparator} {
 	$w edit separator
 	$w configure -autoseparators 1
     }
 }
 
 # ::tk::TextUpDownLine --
 # Returns the index of the character one display line above or below the
 # insertion cursor.  There are two tricky things here.  First, we want to
 # maintain the original x position across repeated operations, even though
 # some lines that will get passed through don't have enough characters to
 # cover the original column.  Second, don't try to scroll past the
 # beginning or end of the text.
 #
 # Arguments:
 # w -		The text window in which the cursor is to move.
 # n -		The number of display lines to move: -1 for up one line,
 #		+1 for down one line.
 
 proc ::tk::TextUpDownLine {w n} {
     variable ::tk::Priv
 
     set i [$w index insert]
     if {$Priv(prevPos) ne $i} {
 	set Priv(textPosOrig) $i
     }
     set lines [$w count -displaylines $Priv(textPosOrig) $i]
     set new [$w index \
 	    "$Priv(textPosOrig) + [expr {$lines + $n}] displaylines"]
     if {[$w compare $new == end] \
 	    || [$w compare $new == "insert display linestart"]} {
 	set new $i
     }
     set Priv(prevPos) $new
     return $new
 }
 
 # ::tk::TextPrevPara --
 # Returns the index of the beginning of the paragraph just before a given
 # position in the text (the beginning of a paragraph is the first non-blank
 # character after a blank line).
 #
 # Arguments:
 # w -		The text window in which the cursor is to move.
 # pos -		Position at which to start search.
 
 proc ::tk::TextPrevPara {w pos} {
     set pos [$w index "$pos linestart"]
     while {1} {
 	if {([$w get "$pos - 1 line"] eq "\n" && ([$w get $pos] ne "\n")) \
 		|| $pos eq "1.0"} {
 	    if {[regexp -indices -- {^[ \t]+(.)} \
 		    [$w get $pos "$pos lineend"] -> index]} {
 		set pos [$w index "$pos + [lindex $index 0] chars"]
 	    }
 	    if {[$w compare $pos != insert] || [lindex [split $pos .] 0]==1} {
 		return $pos
 	    }
 	}
 	set pos [$w index "$pos - 1 line"]
     }
 }
 
 # ::tk::TextNextPara --
 # Returns the index of the beginning of the paragraph just after a given
 # position in the text (the beginning of a paragraph is the first non-blank
 # character after a blank line).
 #
 # Arguments:
 # w -		The text window in which the cursor is to move.
 # start -	Position at which to start search.
 
 proc ::tk::TextNextPara {w start} {
     set pos [$w index "$start linestart + 1 line"]
     while {[$w get $pos] ne "\n"} {
 	if {[$w compare $pos == end]} {
 	    return [$w index "end - 1c"]
 	}
 	set pos [$w index "$pos + 1 line"]
     }
     while {[$w get $pos] eq "\n"} {
 	set pos [$w index "$pos + 1 line"]
 	if {[$w compare $pos == end]} {
 	    return [$w index "end - 1c"]
 	}
     }
     if {[regexp -indices -- {^[ \t]+(.)} \
 	    [$w get $pos "$pos lineend"] -> index]} {
 	return [$w index "$pos + [lindex $index 0] chars"]
     }
     return $pos
 }
 
 # ::tk::TextScrollPages --
 # This is a utility procedure used in bindings for moving up and down
 # pages and possibly extending the selection along the way.  It scrolls
 # the view in the widget by the number of pages, and it returns the
 # index of the character that is at the same position in the new view
 # as the insertion cursor used to be in the old view.
 #
 # Arguments:
 # w -		The text window in which the cursor is to move.
 # count -	Number of pages forward to scroll;  may be negative
 #		to scroll backwards.
 
 proc ::tk::TextScrollPages {w count} {
     set bbox [$w bbox insert]
     $w yview scroll $count pages
     if {$bbox eq ""} {
 	return [$w index @[expr {[winfo height $w]/2}],0]
     }
     return [$w index @[lindex $bbox 0],[lindex $bbox 1]]
 }
 
 # ::tk::TextTranspose --
 # This procedure implements the "transpose" function for text widgets.
 # It tranposes the characters on either side of the insertion cursor,
 # unless the cursor is at the end of the line.  In this case it
 # transposes the two characters to the left of the cursor.  In either
 # case, the cursor ends up to the right of the transposed characters.
 #
 # Arguments:
 # w -		Text window in which to transpose.
 
 proc ::tk::TextTranspose w {
     set pos insert
     if {[$w compare $pos != "$pos lineend"]} {
 	set pos [$w index "$pos + 1 char"]
     }
     set new [$w get "$pos - 1 char"][$w get  "$pos - 2 char"]
     if {[$w compare "$pos - 1 char" == 1.0]} {
 	return
     }
     # ensure this is seen as an atomic op to undo
     set autosep [$w cget -autoseparators]
     if {$autosep} {
 	$w configure -autoseparators 0
 	$w edit separator
     }
     $w delete "$pos - 2 char" $pos
     $w insert insert $new
     $w see insert
     if {$autosep} {
 	$w edit separator
 	$w configure -autoseparators $autosep
     }
 }
 
 # ::tk_textCopy --
 # This procedure copies the selection from a text widget into the
 # clipboard.
 #
 # Arguments:
 # w -		Name of a text widget.
 
 proc ::tk_textCopy w {
     if {![catch {set data [$w get sel.first sel.last]}]} {
 	clipboard clear -displayof $w
 	clipboard append -displayof $w $data
     }
 }
 
 # ::tk_textCut --
 # This procedure copies the selection from a text widget into the
 # clipboard, then deletes the selection (if it exists in the given
 # widget).
 #
 # Arguments:
 # w -		Name of a text widget.
 
 proc ::tk_textCut w {
     if {![catch {set data [$w get sel.first sel.last]}]} {
         # make <<Cut>> an atomic operation on the Undo stack,
         # i.e. separate it from other delete operations on either side
 	set oldSeparator [$w cget -autoseparators]
 	if {$oldSeparator} {
 	    $w edit separator
 	}
 	clipboard clear -displayof $w
 	clipboard append -displayof $w $data
 	$w delete sel.first sel.last
 	if {$oldSeparator} {
 	    $w edit separator
 	}
     }
 }
 
 # ::tk_textPaste --
 # This procedure pastes the contents of the clipboard to the insertion
 # point in a text widget.
 #
 # Arguments:
 # w -		Name of a text widget.
 
 proc ::tk_textPaste w {
     if {![catch {::tk::GetSelection $w CLIPBOARD} sel]} {
 	set oldSeparator [$w cget -autoseparators]
 	if {$oldSeparator} {
 	    $w configure -autoseparators 0
 	    $w edit separator
 	}
 	if {[tk windowingsystem] ne "x11"} {
 	    catch { $w delete sel.first sel.last }
 	}
 	$w insert insert $sel
 	if {$oldSeparator} {
 	    $w edit separator
 	    $w configure -autoseparators 1
 	}
     }
 }
 
 # ::tk::TextNextWord --
 # Returns the index of the next word position after a given position in the
 # text.  The next word is platform dependent and may be either the next
 # end-of-word position or the next start-of-word position after the next
 # end-of-word position.
 #
 # Arguments:
 # w -		The text window in which the cursor is to move.
 # start -	Position at which to start search.
 
 if {[tk windowingsystem] eq "win32"}  {
     proc ::tk::TextNextWord {w start} {
 	TextNextPos $w [TextNextPos $w $start tcl_endOfWord] \
 		tcl_startOfNextWord
     }
 } else {
     proc ::tk::TextNextWord {w start} {
 	TextNextPos $w $start tcl_endOfWord
     }
 }
 
 # ::tk::TextNextPos --
 # Returns the index of the next position after the given starting
 # position in the text as computed by a specified function.
 #
 # Arguments:
 # w -		The text window in which the cursor is to move.
 # start -	Position at which to start search.
 # op -		Function to use to find next position.
 
 proc ::tk::TextNextPos {w start op} {
     set text ""
     set cur $start
     while {[$w compare $cur < end]} {
 	set text $text[$w get -displaychars $cur "$cur lineend + 1c"]
 	set pos [$op $text 0]
 	if {$pos >= 0} {
 	    return [$w index "$start + $pos display chars"]
 	}
 	set cur [$w index "$cur lineend +1c"]
     }
     return end
 }
 
 # ::tk::TextPrevPos --
 # Returns the index of the previous position before the given starting
 # position in the text as computed by a specified function.
 #
 # Arguments:
 # w -		The text window in which the cursor is to move.
 # start -	Position at which to start search.
 # op -		Function to use to find next position.
 
 proc ::tk::TextPrevPos {w start op} {
     set text ""
     set cur $start
     while {[$w compare $cur > 0.0]} {
 	set text [$w get -displaychars "$cur linestart - 1c" $cur]$text
 	set pos [$op $text end]
 	if {$pos >= 0} {
 	    return [$w index "$cur linestart - 1c + $pos display chars"]
 	}
 	set cur [$w index "$cur linestart - 1c"]
     }
     return 0.0
 }
 
 # ::tk::TextScanMark --
 #
 # Marks the start of a possible scan drag operation
 #
 # Arguments:
 # w -	The text window from which the text to get
 # x -	x location on screen
 # y -	y location on screen
 
 proc ::tk::TextScanMark {w x y} {
     variable ::tk::Priv
     $w scan mark $x $y
     set Priv(x) $x
     set Priv(y) $y
     set Priv(mouseMoved) 0
 }
 
 # ::tk::TextScanDrag --
 #
 # Marks the start of a possible scan drag operation
 #
 # Arguments:
 # w -	The text window from which the text to get
 # x -	x location on screen
 # y -	y location on screen
 
 proc ::tk::TextScanDrag {w x y} {
     variable ::tk::Priv
     # Make sure these exist, as some weird situations can trigger the
     # motion binding without the initial press.  [Bug #220269]
     if {![info exists Priv(x)]} {
 	set Priv(x) $x
     }
     if {![info exists Priv(y)]} {
 	set Priv(y) $y
     }
     if {($x != $Priv(x)) || ($y != $Priv(y))} {
 	set Priv(mouseMoved) 1
     }
     if {[info exists Priv(mouseMoved)] && $Priv(mouseMoved)} {
 	$w scan dragto $x $y
     }
 }