From: Stefan Monnier <monnier@iro.umontreal.ca>
Date: Mon, 25 Nov 2024 15:13:38 +0000 (-0500)
Subject: (undo-delta): Handle `apply` elements (bug#74523)
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=7dde2dee043cb81f7963d86edd59f76420b605b1;p=emacs.git

(undo-delta): Handle `apply` elements (bug#74523)

* lisp/simple.el (undo-delta): Handle `apply` elements.

* test/lisp/simple-tests.el (simple-tests--undo-apply): New test.
(simple-tests--undo-equiv-table): Adjust test so it's not influenced by
previous operation.

(cherry picked from commit 83968cbeee06cc0fff932d5052e431b478276841)
---

diff --git a/lisp/simple.el b/lisp/simple.el
index c5bbb7d6e89..38586479303 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -3874,6 +3874,9 @@ with < or <= based on USE-<."
 	    ((integerp (car undo-elt))
 	     ;; (BEGIN . END)
 	     (cons (car undo-elt) (- (car undo-elt) (cdr undo-elt))))
+	    ;; (apply DELTA BEG END FUNC . ARGS)
+	    ((and (eq (car undo-elt) 'apply) (integerp (nth 1 undo-elt)))
+	     (cons (nth 2 undo-elt) (nth 1 undo-elt)))
 	    (t
 	     '(0 . 0)))
     '(0 . 0)))
diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el
index becf62a5516..dfb74bd1c3e 100644
--- a/test/lisp/simple-tests.el
+++ b/test/lisp/simple-tests.el
@@ -524,6 +524,51 @@ See bug#35036."
     (simple-tests--exec '(undo-redo))
     (should (equal (buffer-string) "abcde"))))
 
+(ert-deftest simple-tests--undo-apply () ;bug#74523
+  (with-temp-buffer
+    (modula-2-mode) ;; A simple mode with non-LF terminated comments.
+    (buffer-enable-undo)
+    (insert "foo\n\n")
+    (let ((midbeg (point-marker))
+          (_ (insert "midmid"))
+          (midend (point-marker)))
+      (insert "\n\nbar")
+      (undo-boundary)
+      (goto-char (+ midbeg 3))
+      (insert "\n")
+      (undo-boundary)
+      (comment-region (point-min) midbeg) ;inserts an `apply' element.
+      (undo-boundary)
+      (comment-region midend (point-max)) ;inserts an `apply' element.
+      (undo-boundary)
+      (progn
+        (goto-char midbeg)
+        (set-mark midend)
+        (setq last-command 'something-else) ;Not `undo', so we start a new run.
+        (undo '(4))
+        (should (equal (buffer-substring midbeg midend) "midmid")))
+      ;; (progn
+      ;;   (goto-char (point-min))
+      ;;   ;; FIXME: `comment-region-default' puts a too conservative boundary
+      ;;   ;; on the `apply' block, so we have to use a larger undo-region to
+      ;;   ;; include the comment-region action.  This in turn makes the
+      ;;   ;; undo-region include the \n insertion/deletion so we need 2 undo
+      ;;   ;; steps.
+      ;;   (set-mark (1+ midend))
+      ;;   (setq last-command 'something-else) ;Not `undo', so we start a new run.
+      ;;   (undo '(4))
+      ;;   (setq last-command 'undo) ;Continue the undo run.
+      ;;   (undo)
+      ;;   (should (equal (buffer-substring (point-min) midbeg) "foo\n\n")))
+      ;; (progn
+      ;;   (goto-char (point-max))
+      ;;   (set-mark midend)
+      ;;   (setq last-command 'something-else) ;Not `undo', so we start a new run.
+      ;;   (undo '(4))
+      ;;   (should (equal (buffer-substring midend (point-max)) "\n\nbar"))
+      ;;   (should (equal (buffer-string) "foo\n\nmidmid\n\nbar")))
+      )))
+
 (defun simple-tests--sans-leading-nil (lst)
   "Return LST sans the leading nils."
   (while (and (consp lst) (null (car lst)))
@@ -542,7 +587,8 @@ See bug#35036."
         (undo-boundary))
       (should (equal (buffer-string) "abc"))
       ;; Tests mappings in `undo-equiv-table'.
-      (simple-tests--exec '(undo))
+      ;; `ignore' makes sure the `undo' won't continue a previous `undo'.
+      (simple-tests--exec '(ignore undo))
       (should (equal (buffer-string) "ab"))
       (should (eq (gethash (simple-tests--sans-leading-nil
                             buffer-undo-list)