From 2261de4d20d006c5344615d49ade539541577f7e Mon Sep 17 00:00:00 2001
From: Gregory Heytings <gregory@heytings.org>
Date: Tue, 3 Jan 2023 09:23:14 +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 | 43 ++++++++++++++++++-------------------------
 1 file changed, 18 insertions(+), 25 deletions(-)

diff --git a/lisp/subr.el b/lisp/subr.el
index 9087f9a404..25ca211225 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -4934,31 +4934,24 @@ 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)))))
+        (when (and (not (eq buffer-undo-list t))
+                   (not (eq buffer-undo-list old-bul)))
+          (let ((ptr buffer-undo-list) body-undo-list)
+            (while (not (eq ptr old-bul))
+              (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))
+            (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)
+            (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