diff options
Diffstat (limited to 'library/text.tcl')
| -rw-r--r-- | library/text.tcl | 317 |
1 files changed, 185 insertions, 132 deletions
diff --git a/library/text.tcl b/library/text.tcl index 60eab41..37aa387 100644 --- a/library/text.tcl +++ b/library/text.tcl @@ -3,9 +3,9 @@ # 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. +# Copyright © 1992-1994 The Regents of the University of California. +# Copyright © 1994-1997 Sun Microsystems, Inc. +# Copyright © 1998 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -42,7 +42,7 @@ # Standard Motif bindings: -bind Text <1> { +bind Text <Button-1> { tk::TextButton1 %W %x %y %W tag remove sel 0.0 end } @@ -51,26 +51,26 @@ bind Text <B1-Motion> { set tk::Priv(y) %y tk::TextSelectTo %W %x %y } -bind Text <Double-1> { +bind Text <Double-Button-1> { set tk::Priv(selectMode) word tk::TextSelectTo %W %x %y catch {%W mark set insert sel.first} } -bind Text <Triple-1> { +bind Text <Triple-Button-1> { set tk::Priv(selectMode) line tk::TextSelectTo %W %x %y catch {%W mark set insert sel.first} } -bind Text <Shift-1> { +bind Text <Shift-Button-1> { tk::TextResetAnchor %W @%x,%y set tk::Priv(selectMode) char tk::TextSelectTo %W %x %y } -bind Text <Double-Shift-1> { +bind Text <Double-Shift-Button-1> { set tk::Priv(selectMode) word tk::TextSelectTo %W %x %y 1 } -bind Text <Triple-Shift-1> { +bind Text <Triple-Shift-Button-1> { set tk::Priv(selectMode) line tk::TextSelectTo %W %x %y } @@ -86,7 +86,7 @@ bind Text <ButtonRelease-1> { tk::CancelRepeat } -bind Text <Control-1> { +bind Text <Control-Button-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 @@ -95,14 +95,14 @@ bind Text <Control-1> { } } # stop an accidental double click triggering <Double-Button-1> -bind Text <Double-Control-1> { # nothing } +bind Text <Double-Control-Button-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 [tk::TextPrevPos %W insert tk::startOfCluster] } bind Text <<NextChar>> { - tk::TextSetCursor %W insert+1displayindices + tk::TextSetCursor %W [tk::TextNextPos %W insert tk::endOfCluster] } bind Text <<PrevLine>> { tk::TextSetCursor %W [tk::TextUpDownLine %W -1] @@ -111,10 +111,10 @@ bind Text <<NextLine>> { tk::TextSetCursor %W [tk::TextUpDownLine %W 1] } bind Text <<SelectPrevChar>> { - tk::TextKeySelect %W [%W index {insert - 1displayindices}] + tk::TextKeySelect %W [tk::TextPrevPos %W insert tk::startOfCluster] } bind Text <<SelectNextChar>> { - tk::TextKeySelect %W [%W index {insert + 1displayindices}] + tk::TextKeySelect %W [tk::TextNextPos %W insert tk::endOfCluster] } bind Text <<SelectPrevLine>> { tk::TextKeySelect %W [tk::TextUpDownLine %W -1] @@ -123,7 +123,7 @@ bind Text <<SelectNextLine>> { tk::TextKeySelect %W [tk::TextUpDownLine %W 1] } bind Text <<PrevWord>> { - tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord] + tk::TextSetCursor %W [tk::TextPrevPos %W insert tk::startOfPreviousWord] } bind Text <<NextWord>> { tk::TextSetCursor %W [tk::TextNextWord %W insert] @@ -135,10 +135,10 @@ bind Text <<NextPara>> { tk::TextSetCursor %W [tk::TextNextPara %W insert] } bind Text <<SelectPrevWord>> { - tk::TextKeySelect %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord] + tk::TextKeySelect %W [tk::TextPrevPos %W insert tk::startOfPreviousWord] } bind Text <<SelectNextWord>> { - tk::TextKeySelect %W [tk::TextNextWord %W insert] + tk::TextKeySelect %W [tk::TextSelectNextWord %W insert] } bind Text <<SelectPrevPara>> { tk::TextKeySelect %W [tk::TextPrevPara %W insert] @@ -222,7 +222,8 @@ bind Text <Delete> { %W delete sel.first sel.last } else { if {[%W compare end != insert+1c]} { - %W delete insert + %W delete [tk::TextPrevPos %W insert+1c tk::startOfCluster] \ + [tk::TextNextPos %W insert tk::endOfCluster] } %W see insert } @@ -232,7 +233,8 @@ bind Text <BackSpace> { %W delete sel.first sel.last } else { if {[%W compare insert != 1.0]} { - %W delete insert-1c + %W delete [tk::TextPrevPos %W insert tk::startOfCluster] \ + [tk::TextNextPos %W insert-1c tk::endOfCluster] } %W see insert } @@ -296,7 +298,7 @@ bind Text <Key> { tk::TextInsert %W %A } -# Ignore all Alt, Meta, and Control keypresses unless explicitly bound. +# Ignore all Alt, Meta, Control, Command, and Fn keypresses unless explicitly bound. # Otherwise, if a widget binding for one of these is defined, the # <Key> class binding will also fire and insert the character, # which is wrong. Ditto for <Escape>. @@ -306,10 +308,8 @@ bind Text <Meta-Key> {# nothing} bind Text <Control-Key> {# nothing} bind Text <Escape> {# nothing} bind Text <KP_Enter> {# nothing} -if {[tk windowingsystem] eq "aqua"} { - bind Text <Command-Key> {# nothing} - bind Text <Mod4-Key> {# nothing} -} +bind Text <Command-Key> {# nothing} +bind Text <Fn-Key> {# nothing} # Additional emacs-like bindings: @@ -358,7 +358,7 @@ bind Text <<Redo>> { bind Text <Meta-b> { if {!$tk_strictMotif} { - tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord] + tk::TextSetCursor %W [tk::TextPrevPos %W insert tk::startOfPreviousWord] } } bind Text <Meta-d> { @@ -383,12 +383,12 @@ bind Text <Meta-greater> { } bind Text <Meta-BackSpace> { if {!$tk_strictMotif} { - %W delete [tk::TextPrevPos %W insert tcl_startOfPreviousWord] insert + %W delete [tk::TextPrevPos %W insert tk::startOfPreviousWord] insert } } bind Text <Meta-Delete> { if {!$tk_strictMotif} { - %W delete [tk::TextPrevPos %W insert tcl_startOfPreviousWord] insert + %W delete [tk::TextPrevPos %W insert tk::startOfPreviousWord] insert } } @@ -398,12 +398,7 @@ bind Text <<TkStartIMEMarkedText>> { dict set ::tk::Priv(IMETextMark) "%W" [%W index insert] } bind Text <<TkEndIMEMarkedText>> { - if { [catch {dict get $::tk::Priv(IMETextMark) "%W"} mark] } { - bell - } else { - %W tag add IMEmarkedtext $mark insert - %W tag configure IMEmarkedtext -underline on - } + ::tk::TextEndIMEMarkedText %W } bind Text <<TkClearIMEMarkedText>> { %W delete IMEmarkedtext.first IMEmarkedtext.last @@ -412,6 +407,25 @@ bind Text <<TkAccentBackspace>> { %W delete insert-1c } +# ::tk::TextEndIMEMarkedText -- +# +# Handles input method text marking in a text widget. +# +# Arguments: +# w - The text widget + +proc ::tk::TextEndIMEMarkedText {w} { + variable Priv + if {[catch { + set mark [dict get $Priv(IMETextMark) $w] + }]} { + bell + return + } + $w tag add IMEmarkedtext $mark insert + $w tag configure IMEmarkedtext -underline 1 +} + # Macintosh only bindings: if {[tk windowingsystem] eq "aqua"} { @@ -430,96 +444,37 @@ bind Text <Control-h> { %W see insert } } -if {[tk windowingsystem] ne "aqua"} { - bind Text <2> { - if {!$tk_strictMotif} { - tk::TextScanMark %W %x %y - } - } - bind Text <B2-Motion> { - if {!$tk_strictMotif} { - tk::TextScanDrag %W %x %y - } - } -} else { - bind Text <3> { - if {!$tk_strictMotif} { - tk::TextScanMark %W %x %y - } +bind Text <Button-2> { + if {!$tk_strictMotif} { + tk::TextScanMark %W %x %y } - bind Text <B3-Motion> { - if {!$tk_strictMotif} { - tk::TextScanDrag %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 - } - } +bind Text <MouseWheel> { + tk::MouseWheel %W y [tk::ScaleNum %D] -4.0 pixels } - -if {[tk windowingsystem] eq "x11"} { - # 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: - # https://linuxreviews.org/HOWTO_change_the_mouse_speed_in_X - bind Text <4> { - if {!$tk_strictMotif} { - %W yview scroll -50 pixels - } - } - bind Text <5> { - if {!$tk_strictMotif} { - %W yview scroll 50 pixels - } +bind Text <Option-MouseWheel> { + tk::MouseWheel %W y [tk::ScaleNum %D] -1.2 pixels +} +bind Text <Shift-MouseWheel> { + tk::MouseWheel %W x [tk::ScaleNum %D] -4.0 pixels +} +bind Text <Shift-Option-MouseWheel> { + tk::MouseWheel %W x [tk::ScaleNum %D] -1.2 pixels +} +bind Text <TouchpadScroll> { + lassign [tk::PreciseScrollDeltas %D] tk::Priv(deltaX) tk::Priv(deltaY) + if {$tk::Priv(deltaX) != 0} { + %W xview scroll [tk::ScaleNum [expr {-$tk::Priv(deltaX)}]] 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 - } + if {$tk::Priv(deltaY) != 0} { + %W yview scroll [tk::ScaleNum [expr {-$tk::Priv(deltaY)}]] pixels } } @@ -648,8 +603,8 @@ proc ::tk::TextSelectTo {w x y {extend 0}} { } # Now find word boundaries - set first [TextPrevPos $w "$first + 1c" tcl_wordBreakBefore] - set last [TextNextPos $w "$last - 1c" tcl_wordBreakAfter] + set first [TextPrevPos $w "$first + 1c" tk::wordBreakBefore] + set last [TextNextPos $w "$last - 1c" tk::wordBreakAfter] } line { # Set initial range based only on the anchor @@ -1131,26 +1086,31 @@ proc ::tk_textPaste w { } # ::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. +# Returns the index of the next start-of-word position after the next +# end-of-word position after a given position in the text. # # 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 - } +proc ::tk::TextNextWord {w start} { + TextNextPos $w [TextNextPos $w $start tk::endOfWord] \ + tk::startOfNextWord } +# ::tk::TextSelectNextWord -- +# Returns the index of the next end-of-word position after a given +# position in the text. +# +# Arguments: +# w - The text window in which the cursor is to move. +# start - Position at which to start search. + +proc ::tk::TextSelectNextWord {w start} { + TextNextPos $w $start tk::endOfWord +} + + # ::tk::TextNextPos -- # Returns the index of the next position after the given starting # position in the text as computed by a specified function. @@ -1240,3 +1200,96 @@ proc ::tk::TextScanDrag {w x y} { $w scan dragto $x $y } } +# ::tk::TextUndoRedoProcessMarks -- +# +# 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. +# +# 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] + if {$n > 0} { + set Lmarks [lrange $undoMarks 0 [expr {$n - 1}]] + } else { + set Lmarks {} + } + 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 +} |