From a1c435749f1f4346cfd07fdb893f6721233fe9b7 Mon Sep 17 00:00:00 2001 From: Gregory Heytings 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