Change algorithm used to adjust positions for undo in region

* simple.el (undo-make-selective-list): New algorithm fixes
incorrectness of position adjustments when undoing in region.
(Bug#17235)
(undo-elt-crosses-region): Make obsolete.
(undo-adjust-elt, undo-adjust-beg-end, undo-adjust-pos): New
functions to adjust positions using undo-deltas.
* automated/undo-tests.el (undo-test-region-deletion): New test to
demonstrate bug#17235.
(undo-test-region-example): New test to verify example given in
comments for undo-make-selective-list.

Fixes: debbugs:17325

4 files changed, 259 insertions, 84 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index fdaf4f1d9e..9a084d8390 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,10 @@
+2014-05-01  Barry O'Reilly  <gundaetiapo@gmail.com>
+
+	* automated/undo-tests.el (undo-test-region-deletion): New test to
+	demonstrate bug#17235.
+	(undo-test-region-example): New test to verify example given in
+	comments for undo-make-selective-list.
+
 2014-05-01  Stefan Monnier  <monnier@iro.umontreal.ca>
 
 	* emacs-lisp/lisp-mode.el (lisp--match-hidden-arg): Only highlight past
diff --git a/lisp/simple.el b/lisp/simple.el
index 3273d86879..1484339986 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -2365,91 +2365,112 @@ 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.  It is adjusted through the undo-deltas: ((6 . 2) (6 . -2)).
+;; 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 the first undo delta.
+;;
+;; More interesting is how to adjust the "ddd" insertion due to the
+;; next undo-delta: (6 . -2), corresponding to reinsertion of "ad".
+;; If the reinsertion was a manual retyping of "ad", then the total
+;; adjustment should be (7 . 10) -> (6 . 8) -> (8 . 10).  However, if
+;; the reinsertion was due to undo, one might expect the first "d"
+;; character would again be a part of the "ddd" text, meaning its
+;; total adjustment would be (7 . 10) -> (6 . 8) -> (7 . 10).
+;;
+;; undo-make-selective-list assumes in this situation that "ad" was a
+;; new edit, even if it was inserted because of an undo.
+;; Consequently, if the user undos in region "8 to 10" of the
+;; "ccaabaddd" buffer, they could be surprised that it becomes
+;; "ccaabad", as though the first "d" became detached from the
+;; original "ddd" insertion.  This quirk is a FIXME.
+
 (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.
@@ -2497,6 +2518,73 @@ 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)))
+     (undo-adjust-beg-end beg end deltas))
+    ;; (TEXT . POSITION)
+    (`(,(and text (pred stringp)) . ,(and pos (pred integerp)))
+     (cons text (* (if (< pos 0) -1 1)
+                   (undo-adjust-pos (abs pos) deltas))))
+    ;; (nil PROPERTY VALUE BEG . END)
+    (`(nil . ,(or `(,prop ,val ,beg . ,end) pcase--dontcare))
+     `(nil ,prop ,val . ,(undo-adjust-beg-end beg end deltas)))
+    ;; (apply DELTA START END FUN . ARGS)
+    ;; FIXME
+    ;; All others return same elt
+    (_ elt)))
+
+;; (BEG . END) can adjust to the same positions, commonly when an
+;; insertion was undone and they are out of region, for example:
+;;
+;; buf pos:
+;; 123456789 buffer-undo-list undo-deltas
+;; --------- ---------------- -----------
+;; [...]
+;; abbaa     (2 . 4)          (2 . -2)
+;; aaa       ("bb" . 2)       (2 . 2)
+;; [...]
+;;
+;; "bb" insertion (2 . 4) adjusts to (2 . 2) because of the subsequent
+;; undo.  Further adjustments to such an element should be the same as
+;; for (TEXT . POSITION) elements.  The options are:
+;;
+;;   1: POSITION adjusts using <= (use-< nil), resulting in behavior
+;;      analogous to marker insertion-type t.
+;;
+;;   2: POSITION adjusts using <, resulting in behavior analogous to
+;;      marker insertion-type nil.
+;;
+;; There was no strong reason to prefer one or the other, except that
+;; the first is more consistent with prior undo in region behavior.
+(defun undo-adjust-beg-end (beg end deltas)
+  "Return cons of adjustments to BEG and END by the undo DELTAS
+list."
+  (let ((adj-beg (undo-adjust-pos beg deltas)))
+    ;; Note: option 2 above would be like (cons (min ...) adj-end)
+    (cons adj-beg
+          (max adj-beg (undo-adjust-pos end deltas t)))))
+
+(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/ChangeLog b/test/ChangeLog
index afc05d338a..f4f7e0abdc 100644
--- a/test/ChangeLog
+++ b/test/ChangeLog
@@ -1,3 +1,12 @@
+2014-05-01  Barry O'Reilly  <gundaetiapo@gmail.com>
+
+	* simple.el (undo-make-selective-list): New algorithm fixes
+	incorrectness of position adjustments when undoing in region.
+	(Bug#17235)
+	(undo-elt-crosses-region): Make obsolete.
+	(undo-adjust-elt, undo-adjust-beg-end, undo-adjust-pos): New
+	functions to adjust positions using undo-deltas.
+
 2014-04-25  Michael Albinus  <michael.albinus@gmx.de>
 
 	* automated/tramp-tests.el (top):
diff --git a/test/automated/undo-tests.el b/test/automated/undo-tests.el
index 6ecac36b6b..178eaf194d 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)