diff options
author | William Joye <wjoye@cfa.harvard.edu> | 2018-12-25 19:55:50 (GMT) |
---|---|---|
committer | William Joye <wjoye@cfa.harvard.edu> | 2018-12-25 19:55:50 (GMT) |
commit | ff51550ee89b473c63df78de6b2a413f21105687 (patch) | |
tree | bcdca927ed2a7b05c647b9a6bfdfd4a7ca5c730e /tk8.6/library/text.tcl | |
parent | 01cbf5b15ea760408c24288ccb5cf8e0af9aa299 (diff) | |
download | blt-ff51550ee89b473c63df78de6b2a413f21105687.zip blt-ff51550ee89b473c63df78de6b2a413f21105687.tar.gz blt-ff51550ee89b473c63df78de6b2a413f21105687.tar.bz2 |
update tcl/tk
Diffstat (limited to 'tk8.6/library/text.tcl')
-rw-r--r-- | tk8.6/library/text.tcl | 1207 |
1 files changed, 0 insertions, 1207 deletions
diff --git a/tk8.6/library/text.tcl b/tk8.6/library/text.tcl deleted file mode 100644 index 468696b..0000000 --- a/tk8.6/library/text.tcl +++ /dev/null @@ -1,1207 +0,0 @@ -# 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 {([$w cget -state] eq "normal") && $oldSeparator} { - $w edit separator - } - clipboard clear -displayof $w - clipboard append -displayof $w $data - $w delete sel.first sel.last - if {([$w cget -state] eq "normal") && $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 - } -} |