diff options
Diffstat (limited to 'library/text.tcl')
| -rw-r--r-- | library/text.tcl | 704 |
1 files changed, 389 insertions, 315 deletions
diff --git a/library/text.tcl b/library/text.tcl index 59e395c..cf2c85d 100644 --- a/library/text.tcl +++ b/library/text.tcl @@ -6,11 +6,21 @@ # Copyright (c) 1992-1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. # Copyright (c) 1998 by Scriptics Corporation. +# Copyright (c) 2015-2017 Gregor Cramer # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # +########################################################################## +# TODO: +# Currently we cannot use identifier "begin" for very first index, because +# it has still lowest precedence, and this may clash if the application is +# using this identifier for marks. In a later version of this file all +# occurences of "1.0" should be replaced with "begin", as soon as "begin" +# has highest precedence. +########################################################################## + #------------------------------------------------------------------------- # Elements of ::tk::Priv that are used in this file: # @@ -42,7 +52,7 @@ bind Text <1> { tk::TextButton1 %W %x %y - %W tag remove sel 0.0 end + %W tag remove sel 1.0 end } bind Text <B1-Motion> { set tk::Priv(x) %x @@ -96,10 +106,10 @@ 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 + tk::TextSetCursor %W insert-1displaychars } bind Text <<NextChar>> { - tk::TextSetCursor %W insert+1displayindices + tk::TextSetCursor %W insert+1displaychars } bind Text <<PrevLine>> { tk::TextSetCursor %W [tk::TextUpDownLine %W -1] @@ -108,16 +118,16 @@ bind Text <<NextLine>> { tk::TextSetCursor %W [tk::TextUpDownLine %W 1] } bind Text <<SelectPrevChar>> { - tk::TextKeySelect %W [%W index {insert - 1displayindices}] + tk::TextKeySelect %W [%W index {insert - 1displaychars}] } bind Text <<SelectNextChar>> { - tk::TextKeySelect %W [%W index {insert + 1displayindices}] + tk::TextKeySelect %W [%W index {insert + 1displaychars}] } bind Text <<SelectPrevLine>> { - tk::TextKeySelect %W [tk::TextUpDownLine %W -1] + tk::TextKeySelect %W [tk::TextUpDownLine %W -1 yes] } bind Text <<SelectNextLine>> { - tk::TextKeySelect %W [tk::TextUpDownLine %W 1] + tk::TextKeySelect %W [tk::TextUpDownLine %W 1 yes] } bind Text <<PrevWord>> { tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord] @@ -195,7 +205,7 @@ bind Text <Tab> { } } bind Text <Shift-Tab> { - # Needed only to keep <Tab> binding from triggering; doesn't + # Needed only to keep <Tab> binding from triggering; doesn't # have to actually do anything. break } @@ -209,29 +219,37 @@ bind Text <Control-i> { tk::TextInsert %W \t } bind Text <Return> { - tk::TextInsert %W \n - if {[%W cget -autoseparators]} { - %W edit separator + if {[%W cget -state] eq "normal"} { + 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 + if {[%W cget -state] eq "normal"} { + if {[tk::TextCursorInSelection %W]} { + tk::TextDelete %W sel.first sel.last + } else { + if {[%W compare end != insert+1i]} { + %W delete insert + } + %W see 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 + if {[%W cget -state] eq "normal"} { + if {[tk::TextCursorInSelection %W]} { + tk::TextDelete %W sel.first sel.last + } else { + if {[%W compare insert != 1.0]} { + # ensure that this operation is triggering "watch" + %W mark set insert insert-1i + %W delete insert + } + %W see insert } - %W see insert } } @@ -255,7 +273,7 @@ bind Text <<SelectAll>> { 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 + # because the selection operation may have moved the insert mark. if {[%W cget -autoseparators]} { %W edit separator } @@ -270,24 +288,27 @@ 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 + if {[%W cget -state] eq "normal"} { + # 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 { tk::TextDelete %W 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)} { + 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]} + if {[%W cget -state] eq "normal"} { + catch {tk::TextInsert %W [::tk::GetSelection %W PRIMARY]} + } } bind Text <KeyPress> { tk::TextInsert %W %A @@ -310,12 +331,12 @@ if {[tk windowingsystem] eq "aqua"} { # Additional emacs-like bindings: bind Text <Control-d> { - if {!$tk_strictMotif && [%W compare end != insert+1c]} { + if {[%W cget -state] eq "normal" && !$tk_strictMotif && [%W compare end != insert+1i]} { %W delete insert } } bind Text <Control-k> { - if {!$tk_strictMotif && [%W compare end != insert+1c]} { + if {[%W cget -state] eq "normal" && !$tk_strictMotif && [%W compare end != insert+1i]} { if {[%W compare insert == {insert lineend}]} { %W delete insert } else { @@ -324,9 +345,9 @@ bind Text <Control-k> { } } bind Text <Control-o> { - if {!$tk_strictMotif} { + if {[%W cget -state] eq "normal" && !$tk_strictMotif} { %W insert insert \n - %W mark set insert insert-1c + %W mark set insert insert-1i } } bind Text <Control-t> { @@ -336,20 +357,24 @@ bind Text <Control-t> { } 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 + if {[%W cget -state] eq "normal"} { + # 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 } + if {[%W cget -state] eq "normal"} { + catch { %W edit redo } + } } bind Text <Meta-b> { @@ -358,7 +383,7 @@ bind Text <Meta-b> { } } bind Text <Meta-d> { - if {!$tk_strictMotif && [%W compare end != insert+1c]} { + if {!$tk_strictMotif && [%W compare end != insert+1i]} { %W delete insert [tk::TextNextWord %W insert] } } @@ -374,26 +399,26 @@ bind Text <Meta-less> { } bind Text <Meta-greater> { if {!$tk_strictMotif} { - tk::TextSetCursor %W end-1c + tk::TextSetCursor %W end-1i } } bind Text <Meta-BackSpace> { - if {!$tk_strictMotif} { - %W delete [tk::TextPrevPos %W insert tcl_startOfPreviousWord] insert + if {[%W cget -state] eq "normal" && !$tk_strictMotif} { + tk::TextDelete %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord] insert } } bind Text <Meta-Delete> { - if {!$tk_strictMotif} { - %W delete [tk::TextPrevPos %W insert tcl_startOfPreviousWord] insert + if {[%W cget -state] eq "normal" && !$tk_strictMotif} { + tk::TextDelete %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord] insert } } # Macintosh only bindings: if {[tk windowingsystem] eq "aqua"} { -bind Text <Control-v> { - tk::TextScrollPages %W 1 -} + bind Text <Control-v> { + tk::TextScrollPages %W 1 + } # End of Mac only bindings } @@ -401,8 +426,10 @@ bind Text <Control-v> { # A few additional bindings of my own. bind Text <Control-h> { - if {!$tk_strictMotif && [%W compare insert != 1.0]} { - %W delete insert-1c + if {[%W cget -state] eq "normal" && !$tk_strictMotif && [%W compare insert != 1.0]} { + # ensure that this operation is triggering "watch" + %W mark set insert insert-1i + %W delete insert %W see insert } } @@ -425,16 +452,16 @@ set ::tk::Priv(prevPos) {} if {[tk windowingsystem] eq "aqua"} { bind Text <MouseWheel> { - %W yview scroll [expr {-15 * (%D)}] pixels + %W yview scroll [expr {-15 * (%D)}] pixels } bind Text <Option-MouseWheel> { - %W yview scroll [expr {-150 * (%D)}] pixels + %W yview scroll [expr {-150 * (%D)}] pixels } bind Text <Shift-MouseWheel> { - %W xview scroll [expr {-15 * (%D)}] pixels + %W xview scroll [expr {-15 * (%D)}] pixels } bind Text <Shift-Option-MouseWheel> { - %W xview scroll [expr {-150 * (%D)}] pixels + %W xview scroll [expr {-150 * (%D)}] pixels } } else { # We must make sure that positive and negative movements are rounded @@ -486,6 +513,24 @@ if {"x11" eq [tk windowingsystem]} { } } +# ::tk::TextCursorPos -- +# Given x and y coordinates, this procedure computes the "cursor" +# position, and returns the index of the character at this position. +# +# Arguments: +# w - The text window. +# x - X-coordinate within the window. +# y - Y-coordinate within the window. + +proc ::tk::TextCursorPos {w x y} { + if {[$w cget -blockcursor]} { + # If we have a block cursor, then use the actual x-position + # for cursor position. + return [$w index @$x,$y] + } + return [TextClosestGap $w $x $y] +} + # ::tk::TextClosestGap -- # Given x and y coordinates, this procedure finds the closest boundary # between characters to the given coordinates and returns the index @@ -499,13 +544,13 @@ if {"x11" eq [tk windowingsystem]} { proc ::tk::TextClosestGap {w x y} { set pos [$w index @$x,$y] set bbox [$w bbox $pos] - if {$bbox eq ""} { - return $pos + if {[llength $bbox] == 0} { + return $pos } if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} { - return $pos + return $pos } - $w index "$pos + 1 char" + $w index "$pos + 1i" } # ::tk::TextButton1 -- @@ -519,31 +564,42 @@ proc ::tk::TextClosestGap {w x y} { # 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 + variable Priv + # Catch the very special case with dead peers. + if {![$w isdead]} { + set Priv(selectMode) char + set Priv(mouseMoved) 0 + set Priv(pressX) $x + set pos [TextCursorPos $w $x $y] + set thisLineNo [$w lineno @last,$y] + if {[$w lineno $pos] ne $thisLineNo} { + # The button has been pressed at an x position after last character. + # In this case [$w index @$x,$y] is returning the start of next line, + # but we want the end of this line. + set pos "$thisLineNo.end" + } + $w mark set insert $pos + if {[$w cget -blockcursor]} { + set anchor [TextClosestGap $w $x $y] + } else { + # this is already the closest gap + set anchor insert + } + # Set the anchor mark's gravity depending on the click position + # relative to the gap. + set bbox [$w bbox $anchor] + set gravity [expr {$x > [lindex $bbox 0] ? "right" : "left"}] + $w mark set [TextAnchor $w] $anchor $gravity + if {[$w cget -state] eq "normal" && [$w cget -autoseparators]} { + $w edit separator + } } + # 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"} { + if {[tk windowingsystem] eq "win32" || [$w cget -state] eq "normal"} { focus $w } - if {[$w cget -autoseparators]} { - $w edit separator - } } # ::tk::TextSelectTo -- @@ -555,30 +611,39 @@ proc ::tk::TextButton1 {w x y} { # # 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'. +# text widget (even when there are multiple peers). # # 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)] + # This gives us a private mark, not visible with + # "mark names|next|previous|..". + set Priv(textanchor,$w) [$w mark generate] + # The Tk library still has a big weakness: it's not possible to + # bind variables to a widget, so we use a private command for this + # binding; this means that the variable will be unset automatically + # when the widget will be destroyed. This is the only proper way to + # handle unique identifiers. + $w tk_bindvar [namespace current]::Priv(textanchor,$w) } 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}]} { + variable Priv + if {[$w isdead]} { + # Catch the very special case with dead peers. + return + } + set anchorname [TextAnchor $w] + set cur [TextCursorPos $w $x $y] + if {![$w mark exists $anchorname]} { $w mark set $anchorname $cur } set anchor [$w index $anchorname] @@ -596,24 +661,31 @@ proc ::tk::TextSelectTo {w x y {extend 0}} { } } 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" + set first [$w index @$x,$y] + set isEmbedded [expr {[string length [$w get $first]] == 0}] + if {$isEmbedded} { + # Don't extend the range if we have an embedded item at this position + set last "$first+1i" } 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 + # 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 + 1i" + } else { + set first "$anchorname - 1i" + 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 + 1i" tcl_wordBreakBefore] + set last [TextNextPos $w "$last - 1i" tcl_wordBreakAfter] } - - # 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 @@ -627,12 +699,12 @@ proc ::tk::TextSelectTo {w x y {extend 0}} { set last "$cur lineend" } set first [$w index $first] - set last [$w index "$last + 1c"] + set last [$w index "$last + 1i"] } } if {$Priv(mouseMoved) || ($Priv(selectMode) ne "char")} { - $w tag remove sel 0.0 end $w mark set insert $cur + $w tag remove sel 1.0 $first $w tag add sel $first $last $w tag remove sel $last end update idletasks @@ -649,11 +721,10 @@ proc ::tk::TextSelectTo {w x y {extend 0}} { # index - The point to which the selection is to be extended. proc ::tk::TextKeyExtend {w index} { - - set anchorname [tk::TextAnchor $w] + set anchorname [TextAnchor $w] set cur [$w index $index] - if {[catch {$w index $anchorname}]} { - $w mark set $anchorname $cur + if {![$w mark exists $anchorname]} { + $w mark set $anchorname $cur left } set anchor [$w index $anchorname] if {[$w compare $cur < $anchorname]} { @@ -663,7 +734,7 @@ proc ::tk::TextKeyExtend {w index} { set first $anchorname set last $cur } - $w tag remove sel 0.0 $first + $w tag remove sel 1.0 $first $w tag add sel $first $last $w tag remove sel $last end } @@ -677,18 +748,9 @@ proc ::tk::TextKeyExtend {w index} { # 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"} { + $w mark set insert [TextCursorPos $w $x $y] + TextInsertSelection $w PRIMARY } if {[$w cget -state] eq "normal"} { focus $w @@ -707,7 +769,7 @@ proc ::tk::TextPasteSelection {w x y} { # w - The text window. proc ::tk::TextAutoScan {w} { - variable ::tk::Priv + variable Priv if {![winfo exists $w]} { return } @@ -723,7 +785,7 @@ proc ::tk::TextAutoScan {w} { return } TextSelectTo $w $Priv(x) $Priv(y) - set Priv(afterId) [after 50 [list tk::TextAutoScan $w]] + set Priv(afterId) [after 50 [list ::tk::TextAutoScan $w]] } # ::tk::TextSetCursor @@ -738,7 +800,7 @@ proc ::tk::TextAutoScan {w} { proc ::tk::TextSetCursor {w pos} { if {[$w compare $pos == end]} { - set pos {end - 1 chars} + set pos {end - 1i} } $w mark set insert $pos $w tag remove sel 1.0 end @@ -759,8 +821,12 @@ proc ::tk::TextSetCursor {w pos} { # 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 isdead]} { + # Catch the very special case with dead peers. + return + } + set anchorname [TextAnchor $w] + if {[llength [$w tag nextrange sel 1.0 end]] == 0} { if {[$w compare $new < insert]} { $w tag add sel $new insert } else { @@ -799,14 +865,14 @@ proc ::tk::TextKeySelect {w new} { # which end of selection should be used as anchor point. proc ::tk::TextResetAnchor {w index} { - if {[$w tag ranges sel] eq ""} { + if {[llength [$w tag ranges sel]] == 0} { # 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 anchorname [TextAnchor $w] set a [$w index $index] set b [$w index sel.first] set c [$w index sel.last] @@ -821,7 +887,7 @@ proc ::tk::TextResetAnchor {w index} { scan $a "%d.%d" lineA chA scan $b "%d.%d" lineB chB scan $c "%d.%d" lineC chC - if {$lineB < $lineC+2} { + if {$lineB < $lineC + 2} { set total [string length [$w get $b $c]] if {$total <= 2} { return @@ -833,7 +899,7 @@ proc ::tk::TextResetAnchor {w index} { } return } - if {($lineA-$lineB) < ($lineC-$lineA)} { + if {$lineA - $lineB < $lineC - $lineA} { $w mark set $anchorname sel.last } else { $w mark set $anchorname sel.first @@ -848,8 +914,7 @@ proc ::tk::TextResetAnchor {w index} { # w - The text widget whose selection is to be checked proc ::tk::TextCursorInSelection {w} { - expr { - [llength [$w tag ranges sel]] + expr {[llength [$w tag ranges sel]] && [$w compare sel.first <= insert] && [$w compare sel.last >= insert] } @@ -865,25 +930,20 @@ proc ::tk::TextCursorInSelection {w} { # s - The string to insert (usually just a single character) proc ::tk::TextInsert {w s} { - if {$s eq "" || [$w cget -state] eq "disabled"} { + if {[string length $s] == 0 || [$w cget -state] ne "normal"} { return } - set compound 0 if {[TextCursorInSelection $w]} { - set oldSeparator [$w cget -autoseparators] - if {$oldSeparator} { - $w configure -autoseparators 0 + if {[$w cget -autoseparators]} { $w edit separator - set compound 1 } - $w delete sel.first sel.last + # ensure that this operation is triggering "watch" + $w mark set insert sel.first + $w replace insert sel.last $s + } else { + $w insert insert $s } - $w insert insert $s $w see insert - if {$compound && $oldSeparator} { - $w edit separator - $w configure -autoseparators 1 - } } # ::tk::TextUpDownLine -- @@ -892,25 +952,24 @@ proc ::tk::TextInsert {w s} { # 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. +# beginning or end of the text if we don't select. # # 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. +# sel Boolean value whether we are selecting text. -proc ::tk::TextUpDownLine {w n} { - variable ::tk::Priv +proc ::tk::TextUpDownLine {w n {sel no}} { + variable 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 [$w index "$Priv(textPosOrig) + [expr {$lines + $n}] displaylines"] + if {!$sel && ([$w compare $new == end] || [$w compare $new == "insert display linestart"])} { set new $i } set Priv(prevPos) $new @@ -929,17 +988,16 @@ proc ::tk::TextUpDownLine {w n} { 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 newPos [$w index "$pos - 1 line"] + if {([$w get $newPos] eq "\n" && ([$w get $pos] ne "\n")) || [$w compare $pos == 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} { + if {[$w compare $pos != insert] || [$w compare [$w index "$pos linestart"] == 1.0]} { return $pos } } - set pos [$w index "$pos - 1 line"] + set pos $newPos } } @@ -956,18 +1014,17 @@ 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"] + return [$w index "end - 1i"] } 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"] + return [$w index "end - 1i"] } } - if {[regexp -indices -- {^[ \t]+(.)} \ - [$w get $pos "$pos lineend"] -> index]} { + if {[regexp -indices -- {^[ \t]+(.)} [$w get $pos "$pos lineend"] -> index]} { return [$w index "$pos + [lindex $index 0] chars"] } return $pos @@ -988,7 +1045,7 @@ proc ::tk::TextNextPara {w start} { proc ::tk::TextScrollPages {w count} { set bbox [$w bbox insert] $w yview scroll $count pages - if {$bbox eq ""} { + if {[llength $bbox] == 0} { return [$w index @[expr {[winfo height $w]/2}],0] } return [$w index @[lindex $bbox 0],[lindex $bbox 1]] @@ -1005,27 +1062,21 @@ proc ::tk::TextScrollPages {w count} { # 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]} { + if {[$w cget -state] ne "normal" || [$w compare insert == 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 + set pos insert + if {[$w compare insert != "insert lineend"]} { + append pos +1i + } + set pos [$w index $pos] + # ensure that this operation is triggering "watch" + set insPos [$w index insert] + $w mark set insert ${pos}-2c + set new [$w get insert+1i][$w get insert] + $w replace insert $pos $new + $w mark set insert $insPos $w see insert - if {$autosep} { - $w edit separator - $w configure -autoseparators $autosep - } } # ::tk_textCopy -- @@ -1052,16 +1103,17 @@ proc ::tk_textCopy w { 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} { + # make <<Cut>> 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 } clipboard clear -displayof $w clipboard append -displayof $w $data - $w delete sel.first sel.last - if {$oldSeparator} { + if {[$w cget -state] eq "normal"} { + ::tk::TextDelete $w sel.first sel.last + } + if {[$w cget -autoseparators]} { $w edit separator } } @@ -1075,20 +1127,8 @@ proc ::tk_textCut w { # 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 - } + if {[$w cget -state] eq "normal"} { + ::tk::TextInsertSelection $w CLIPBOARD } } @@ -1104,8 +1144,7 @@ proc ::tk_textPaste w { if {[tk windowingsystem] eq "win32"} { proc ::tk::TextNextWord {w start} { - TextNextPos $w [TextNextPos $w $start tcl_endOfWord] \ - tcl_startOfNextWord + TextNextPos $w [TextNextPos $w $start tcl_endOfWord] tcl_startOfNextWord } } else { proc ::tk::TextNextWord {w start} { @@ -1126,12 +1165,13 @@ 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 end [$w index "$cur lineend + 1i"] + append text [$w get -displaychars $cur $end] set pos [$op $text 0] if {$pos >= 0} { return [$w index "$start + $pos display chars"] } - set cur [$w index "$cur lineend +1c"] + set cur $end } return end } @@ -1147,16 +1187,18 @@ proc ::tk::TextNextPos {w start op} { proc ::tk::TextPrevPos {w start op} { set text "" + set succ "" set cur $start - while {[$w compare $cur > 0.0]} { - set text [$w get -displaychars "$cur linestart - 1c" $cur]$text + while {[$w compare $cur > 1.0]} { + append text [$w get -displaychars "$cur linestart - 1i" $cur] $succ set pos [$op $text end] if {$pos >= 0} { - return [$w index "$cur linestart - 1c + $pos display chars"] + return [$w index "$cur linestart - 1i + $pos display chars"] } - set cur [$w index "$cur linestart - 1c"] + set cur [$w index "$cur linestart - 1i"] + set succ $text } - return 0.0 + return 1.0 } # ::tk::TextScanMark -- @@ -1169,7 +1211,7 @@ proc ::tk::TextPrevPos {w start op} { # y - y location on screen proc ::tk::TextScanMark {w x y} { - variable ::tk::Priv + variable Priv $w scan mark $x $y set Priv(x) $x set Priv(y) $y @@ -1186,7 +1228,7 @@ proc ::tk::TextScanMark {w x y} { # y - y location on screen proc ::tk::TextScanDrag {w x y} { - variable ::tk::Priv + variable 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)]} { @@ -1195,7 +1237,7 @@ proc ::tk::TextScanDrag {w x y} { if {![info exists Priv(y)]} { set Priv(y) $y } - if {($x != $Priv(x)) || ($y != $Priv(y))} { + if {$x != $Priv(x) || $y != $Priv(y)} { set Priv(mouseMoved) 1 } if {[info exists Priv(mouseMoved)] && $Priv(mouseMoved)} { @@ -1203,98 +1245,130 @@ proc ::tk::TextScanDrag {w x y} { } } -# ::tk::TextUndoRedoProcessMarks -- +# ::tk::TextDelete -- # -# This proc is executed after an undo or redo action. -# It processes the list of undo/redo marks temporarily set in the -# text widget to positions delimiting where changes happened, and -# returns a flat list of ranges. The temporary marks are removed -# from the text widget. +# Delete the characters in given range. +# Ensure that "watch" will be triggered, and consider +# that "insert" may be involved in the given range. +# This implementation avoids unnecessary mappings of indices. + +proc ::tk::TextDelete {w start end} { + # Remember old positions, use temporary marks ('mark generate'), + # take into account that $end may refer "insert" mark. + $w mark set [set insPos [$w mark generate]] insert + $w mark set [set endPos [$w mark generate]] $end + $w mark set insert $start + $w delete insert $endPos + $w mark set insert $insPos + $w mark unset $insPos + $w mark unset $endPos +} + +# ::tk::TextInsertSelection -- +# This procedure inserts the selection. # # Arguments: -# w - The text widget - -proc ::tk::TextUndoRedoProcessMarks {w} { - set indices {} - set undoMarks {} - - # only consider the temporary marks set by an undo/redo action - foreach mark [$w mark names] { - if {[string range $mark 0 11] eq "tk::undoMark"} { - lappend undoMarks $mark - } - } - - # transform marks into indices - # the number of undo/redo marks is always even, each right mark - # completes a left mark to give a range - # this is true because: - # - undo/redo only deals with insertions and deletions of text - # - insertions may move marks but not delete them - # - when deleting text, marks located inside the deleted range - # are not erased but moved to the start of the deletion range - # . this is done in TkBTreeDeleteIndexRange ("This segment - # refuses to die...") - # . because MarkDeleteProc does nothing else than returning - # a value indicating that marks are not deleted by this - # deleteProc - # . mark deletion rather happen through [.text mark unset xxx] - # which was not used _up to this point of the code_ (it - # is a bit later just before exiting the present proc) - set nUndoMarks [llength $undoMarks] - set n [expr {$nUndoMarks / 2}] - set undoMarks [lsort -dictionary $undoMarks] - set Lmarks [lrange $undoMarks 0 [expr {$n - 1}]] - set Rmarks [lrange $undoMarks $n [llength $undoMarks]] - foreach Lmark $Lmarks Rmark $Rmarks { - lappend indices [$w index $Lmark] [$w index $Rmark] - $w mark unset $Lmark $Rmark - } - - # process ranges to: - # - remove those already fully included in another range - # - merge overlapping ranges - set ind [lsort -dictionary -stride 2 $indices] - set indices {} - - for {set i 0} {$i < $nUndoMarks} {incr i 2} { - set il1 [lindex $ind $i] - set ir1 [lindex $ind [expr {$i + 1}]] - lappend indices $il1 $ir1 - - for {set j [expr {$i + 2}]} {$j < $nUndoMarks} {incr j 2} { - set il2 [lindex $ind $j] - set ir2 [lindex $ind [expr {$j + 1}]] - - if {[$w compare $il2 > $ir1]} { - # second range starts after the end of first range - # -> further second ranges do not need to be considered - # because ranges were sorted by increasing first index - set j $nUndoMarks - - } else { - if {[$w compare $ir2 > $ir1]} { - # second range overlaps first range - # -> merge them into a single range - set indices [lreplace $indices end-1 end] - lappend indices $il1 $ir2 - - } else { - # second range is fully included in first range - # -> ignore it - - } - # in both cases above, the second range shall be - # trimmed out from the list of ranges - set ind [lreplace $ind $j [expr {$j + 1}]] - incr j -2 - incr nUndoMarks -2 - - } - - } - - } - - return $indices +# w - The text window. +# x, y - Position of the mouse. +# selection atom name of the selection + +proc ::tk::TextInsertSelection {w selection} { + if {[catch {GetSelection $w $selection} sel]} { + return + } + set oldSeparator [$w cget -autoseparators] + if {$oldSeparator} { + $w configure -autoseparators 0 + $w edit separator + } + if {$selection eq "CLIPBOARD" && [tk windowingsystem] ne "x11"} { + catch { TextDelete $w sel.first sel.last } + } + $w insert insert $sel + if {$oldSeparator} { + $w edit separator + $w configure -autoseparators 1 + } +} + +# ::tk_textInsert -- +# This procedure supports the insertion of text with hyphen information. +# +# Arguments: +# w - The text window. +# args - Arguments for text insertion. + +proc ::tk_textInsert {w args} { + # Use an internal command: + uplevel [list $w tk_textInsert {*}$args] } + +# ::tk_textReplace -- +# This procedure supports the replacement of text with hyphen information. +# +# Arguments: +# w - The text window. +# args - Arguments for text insertion. + +proc ::tk_textReplace {w args} { + # Use an internal command: + uplevel [list $w tk_textReplace {*}$args] +} + +# ::tk_mergeRange -- +# This procedure is merging a range into a sorted list of ranges. +# If given range is adjacent to, or intersecting a range in given +# list, then it will be amalgamated. +# +# Arguments: +# rangeListVar - Name of variable containing the list of ranges. +# newRange - New range which should be merged into given list. + +proc tk_mergeRange {rangeListVar newRange} { + upvar $rangeListVar ranges + + if {![info exists ranges]} { + lappend ranges $newRange + return $ranges + } + + lassign $newRange s e + lassign [split $s .] sline scol + lassign [split $e .] eline ecol + set newRangeList {} + set n [llength $ranges] + + for {set i 0} {$i < $n} {incr i} { + set range [lindex $ranges $i] + lassign $range s1 e1 + lassign [split $s1 .] sline1 scol1 + lassign [split $e1 .] eline1 ecol1 + + # [$w compare "$e+1i" < $s1] + if {$eline < $sline1 || ($eline == $sline1 && $ecol + 1 < $scol1)} { + lappend newRangeList [list $s $e] + lappend newRangeList {*}[lrange $ranges $i end] + set ranges $newRangeList + return $newRangeList + } + # [$w compare $s <= "$e1+1i"] + if {$sline < $eline1 || ($sline == $eline1 && $scol <= $ecol1 + 1)} { + # [$w compare $s > $s1] + if {$sline > $sline1 || ($sline == $sline1 && $scol > $scol1)} { + set s $s1; set sline $sline1; set scol $scol1 + } + # [$w compare $e < $e1] + if {$eline < $eline1 || ($eline == $eline1 && $ecol < $ecol1)} { + set e $e1; set eline $eline1; set ecol $ecol1 + } + } else { + lappend newRangeList $range + } + } + + lappend newRangeList [list $s $e] + set ranges $newRangeList + return $newRangeList +} + +# vi:set ts=8 sw=4: |