From 7e197d19f257816aaf12f474bdae2eca36fbbc21 Mon Sep 17 00:00:00 2001
From: Yuan Fu <casouri@gmail.com>
Date: Wed, 3 Mar 2021 09:50:15 -0500
Subject: [PATCH] Map redo records for undo in region to 'undo-in-region

* lisp/simple.el (undo-equiv-table): Add explaination for
undo-in-region, undo to the beginning of undo list and null undo.
(undo): If equiv is 'undo-in-region, empty or t, set pending-undo-list
to t.  If the redo is undo-in-region, map buffer-undo-list to
'undo-in-region instead of t, if it is an identity mapping, map to
'empty.
(undo-make-selective-list): Only continue when ulist is a proper list.
* test/lisp/simple-tests.el (simple-tests--undo): Add test for
undo-only in region.
(simple-tests--sans-leading-nil): New helper function.
(simple-tests--undo-equiv-table): New test for 'undo-equiv-table'.
---
 lisp/simple.el            |  55 +++++++++++++++----
 test/lisp/simple-tests.el | 111 +++++++++++++++++++++++++++++++++++++-
 2 files changed, 155 insertions(+), 11 deletions(-)

diff --git a/lisp/simple.el b/lisp/simple.el
index f8050091d5..98fccf4ff2 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -2824,8 +2824,35 @@ 'advertised-undo
 
 (defconst undo-equiv-table (make-hash-table :test 'eq :weakness t)
   "Table mapping redo records to the corresponding undo one.
-A redo record for undo-in-region maps to t.
-A redo record for ordinary undo maps to the following (earlier) undo.")
+A redo record for an undo in region maps to 'undo-in-region.
+A redo record for ordinary undo maps to the following (earlier) undo.
+A redo record that undoes to the beginning of the undo list maps to t.
+In the rare case where there are (erroneously) consecutive nil's in
+`buffer-undo-list', `undo' maps the previous valid undo record to
+'empty, if the previous record is a redo record, `undo' doesn't change
+its mapping.
+
+To be clear, a redo record is just an undo record, the only difference
+is that it is created by an undo command (instead of an ordinary buffer
+edit).  Since a record used to undo ordinary change is called undo
+record, a record used to undo an undo is called redo record.
+
+`undo' uses this table to make sure the previous command is `undo'.
+`undo-redo' uses this table to set the correct `pending-undo-list'.
+
+When you undo, `pending-undo-list' shrinks and `buffer-undo-list'
+grows, and Emacs maps the tip of `buffer-undo-list' to the tip of
+`pending-undo-list' in this table.
+
+For example, consider this undo list where each node represents an
+undo record: if we undo from 4, `pending-undo-list' will be at 3,
+`buffer-undo-list' at 5, and 5 will map to 3.
+
+    |
+    3  5
+    | /
+    |/
+    4")
 
 (defvar undo-in-region nil
   "Non-nil if `pending-undo-list' is not just a tail of `buffer-undo-list'.")
@@ -2872,7 +2899,9 @@ undo
     ;; the next command should not be a "consecutive undo".
     ;; So set `this-command' to something other than `undo'.
     (setq this-command 'undo-start)
-
+    ;; Here we decide whether to break the undo chain.  If the
+    ;; previous command is `undo', we don't call `undo-start', i.e.,
+    ;; don't break the undo chain.
     (unless (and (eq last-command 'undo)
 		 (or (eq pending-undo-list t)
 		     ;; If something (a timer or filter?) changed the buffer
@@ -2901,7 +2930,7 @@ undo
 	;; undo-redo-undo-redo-... so skip to the very last equiv.
 	(while (let ((next (gethash equiv undo-equiv-table)))
 		 (if next (setq equiv next))))
-	(setq pending-undo-list equiv)))
+	(setq pending-undo-list (if (consp equiv) equiv t))))
     (undo-more
      (if (numberp arg)
 	 (prefix-numeric-value arg)
@@ -2917,11 +2946,17 @@ undo
       (while (eq (car list) nil)
 	(setq list (cdr list)))
       (puthash list
-               ;; Prevent identity mapping.  This can happen if
-               ;; consecutive nils are erroneously in undo list.
-               (if (or undo-in-region (eq list pending-undo-list))
-                   t
-                 pending-undo-list)
+               (cond
+                (undo-in-region 'undo-in-region)
+                ;; Prevent identity mapping.  This can happen if
+                ;; consecutive nils are erroneously in undo list.  It
+                ;; has to map to _something_ so that the next `undo'
+                ;; command recognizes that the previous command is
+                ;; `undo' and doesn't break the undo chain.
+                ((eq list pending-undo-list)
+                 (or (gethash list undo-equiv-table)
+                     'empty))
+                (t pending-undo-list))
 	       undo-equiv-table))
     ;; Don't specify a position in the undo record for the undo command.
     ;; Instead, undoing this should move point to where the change is.
@@ -3234,7 +3269,7 @@ undo-make-selective-list
         undo-elt)
     (while ulist
       (when undo-no-redo
-        (while (gethash ulist undo-equiv-table)
+        (while (consp (gethash ulist undo-equiv-table))
           (setq ulist (gethash ulist undo-equiv-table))))
       (setq undo-elt (car ulist))
       (cond
diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el
index f2ddc2e3fb..1819775bda 100644
--- a/test/lisp/simple-tests.el
+++ b/test/lisp/simple-tests.el
@@ -465,8 +465,117 @@ simple-tests--undo
     (simple-tests--exec '(backward-char undo-redo undo-redo))
     (should (equal (buffer-string) "abc"))
     (simple-tests--exec '(backward-char undo-redo undo-redo))
+    (should (equal (buffer-string) "abcde")))
+  ;; Test undo/redo in region.
+  (with-temp-buffer
+    (buffer-enable-undo)
+    (dolist (x '("a" "b" "c" "d" "e"))
+      (insert x)
+      (undo-boundary))
+    (should (equal (buffer-string) "abcde"))
+    ;; The test does this: activate region, `undo', break the undo
+    ;; chain (by deactivating and reactivating the region), then
+    ;; `undo-only'.  There used to be a bug in
+    ;; `undo-make-selective-list' that makes `undo-only' error out in
+    ;; that case, which is fixed by in the same commit as this change.
+    (simple-tests--exec '(move-beginning-of-line
+                          push-mark-command
+                          forward-char
+                          forward-char
+                          undo))
+    (should (equal (buffer-string) "acde"))
+    (simple-tests--exec '(move-beginning-of-line
+                          push-mark-command
+                          forward-char
+                          forward-char
+                          undo-only))
     (should (equal (buffer-string) "abcde"))
-    ))
+    ;; Rest are simple redo in region tests.
+    (simple-tests--exec '(undo-redo))
+    (should (equal (buffer-string) "acde"))
+    (simple-tests--exec '(undo-redo))
+    (should (equal (buffer-string) "abcde"))))
+
+(defun simple-tests--sans-leading-nil (lst)
+  "Return LST sans the leading nils."
+  (while (and (consp lst) (null (car lst)))
+    (setq lst (cdr lst)))
+  lst)
+
+(ert-deftest simple-tests--undo-equiv-table ()
+  (with-temp-buffer
+    (buffer-enable-undo)
+    (let ((ul-hash-table (make-hash-table :test #'equal)))
+      (dolist (x '("a" "b" "c"))
+        (insert x)
+        (puthash x (simple-tests--sans-leading-nil buffer-undo-list)
+                 ul-hash-table)
+        (undo-boundary))
+      (should (equal (buffer-string) "abc"))
+      ;; Tests mappings in `undo-equiv-table'.
+      (simple-tests--exec '(undo))
+      (should (equal (buffer-string) "ab"))
+      (should (eq (gethash (simple-tests--sans-leading-nil
+                            buffer-undo-list)
+                           undo-equiv-table)
+                  (gethash "b" ul-hash-table)))
+      (simple-tests--exec '(backward-char undo))
+      (should (equal (buffer-string) "abc"))
+      (should (eq (gethash (simple-tests--sans-leading-nil
+                            buffer-undo-list)
+                           undo-equiv-table)
+                  (gethash "c" ul-hash-table)))
+      ;; Undo in region should map to 'undo-in-region.
+      (simple-tests--exec '(backward-char
+                            push-mark-command
+                            move-end-of-line
+                            undo))
+      (should (equal (buffer-string) "ab"))
+      (should (eq (gethash (simple-tests--sans-leading-nil
+                            buffer-undo-list)
+                           undo-equiv-table)
+                  'undo-in-region))
+      ;; The undo that undoes to the beginning should map to t.
+      (deactivate-mark 'force)
+      (simple-tests--exec '(backward-char
+                            undo undo undo
+                            undo undo undo))
+      (should (equal (buffer-string) ""))
+      (should (eq (gethash (simple-tests--sans-leading-nil
+                            buffer-undo-list)
+                           undo-equiv-table)
+                  t))
+      ;; Erroneous nil undo should map to 'empty.
+      (insert "a")
+      (undo-boundary)
+      (push nil buffer-undo-list)
+      (simple-tests--exec '(backward-char undo))
+      (should (equal (buffer-string) "a"))
+      (should (eq (gethash (simple-tests--sans-leading-nil
+                            buffer-undo-list)
+                           undo-equiv-table)
+                  'empty))
+      ;; But if the previous record is a redo record, its mapping
+      ;; shouldn't change.
+      (insert "e")
+      (undo-boundary)
+      (should (equal (buffer-string) "ea"))
+      (puthash "e" (simple-tests--sans-leading-nil buffer-undo-list)
+               ul-hash-table)
+      (insert "a")
+      (undo-boundary)
+      (simple-tests--exec '(backward-char undo))
+      (should (equal (buffer-string) "ea"))
+      (push nil buffer-undo-list)
+      (simple-tests--exec '(forward-char undo))
+      ;; Buffer content should change since we just undid a nil
+      ;; record.
+      (should (equal (buffer-string) "ea"))
+      ;; The previous redo record shouldn't map to empty.
+      (should (equal (gethash (simple-tests--sans-leading-nil
+                               buffer-undo-list)
+                              undo-equiv-table)
+                     (gethash "e" ul-hash-table))))))
 
 ;;; undo auto-boundary tests
 (ert-deftest undo-auto-boundary-timer ()
-- 
2.24.3 (Apple Git-128)

