bug#17235: Undo in region adjusts past positions incorrectly

[Barry OReilly <gundaetiapo@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 1776 bytes --]

> While looking at that code, can you make that "make-selective-list"
> skip redo entries (depending on undo-no-redo, obviously), using the
> undo-equiv-table?

IOW bug 16411? The reason I was looking at this code was because of
that bug. I plan to return to it soon and put my proposition there
into code.

> I think the algorithm would be simpler to make correct if
> adjustments are applied forward chronologically rather than
> backwards. That is, the algorithm keeps a list of undo-deltas that
> grows as the algorithm iterates backwards through undo history. As
> it does so, the positions are adjusted chronologically forward
> through the undo-deltas. This approach is O(N**2), as the current
> algorithm also is, but the bright side is the proposed algorithm
> lends itself to short circuiting better than the current.

I attached the patch implementing this. The new
undo-test-region-deletion test implements the recipe of this bug
report. It fails with the current undo-make-selective-list code,
passes with the new.

Do you recall why the code ceases to make the selective list when an
element cross the region? I did not think of a good reason so I
dropped that behavior in favor of deeming the element out of region
and continuing.

I also attached undo-play.el which I used to benchmark
undo-make-selective-list. It basically fills up undo history with
small edits and then undos in region of an element on the verge of
truncation. The old undo-make-selective-list is about 213ms and the
new is 72ms.

Since the new code performs better, I didn't make the list lazy. If I
did, it would have been as a closure that returns the next element
with adjusted positions, or possibly the next change group. I may yet
do that as a part of bug 16411, as discussed there.

[-- Attachment #2: undo-in-region.diff --]
[-- Type: text/plain, Size: 13572 bytes --]

diff --git a/lisp/simple.el b/lisp/simple.el
index 0af1526..0d30ca9 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -2360,91 +2360,111 @@ are ignored.  If BEG and END are nil, all undo elements are used."
 	    (undo-make-selective-list (min beg end) (max beg end))
 	  buffer-undo-list)))
 
+;; The positions given in elements of the undo list are the positions
+;; as of the time that element was recorded to undo history. In
+;; general, subsequent buffer edits render those positions invalid in
+;; the current buffer, unless adjusted according to the intervening
+;; undo elements.
+;;
+;; Undo in region is a use case that requires adjustments to undo
+;; elements. It must adjust positions of elements in the region based
+;; on newer elements not in the region so as they may be correctly
+;; applied in the current buffer. undo-make-selective-list
+;; accomplishes this with its undo-deltas list of adjustments. An
+;; example undo history from oldest to newest:
+;;
+;; buf pos:
+;; 123456789 buffer-undo-list  undo-deltas
+;; --------- ----------------  -----------
+;; aaa       (1 . 4)           (1 . -3)
+;; aaba      (3 . 4)           N/A (in region)
+;; ccaaba    (1 . 3)           (1 . -2)
+;; ccaabaddd (7 . 10)          (7 . -3)
+;; ccaabdd   ("ad" . 6)        (6 . 2)
+;; ccaabaddd (6 . 8)           (6 . -2)
+;;  |   |<-- region: "caab", from 2 to 6
+;;
+;; When the user starts a run of undos in region,
+;; undo-make-selective-list is called to create the full list of in
+;; region elements. Each element is adjusted forward chronologically
+;; through undo-deltas to determine if it is in the region.
+;;
+;; In the above example, the insertion of "b" is (3 . 4) in the
+;; buffer-undo-list. The undo-delta (1 . -2) causes (3 . 4) to become
+;; (5 . 6). The next three undo-deltas cause no adjustment, so (5 . 6)
+;; is assessed as in the region and placed in the selective
+;; list. Notably, the end of region itself adjusts from "2 to 6" to "2
+;; to 5" due to the selected element. The "b" insertion is the only
+;; element fully in the region, so in this example
+;; undo-make-selective-list returns (nil (5 . 6)).
+;;
+;; The adjustment of the (7 . 10) insertion of "ddd" shows an edge
+;; case. Normally an undo-delta of (6 . 2) would cause positions after
+;; 6 to adjust by 2. However, they shouldn't adjust to less than 6, so
+;; (7 . 10) adjusts to (6 . 8) due to this particular undo delta.
+;;
+;; More interesting is how to adjust the "ddd" insertion due to the
+;; next undo-delta: (6 . -2). If the reinsertion of "ad" was an undo,
+;; it is most sensical that the total "ddd" insertion adjustment be (7
+;; . 10) -> (6 . 8) -> (7 . 10). However, if the reinsertion was a
+;; normal user edit, then most sensical is: (7 . 10) -> (6 . 8) -> (8
+;; . 10). The undo history is ambiguous about which.
+;;
+;; undo-make-selective-list assumes in this situation that "ad" was a
+;; new edit. This means the undo system considers there to be a
+;; deleted "ad" at position 8 of buffer content "ccaabaddd". If the
+;; user undos in region "7 to 9", they could be surprised to get
+;; buffer content: "ccaabadaddd" . This is a FIXME. Bug 16411
+;; describes the possibility of undo elements referencing what they
+;; undid, and so resolving the problematic ambiguity.
+
 (defun undo-make-selective-list (start end)
   "Return a list of undo elements for the region START to END.
-The elements come from `buffer-undo-list', but we keep only
-the elements inside this region, and discard those outside this region.
-If we find an element that crosses an edge of this region,
-we stop and ignore all further elements."
-  (let ((undo-list-copy (undo-copy-list buffer-undo-list))
-	(undo-list (list nil))
-	some-rejected
-	undo-elt temp-undo-list delta)
-    (while undo-list-copy
-      (setq undo-elt (car undo-list-copy))
-      (let ((keep-this
-	     (cond ((and (consp undo-elt) (eq (car undo-elt) t))
-		    ;; This is a "was unmodified" element.
-		    ;; Keep it if we have kept everything thus far.
-		    (not some-rejected))
-                   ;; Skip over marker adjustments, instead relying on
-                   ;; finding them after (TEXT . POS) elements
-                   ((markerp (car-safe undo-elt))
-                    nil)
-		   (t
-		    (undo-elt-in-region undo-elt start end)))))
-	(if keep-this
-	    (progn
-	      (setq end (+ end (cdr (undo-delta undo-elt))))
-	      ;; Don't put two nils together in the list
-	      (when (not (and (eq (car undo-list) nil)
-                              (eq undo-elt nil)))
-                (setq undo-list (cons undo-elt undo-list))
-                ;; If (TEXT . POS), "keep" its subsequent (MARKER
-                ;; . ADJUSTMENT) whose markers haven't moved.
-                (when (and (stringp (car-safe undo-elt))
-                           (integerp (cdr-safe undo-elt)))
-                  (let ((list-i (cdr undo-list-copy)))
+The elements come from `buffer-undo-list', but we keep only the
+elements inside this region, and discard those outside this
+region. The elements' positions are adjusted so as the returned
+list can be applied to the current buffer."
+  (let ((ulist buffer-undo-list)
+        ;; A list of position adjusted undo elements in the region.
+        (selective-list (list nil))
+        ;; A list of undo-deltas for out of region undo elements.
+        undo-deltas
+        undo-elt)
+    (while ulist
+      (setq undo-elt (car ulist))
+      (cond
+       ((null undo-elt)
+        ;; Don't put two nils together in the list
+        (when (car selective-list)
+          (push nil selective-list)))
+       ((and (consp undo-elt) (eq (car undo-elt) t))
+        ;; This is a "was unmodified" element.  Keep it
+        ;; if we have kept everything thus far.
+        (when (not undo-deltas)
+          (push undo-elt selective-list)))
+       ;; Skip over marker adjustments, instead relying
+       ;; on finding them after (TEXT . POS) elements
+       ((markerp (car-safe undo-elt))
+        nil)
+       (t
+        (let ((adjusted-undo-elt (undo-adjust-elt undo-elt
+                                                  undo-deltas)))
+          (if (undo-elt-in-region adjusted-undo-elt start end)
+              (progn
+                (setq end (+ end (cdr (undo-delta adjusted-undo-elt))))
+                (push adjusted-undo-elt selective-list)
+                ;; Keep (MARKER . ADJUSTMENT) if their (TEXT . POS) was
+                ;; kept. primitive-undo may discard them later.
+                (when (and (stringp (car-safe adjusted-undo-elt))
+                           (integerp (cdr-safe adjusted-undo-elt)))
+                  (let ((list-i (cdr ulist)))
                     (while (markerp (car-safe (car list-i)))
-                      (let* ((adj-elt (pop list-i))
-                             (m (car adj-elt)))
-                        (and (eq (marker-buffer m) (current-buffer))
-                             (= (cdr undo-elt) m)
-                             (push adj-elt undo-list))))))))
-	  (if (undo-elt-crosses-region undo-elt start end)
-	      (setq undo-list-copy nil)
-	    (setq some-rejected t)
-	    (setq temp-undo-list (cdr undo-list-copy))
-	    (setq delta (undo-delta undo-elt))
-
-	    (when (/= (cdr delta) 0)
-	      (let ((position (car delta))
-		    (offset (cdr delta)))
-
-		;; Loop down the earlier events adjusting their buffer
-		;; positions to reflect the fact that a change to the buffer
-		;; isn't being undone. We only need to process those element
-		;; types which undo-elt-in-region will return as being in
-		;; the region since only those types can ever get into the
-		;; output
-
-		(while temp-undo-list
-		  (setq undo-elt (car temp-undo-list))
-		  (cond ((integerp undo-elt)
-			 (if (>= undo-elt position)
-			     (setcar temp-undo-list (- undo-elt offset))))
-			((atom undo-elt) nil)
-			((stringp (car undo-elt))
-			 ;; (TEXT . POSITION)
-			 (let ((text-pos (abs (cdr undo-elt)))
-			       (point-at-end (< (cdr undo-elt) 0 )))
-			   (if (>= text-pos position)
-			       (setcdr undo-elt (* (if point-at-end -1 1)
-						   (- text-pos offset))))))
-			((integerp (car undo-elt))
-			 ;; (BEGIN . END)
-			 (when (>= (car undo-elt) position)
-			   (setcar undo-elt (- (car undo-elt) offset))
-			   (setcdr undo-elt (- (cdr undo-elt) offset))))
-			((null (car undo-elt))
-			 ;; (nil PROPERTY VALUE BEG . END)
-			 (let ((tail (nthcdr 3 undo-elt)))
-			   (when (>= (car tail) position)
-			     (setcar tail (- (car tail) offset))
-			     (setcdr tail (- (cdr tail) offset))))))
-		  (setq temp-undo-list (cdr temp-undo-list))))))))
-      (setq undo-list-copy (cdr undo-list-copy)))
-    (nreverse undo-list)))
+                      (push (pop list-i) selective-list)))))
+            (let ((delta (undo-delta undo-elt)))
+              (when (/= 0 (cdr delta))
+                (push delta undo-deltas)))))))
+      (pop ulist))
+    (nreverse selective-list)))
 
 (defun undo-elt-in-region (undo-elt start end)
   "Determine whether UNDO-ELT falls inside the region START ... END.
@@ -2492,6 +2512,42 @@ is not *inside* the region START...END."
 	 ;; (BEGIN . END)
 	 (and (< (car undo-elt) end)
 	      (> (cdr undo-elt) start)))))
+(make-obsolete 'undo-elt-crosses-region nil "24.5")
+
+(defun undo-adjust-elt (elt deltas)
+  "Return adjustment of undo element ELT by the undo DELTAS
+list."
+  (pcase elt
+    ;; POSITION
+    ((pred integerp)
+     (undo-adjust-pos elt deltas))
+    ;; (BEG . END)
+    (`(,(and beg (pred integerp)) . ,(and end (pred integerp)))
+     (cons (undo-adjust-pos beg deltas)
+           (undo-adjust-pos end deltas t)))
+    ;; (TEXT . POSITION)
+    (`(,(and text (pred stringp)) . ,(and pos (pred integerp)))
+     (cons text (undo-adjust-pos pos deltas)))
+    ;; (nil PROPERTY VALUE BEG . END)
+    (`(nil . ,(or `(,prop ,val ,beg . ,end) pcase--dontcare))
+     `(nil ,prop ,val ,(undo-adjust-pos beg deltas) . ,(undo-adjust-pos end deltas t)))
+    ;; (apply DELTA START END FUN . ARGS)
+    ;; FIXME: (Prior undo in region code didn't implement this.)
+    ;; All others return same elt
+    (_ elt)))
+
+(defun undo-adjust-pos (pos deltas &optional use-<)
+  "Return adjustment of POS by the undo DELTAS list, comparing
+with < or <= based on USE-<."
+  (dolist (d deltas pos)
+    (when (if use-<
+              (< (car d) pos)
+            (<= (car d) pos))
+      (setq pos
+            ;; Don't allow pos to become less than the undo-delta
+            ;; position. This edge case is described in the overview
+            ;; comments.
+            (max (car d) (- pos (cdr d)))))))
 
 ;; Return the first affected buffer position and the delta for an undo element
 ;; delta is defined as the change in subsequent buffer positions if we *did*
diff --git a/test/automated/undo-tests.el b/test/automated/undo-tests.el
index 6ecac36..178eaf1 100644
--- a/test/automated/undo-tests.el
+++ b/test/automated/undo-tests.el
@@ -226,7 +226,7 @@
             (should-not (buffer-modified-p))))
       (delete-file tempfile))))
 
-(ert-deftest undo-test-in-region-not-most-recent ()
+(ert-deftest undo-test-region-not-most-recent ()
   "Test undo in region of an edit not the most recent."
   (with-temp-buffer
     (buffer-enable-undo)
@@ -247,7 +247,78 @@
     (should (string= (buffer-string)
                      "11131"))))
 
-(ert-deftest undo-test-in-region-eob ()
+(ert-deftest undo-test-region-deletion ()
+  "Test undoing a deletion to demonstrate bug 17235."
+  (with-temp-buffer
+    (buffer-enable-undo)
+    (transient-mark-mode 1)
+    (insert "12345")
+    (search-backward "4")
+    (undo-boundary)
+    (delete-forward-char 1)
+    (search-backward "1")
+    (undo-boundary)
+    (insert "xxxx")
+    (undo-boundary)
+    (insert "yy")
+    (search-forward "35")
+    (undo-boundary)
+    ;; Select "35"
+    (push-mark (point) t t)
+    (setq mark-active t)
+    (forward-char -2)
+    (undo) ; Expect "4" to come back
+    (should (string= (buffer-string)
+                     "xxxxyy12345"))))
+
+(ert-deftest undo-test-region-example ()
+  "The same example test case described in comments for
+undo-make-selective-list."
+  ;; buf pos:
+  ;; 123456789 buffer-undo-list  undo-deltas
+  ;; --------- ----------------  -----------
+  ;; aaa       (1 . 4)           (1 . -3)
+  ;; aaba      (3 . 4)           N/A (in region)
+  ;; ccaaba    (1 . 3)           (1 . -2)
+  ;; ccaabaddd (7 . 10)          (7 . -3)
+  ;; ccaabdd   ("ad" . 6)        (6 . 2)
+  ;; ccaabaddd (6 . 8)           (6 . -2)
+  ;;  |   |<-- region: "caab", from 2 to 6
+  (with-temp-buffer
+    (buffer-enable-undo)
+    (transient-mark-mode 1)
+    (insert "aaa")
+    (goto-char 3)
+    (undo-boundary)
+    (insert "b")
+    (goto-char 1)
+    (undo-boundary)
+    (insert "cc")
+    (goto-char 7)
+    (undo-boundary)
+    (insert "ddd")
+    (search-backward "ad")
+    (undo-boundary)
+    (delete-forward-char 2)
+    (undo-boundary)
+    ;; Select "dd"
+    (push-mark (point) t t)
+    (setq mark-active t)
+    (goto-char (point-max))
+    (undo)
+    (undo-boundary)
+    (should (string= (buffer-string)
+                     "ccaabaddd"))
+    ;; Select "caab"
+    (push-mark 2 t t)
+    (setq mark-active t)
+    (goto-char 6)
+    (undo)
+    (undo-boundary)
+    (should (string= (buffer-string)
+                     "ccaaaddd"))))
+
+(ert-deftest undo-test-region-eob ()
   "Test undo in region of a deletion at EOB, demonstrating bug 16411."
   (with-temp-buffer
     (buffer-enable-undo)

[-- Attachment #3: undo-play.el --]
[-- Type: application/octet-stream, Size: 1548 bytes --]

;; To benchmark undo in region:
;;   - open *scratch*
;;   - call play-insert
;;   - elp-instrument-function undo-make-selective-list
;;   - select third line
;;   - undo in region twice
;;   - elp-results
;;
;; Three trials with old undo-make-selective-list code:
;;   0.22304 0.20816 0.207607
;;
;; Three trials with new undo-make-selective-list code:
;;   0.072031 0.072052 0.071874

(require 'cl-lib)

;; Determine number of iterations necessary to trunate "aaa" from undo history
(defun play-num-iters ()
  (interactive)
  (save-excursion
    (goto-char 141)
    (insert "aaa")
    (undo-boundary)
    (undo)
    (undo-boundary))
  (let ((iters 0))
    (insert "b")
    (undo-boundary)
    (while (cl-find "aaa"
                    buffer-undo-list
                    :test
                    (lambda (aaa rhs)
                      (and (listp rhs)
                           (stringp (car rhs))
                           (string= aaa (car rhs)))))
      (undo) ; delete "b"
      (undo-boundary)
      (undo) ; reinsert "b"
      (undo-boundary)
      (garbage-collect)
      (cl-incf iters))
    (message "iters=%s" iters)))

(defun play-insert ()
  (interactive)
  (save-excursion
    (goto-char 141)
    (insert "aaa")
    (undo-boundary)
    (undo)
    (undo-boundary))
  (let ((iters 0))
    (insert "b")
    (undo-boundary)
    ;; 499 is (- (play-num-iters) 1)
    (while (< iters 499)
      (undo) ; delete "b"
      (undo-boundary)
      (undo) ; reinsert "b"
      (undo-boundary)
      (cl-incf iters))
    (garbage-collect)))