bug#60467: 30.0.50; primitive-undo: Changes to be undone by function different from announced

[Gregory Heytings <gregory@heytings.org>]

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


>>> My hope is that we can just remove the timestamp special case, in 
>>> which case we can keep the current code mostly unchanged.
>>
>> Then our hopes are different.  What's wrong exactly with replacing a 
>> piece of code that requires a long discussion with question marks 
>> everywhere to be understood by a piece of well-documented code that is 
>> much more readable and "evidently" does what it is supposed to do?
>
> The old code was working for quite a few years, so it isn't all wrong.
>

It has only a few callers.  In fact, its only callers for a long time have 
been (1) comment-region-default and uncomment-region-default, which, by 
chance, do not insert timestamps between the undo elements, and (2) 
dired-readin in which (as I said upthread) this part of the function is 
simply not executed because buffer-undo-list is let-bound to t around 
body.  In effect, the first caller that actually exercises its logic in 
full is Org.

>
> Why do you object so much to leaving the timestamps in the undo-list?
>

I do not object to leaving timestamps in the undo-list, I object to 
leaving the code in the state it is, because I think of the future person 
who will try to make sense of it in 2028.  I'm equally fine with the two 
attached patches, one in which timestamps are kept an the other in which 
they aren't.

And now I believe it's better if I bow out of this thread, and let you and 
Stefan decide what the best course of action is.

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Fix-combine-change-call-without-timestamps.patch --]
[-- Type: text/x-diff; name=Fix-combine-change-call-without-timestamps.patch, Size: 6820 bytes --]

From 15797b21f663464b5599560e2c62df55a81b77cf Mon Sep 17 00:00:00 2001
From: Gregory Heytings <gregory@heytings.org>
Date: Wed, 4 Jan 2023 20:50:49 +0000
Subject: [PATCH] Fix combine-change-call

* lisp/subr.el (combine-change-calls-1): Rewrite and document
the part which creates the undo-list element.  Fixes bug#60467.
* test/src/undo-tests.el (undo-test-combine-change-calls-1)
(undo-test-combine-change-calls-2)
(undo-test-combine-change-calls-3): Add three tests for 'undo'
with 'combine-change-calls'.
---
 lisp/subr.el           | 65 +++++++++++++++++++++++---------------
 test/src/undo-tests.el | 72 ++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 112 insertions(+), 25 deletions(-)

diff --git a/lisp/subr.el b/lisp/subr.el
index 9087f9a404..7e201f4bc9 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -4934,31 +4934,46 @@ combine-change-calls-1
 	      (kill-local-variable 'before-change-functions))
 	    (if local-acf (setq after-change-functions acf)
 	      (kill-local-variable 'after-change-functions))))
-        (when (not (eq buffer-undo-list t))
-          (let ((ap-elt
-		 (list 'apply
-		       (- end end-marker)
-		       beg
-		       (marker-position end-marker)
-		       #'undo--wrap-and-run-primitive-undo
-		       beg (marker-position end-marker) buffer-undo-list))
-		(ptr buffer-undo-list))
-	    (if (not (eq buffer-undo-list old-bul))
-		(progn
-		  (while (and (not (eq (cdr ptr) old-bul))
-			      ;; In case garbage collection has removed OLD-BUL.
-			      (cdr ptr)
-			      ;; Don't include a timestamp entry.
-			      (not (and (consp (cdr ptr))
-					(consp (cadr ptr))
-					(eq (caadr ptr) t)
-					(setq old-bul (cdr ptr)))))
-		    (setq ptr (cdr ptr)))
-		  (unless (cdr ptr)
-		    (message "combine-change-calls: buffer-undo-list broken"))
-		  (setcdr ptr nil)
-		  (push ap-elt buffer-undo-list)
-		  (setcdr buffer-undo-list old-bul)))))
+	;; If buffer-undo-list is neither t (in which case undo
+	;; information is not recorded) nor equal to buffer-undo-list
+	;; before body was funcalled (in which case (funcall body) did
+	;; not add items to buffer-undo-list) ...
+	(unless (or (eq buffer-undo-list t)
+		    (eq buffer-undo-list old-bul))
+	  (let ((ptr buffer-undo-list) body-undo-list)
+	    ;; ... then loop over buffer-undo-list, until the head of
+	    ;; buffer-undo-list before body was funcalled is found, or
+	    ;; ptr is nil (which may happen if garbage-collect has
+	    ;; been called after (funcall body) and has removed
+	    ;; entries of buffer-undo-list that were added by (funcall
+	    ;; body)) ...
+	    (while (and ptr (not (eq ptr old-bul)))
+	      ;; ... and add the entries to body-undo-list, unless
+	      ;; they are of the form (t . <something>), which are
+	      ;; entries that record buffer modification timestamps.
+	      (unless (and (consp (car ptr))
+			   (eq (caar ptr) t))
+		(push (car ptr) body-undo-list))
+	      (setq ptr (cdr ptr)))
+	    (setq body-undo-list (nreverse body-undo-list))
+	    ;; Warn if garbage-collect has truncated buffer-undo-list
+	    ;; behind our back.
+	    (when (and old-bul (not ptr))
+	      (message
+               "combine-change-calls: buffer-undo-list has been truncated"))
+	    ;; Add an (apply ...) entry to buffer-undo-list, using
+	    ;; body-undo-list ...
+	    (push (list 'apply
+			(- end end-marker)
+			beg
+			(marker-position end-marker)
+			#'undo--wrap-and-run-primitive-undo
+			beg (marker-position end-marker)
+			body-undo-list)
+		  buffer-undo-list)
+	    ;; ... and set the cdr of buffer-undo-list to
+	    ;; buffer-undo-list before body was funcalled.
+	    (setcdr buffer-undo-list old-bul)))
 	(if (not inhibit-modification-hooks)
 	    (run-hook-with-args 'after-change-functions
 				beg (marker-position end-marker)
diff --git a/test/src/undo-tests.el b/test/src/undo-tests.el
index 84151d3b5d..fd45a9101f 100644
--- a/test/src/undo-tests.el
+++ b/test/src/undo-tests.el
@@ -439,6 +439,78 @@ undo-test-region-mark-adjustment
 
     (should (string= (buffer-string) "aaaFirst line\nSecond line\nbbb"))))
 
+(ert-deftest undo-test-combine-change-calls-1 ()
+  "Test how `combine-change-calls' updates `buffer-undo-list'.
+Case 1: a file-visiting buffer with `buffer-undo-list' non-nil
+and `buffer-modified-p' non-nil when `combine-change-calls' is
+called."
+  (ert-with-temp-file tempfile
+    (with-current-buffer (find-file tempfile)
+      (insert "A")
+      (undo-boundary)
+      (insert "B")
+      (undo-boundary)
+      (insert "C")
+      (undo-boundary)
+      (insert " ")
+      (undo-boundary)
+      (insert "D")
+      (undo-boundary)
+      (insert "E")
+      (undo-boundary)
+      (insert "F")
+      (should (= (length buffer-undo-list) 14))
+      (goto-char (point-min))
+      (combine-change-calls (point-min) (point-max)
+        (re-search-forward "ABC ")
+        (replace-match "Z "))
+      (should (= (length buffer-undo-list) 15)))))
+
+(ert-deftest undo-test-combine-change-calls-2 ()
+  "Test how `combine-change-calls' updates `buffer-undo-list'.
+Case 2: a file-visiting buffer with `buffer-undo-list' non-nil
+and `buffer-modified-p' nil when `combine-change-calls' is
+called."
+  (ert-with-temp-file tempfile
+    (with-current-buffer (find-file tempfile)
+      (insert "A")
+      (undo-boundary)
+      (insert "B")
+      (undo-boundary)
+      (insert "C")
+      (undo-boundary)
+      (insert " ")
+      (undo-boundary)
+      (insert "D")
+      (undo-boundary)
+      (insert "E")
+      (undo-boundary)
+      (insert "F")
+      (should (= (length buffer-undo-list) 14))
+      (save-buffer)
+      (goto-char (point-min))
+      (combine-change-calls (point-min) (point-max)
+        (re-search-forward "ABC ")
+        (replace-match "Z "))
+      (should (= (length buffer-undo-list) 15)))))
+
+(ert-deftest undo-test-combine-change-calls-3 ()
+  "Test how `combine-change-calls' updates `buffer-undo-list'.
+Case 3: a file-visiting buffer with `buffer-undo-list' nil and
+`buffer-modified-p' nil when `combine-change-calls' is called."
+  (ert-with-temp-file tempfile
+    (with-current-buffer (find-file tempfile)
+      (insert "ABC DEF")
+      (save-buffer)
+      (kill-buffer))
+    (with-current-buffer (find-file tempfile)
+      (should (= (length buffer-undo-list) 0))
+      (goto-char (point-min))
+      (combine-change-calls (point-min) (point-max)
+        (re-search-forward "ABC ")
+        (replace-match "Z "))
+      (should (= (length buffer-undo-list) 1)))))
+
 (defun undo-test-all (&optional interactive)
   "Run all tests for \\[undo]."
   (interactive "p")
-- 
2.39.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: Fix-combine-change-call-with-timestamps.patch --]
[-- Type: text/x-diff; name=Fix-combine-change-call-with-timestamps.patch, Size: 6604 bytes --]

From a1c435749f1f4346cfd07fdb893f6721233fe9b7 Mon Sep 17 00:00:00 2001
From: Gregory Heytings <gregory@heytings.org>
Date: Wed, 4 Jan 2023 20:49:22 +0000
Subject: [PATCH] Fix combine-change-call

* lisp/subr.el (combine-change-calls-1): Rewrite and document
the part which creates the undo-list element.  Fixes bug#60467.
* test/src/undo-tests.el (undo-test-combine-change-calls-1)
(undo-test-combine-change-calls-2)
(undo-test-combine-change-calls-3): Add three tests for 'undo'
with 'combine-change-calls'.
---
 lisp/subr.el           | 60 ++++++++++++++++++++---------------
 test/src/undo-tests.el | 72 ++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 107 insertions(+), 25 deletions(-)

diff --git a/lisp/subr.el b/lisp/subr.el
index 9087f9a404..106fa71b12 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -4934,31 +4934,41 @@ combine-change-calls-1
 	      (kill-local-variable 'before-change-functions))
 	    (if local-acf (setq after-change-functions acf)
 	      (kill-local-variable 'after-change-functions))))
-        (when (not (eq buffer-undo-list t))
-          (let ((ap-elt
-		 (list 'apply
-		       (- end end-marker)
-		       beg
-		       (marker-position end-marker)
-		       #'undo--wrap-and-run-primitive-undo
-		       beg (marker-position end-marker) buffer-undo-list))
-		(ptr buffer-undo-list))
-	    (if (not (eq buffer-undo-list old-bul))
-		(progn
-		  (while (and (not (eq (cdr ptr) old-bul))
-			      ;; In case garbage collection has removed OLD-BUL.
-			      (cdr ptr)
-			      ;; Don't include a timestamp entry.
-			      (not (and (consp (cdr ptr))
-					(consp (cadr ptr))
-					(eq (caadr ptr) t)
-					(setq old-bul (cdr ptr)))))
-		    (setq ptr (cdr ptr)))
-		  (unless (cdr ptr)
-		    (message "combine-change-calls: buffer-undo-list broken"))
-		  (setcdr ptr nil)
-		  (push ap-elt buffer-undo-list)
-		  (setcdr buffer-undo-list old-bul)))))
+	;; If buffer-undo-list is neither t (in which case undo
+	;; information is not recorded) nor equal to buffer-undo-list
+	;; before body was funcalled (in which case (funcall body) did
+	;; not add items to buffer-undo-list) ...
+	(unless (or (eq buffer-undo-list t)
+		    (eq buffer-undo-list old-bul))
+	  (let ((ptr buffer-undo-list) body-undo-list)
+	    ;; ... then loop over buffer-undo-list, until the head of
+	    ;; buffer-undo-list before body was funcalled is found, or
+	    ;; ptr is nil (which may happen if garbage-collect has
+	    ;; been called after (funcall body) and has removed
+	    ;; entries of buffer-undo-list that were added by (funcall
+	    ;; body)), and add these entries to body-undo-list.
+	    (while (and ptr (not (eq ptr old-bul)))
+	      (push (car ptr) body-undo-list)
+	      (setq ptr (cdr ptr)))
+	    (setq body-undo-list (nreverse body-undo-list))
+	    ;; Warn if garbage-collect has truncated buffer-undo-list
+	    ;; behind our back.
+	    (when (and old-bul (not ptr))
+	      (message
+               "combine-change-calls: buffer-undo-list has been truncated"))
+	    ;; Add an (apply ...) entry to buffer-undo-list, using
+	    ;; body-undo-list ...
+	    (push (list 'apply
+			(- end end-marker)
+			beg
+			(marker-position end-marker)
+			#'undo--wrap-and-run-primitive-undo
+			beg (marker-position end-marker)
+			body-undo-list)
+		  buffer-undo-list)
+	    ;; ... and set the cdr of buffer-undo-list to
+	    ;; buffer-undo-list before body was funcalled.
+	    (setcdr buffer-undo-list old-bul)))
 	(if (not inhibit-modification-hooks)
 	    (run-hook-with-args 'after-change-functions
 				beg (marker-position end-marker)
diff --git a/test/src/undo-tests.el b/test/src/undo-tests.el
index 84151d3b5d..fd45a9101f 100644
--- a/test/src/undo-tests.el
+++ b/test/src/undo-tests.el
@@ -439,6 +439,78 @@ undo-test-region-mark-adjustment
 
     (should (string= (buffer-string) "aaaFirst line\nSecond line\nbbb"))))
 
+(ert-deftest undo-test-combine-change-calls-1 ()
+  "Test how `combine-change-calls' updates `buffer-undo-list'.
+Case 1: a file-visiting buffer with `buffer-undo-list' non-nil
+and `buffer-modified-p' non-nil when `combine-change-calls' is
+called."
+  (ert-with-temp-file tempfile
+    (with-current-buffer (find-file tempfile)
+      (insert "A")
+      (undo-boundary)
+      (insert "B")
+      (undo-boundary)
+      (insert "C")
+      (undo-boundary)
+      (insert " ")
+      (undo-boundary)
+      (insert "D")
+      (undo-boundary)
+      (insert "E")
+      (undo-boundary)
+      (insert "F")
+      (should (= (length buffer-undo-list) 14))
+      (goto-char (point-min))
+      (combine-change-calls (point-min) (point-max)
+        (re-search-forward "ABC ")
+        (replace-match "Z "))
+      (should (= (length buffer-undo-list) 15)))))
+
+(ert-deftest undo-test-combine-change-calls-2 ()
+  "Test how `combine-change-calls' updates `buffer-undo-list'.
+Case 2: a file-visiting buffer with `buffer-undo-list' non-nil
+and `buffer-modified-p' nil when `combine-change-calls' is
+called."
+  (ert-with-temp-file tempfile
+    (with-current-buffer (find-file tempfile)
+      (insert "A")
+      (undo-boundary)
+      (insert "B")
+      (undo-boundary)
+      (insert "C")
+      (undo-boundary)
+      (insert " ")
+      (undo-boundary)
+      (insert "D")
+      (undo-boundary)
+      (insert "E")
+      (undo-boundary)
+      (insert "F")
+      (should (= (length buffer-undo-list) 14))
+      (save-buffer)
+      (goto-char (point-min))
+      (combine-change-calls (point-min) (point-max)
+        (re-search-forward "ABC ")
+        (replace-match "Z "))
+      (should (= (length buffer-undo-list) 15)))))
+
+(ert-deftest undo-test-combine-change-calls-3 ()
+  "Test how `combine-change-calls' updates `buffer-undo-list'.
+Case 3: a file-visiting buffer with `buffer-undo-list' nil and
+`buffer-modified-p' nil when `combine-change-calls' is called."
+  (ert-with-temp-file tempfile
+    (with-current-buffer (find-file tempfile)
+      (insert "ABC DEF")
+      (save-buffer)
+      (kill-buffer))
+    (with-current-buffer (find-file tempfile)
+      (should (= (length buffer-undo-list) 0))
+      (goto-char (point-min))
+      (combine-change-calls (point-min) (point-max)
+        (re-search-forward "ABC ")
+        (replace-match "Z "))
+      (should (= (length buffer-undo-list) 1)))))
+
 (defun undo-test-all (&optional interactive)
   "Run all tests for \\[undo]."
   (interactive "p")
-- 
2.39.0