[Emacs-diffs] trunk r117040: Change algorithm used to adjust positions for undo in region

[Barry O'Reilly]

------------------------------------------------------------
revno: 117040
revision-id: address@hidden
parent: address@hidden
fixes bug: http://debbugs.gnu.org/17325
committer: Barry O'Reilly <address@hidden>
branch nick: trunk
timestamp: Thu 2014-05-01 19:25:28 -0400
message:
  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.
modified:
  lisp/ChangeLog                 changelog-20091113204419-o5vbwnq5f7feedwu-1432
  lisp/simple.el                 simple.el-20091113204419-o5vbwnq5f7feedwu-403
  test/ChangeLog                 changelog-20091113204419-o5vbwnq5f7feedwu-8588
  test/automated/undo-tests.el   undotests.el-20130108184711-brlnvjau5r1ardib-1

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2014-05-01 16:14:03 +0000
+++ b/lisp/ChangeLog    2014-05-01 23:25:28 +0000
@@ -1,3 +1,10 @@
+2014-05-01  Barry O'Reilly  <address@hidden>
+
+       * 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  <address@hidden>
 
        * emacs-lisp/lisp-mode.el (lisp--match-hidden-arg): Only highlight past

=== modified file 'lisp/simple.el'
--- a/lisp/simple.el    2014-04-28 04:40:41 +0000
+++ b/lisp/simple.el    2014-05-01 23:25:28 +0000
@@ -2365,91 +2365,112 @@
            (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 @@
         ;; (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*

=== modified file 'test/ChangeLog'
--- a/test/ChangeLog    2014-04-25 16:11:07 +0000
+++ b/test/ChangeLog    2014-05-01 23:25:28 +0000
@@ -1,3 +1,12 @@
+2014-05-01  Barry O'Reilly  <address@hidden>
+
+       * 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  <address@hidden>
 
        * automated/tramp-tests.el (top):

=== modified file 'test/automated/undo-tests.el'
--- a/test/automated/undo-tests.el      2014-03-25 02:47:39 +0000
+++ b/test/automated/undo-tests.el      2014-05-01 23:25:28 +0000
@@ -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)