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: 1129 bytes --]


>> Patch attached.
>
> Hmm... scary, even if this is intended for the master branch.  Could you 
> at least keep the few comments which were in the original code, and 
> perhaps also add comments explaining all those tricky tests with consp, 
> equality to t and to old-bul, the significance of (car ptr) and (caar 
> ptr), etc.?  This would make the code more maintainer-friendly, as the 
> need to constantly consult the spec of the various undo-list elements 
> (and hope the spec is complete and accurate ;-) would be avoided.
>

Is the attached patch better in that respect?

>
> I'd prefer to fix this in Emacs 29 if feasible, but unless the changes 
> are much simpler and/or more clearly documented, so that it becomes 
> possible to assess their risks, I don't see how that could happen.
>

I don't see how the changes could be made simpler, sorry, but now they are 
documented.  Feel free to ask further questions if something is still 
unclear.

>
> I presume that all the undo tests we have still pass?
>

They do.

>
> If so, how about adding a test for this bug?
>

I'll see if I can do that, but it seems tricky.

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

From 8f65a74ec1b86b3f5f295972c99b0b461cc7bd28 Mon Sep 17 00:00:00 2001
From: Gregory Heytings <gregory@heytings.org>
Date: Tue, 3 Jan 2023 13:29:06 +0000
Subject: [PATCH] Fix combine-change-call

* lisp/subr.el (combine-change-calls-1): Rewrite the part which
creates the undo-list element.  Fixes bug#60467.
---
 lisp/subr.el | 56 +++++++++++++++++++++++++++++-----------------------
 1 file changed, 31 insertions(+), 25 deletions(-)

diff --git a/lisp/subr.el b/lisp/subr.el
index 9087f9a404..da105d3474 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -4934,31 +4934,37 @@ 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 evaluated (in which case evaluating body
+	;; did not add items to buffer-undo-list) ...
+	(when (and (not (eq buffer-undo-list t))
+		   (not (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 evaluated is found ...
+	    (while (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))
+	    ;; 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 evaluated.
+	    (setcdr buffer-undo-list old-bul)))
 	(if (not inhibit-modification-hooks)
 	    (run-hook-with-args 'after-change-functions
 				beg (marker-position end-marker)
-- 
2.39.0