1 files changed, 96 insertions, 0 deletions
diff --git a/library/text.tcl b/library/text.tcl
index 2bf1b2b..59e395c 100644
--- a/library/text.tcl
+++ b/library/text.tcl
@@ -1202,3 +1202,99 @@ 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]
+    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
+}