From 4cc59fba6e722b072a1fa33d5f083c21a327ff45 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Tue, 4 Feb 2025 14:09:52 +0100 Subject: [PATCH] Add inhibit-auto-revert macro * doc/lispref/backups.texi (Reverting): Add inhibit-auto-revert-buffers and inhibit-auto-revert. * etc/NEWS: Add inhibit-auto-revert-buffers and inhibit-auto-revert. Fix typos. * lisp/autorevert.el (inhibit-auto-revert-buffers): New variable. (inhibit-auto-revert): New macro. (auto-revert-active-p, auto-revert-handler): Check `inhibit-auto-revert-buffers'. * lisp/dired.el (dired--inhibit-auto-revert): Remove. (dired-buffer-stale-p): Don't set it. (dired-map-over-marks, dired-internal-do-deletions): Use `inhibit-auto-revert. * test/lisp/autorevert-tests.el (auto-revert-test08-auto-revert-inhibit-auto-revert) (auto-revert-test08-auto-revert-inhibit-auto-revert-remote): New tests. (cherry picked from commit 9597881592049509d62f91139316ac0eba2fb19d) --- doc/lispref/backups.texi | 24 ++++++ lisp/autorevert.el | 47 ++++++++--- lisp/dired.el | 142 ++++++++++++++++------------------ test/lisp/autorevert-tests.el | 35 +++++++++ 4 files changed, 164 insertions(+), 84 deletions(-) diff --git a/doc/lispref/backups.texi b/doc/lispref/backups.texi index 50c7ace253c..f3f0902f364 100644 --- a/doc/lispref/backups.texi +++ b/doc/lispref/backups.texi @@ -852,6 +852,30 @@ It is important to assure that point does not continuously jump around as a consequence of auto-reverting. Of course, moving point might be inevitable if the buffer radically changes. +@defvar inhibit-auto-revert-buffers +When the current buffer is member of this variable (a list of buffers), +auto-reverting is suppressed for that buffer. This is useful if serious +changes are applied to that buffer which would be poisoned by an +unexpected auto-revert. After the change is finished, the buffer shall +be removed from @code{inhibit-auto-revert-buffers}. + +The check of membership in @code{inhibit-auto-revert-buffers} is applied +prior to the call of @code{buffer-stale-function}; any heavy check in +that function is avoided, therefore. + +If auto-reverting is triggered by file notification while +@code{inhibit-auto-revert-buffers} prevents this, auto-revert will +happen next time the buffer is polled for changes, unless +@code{auto-revert-avoid-polling} is non-@code{nil}. @pxref{(emacs) Auto +Revert}. +@end defvar + +@defmac inhibit-auto-revert &rest body +This macro adds the current buffer to +@code{inhibit-auto-revert-buffers}, runs @var{body}, and removes the +current buffer from @code{inhibit-auto-revert-buffers} afterwards. +@end defmac + You should make sure that the @code{revert-buffer-function} does not print messages that unnecessarily duplicate Auto Revert's own messages, displayed if @code{auto-revert-verbose} is @code{t}, and effectively diff --git a/lisp/autorevert.el b/lisp/autorevert.el index b9c58f2d65a..2ae71c07226 100644 --- a/lisp/autorevert.el +++ b/lisp/autorevert.el @@ -772,11 +772,37 @@ If the buffer needs to be reverted, do it now." (when auto-revert-notify-modified-p (auto-revert-handler))))) +;;;###autoload +(progn + (defvar inhibit-auto-revert-buffers nil + "A list of buffers with suppressed auto-revert.") + + (defmacro inhibit-auto-revert (&rest body) + "Deactivate auto-reverting of current buffer temporarily. +Run BODY." + (declare (indent 0) (debug ((form body) body))) + `(progn + ;; Cleanup. + (dolist (buf inhibit-auto-revert-buffers) + (unless (buffer-live-p buf) + (setq inhibit-auto-revert-buffers + (delq buf inhibit-auto-revert-buffers)))) + (let ((buf (and (not (memq (current-buffer) inhibit-auto-revert-buffers)) + (current-buffer)))) + (unwind-protect + (progn + (when buf (add-to-list 'inhibit-auto-revert-buffers buf)) + ,@body) + (when buf + (setq inhibit-auto-revert-buffers + (delq buf inhibit-auto-revert-buffers)))))))) + (defun auto-revert-active-p () "Check if auto-revert is active in current buffer." - (or auto-revert-mode - auto-revert-tail-mode - auto-revert--global-mode)) + (and (or auto-revert-mode + auto-revert-tail-mode + auto-revert--global-mode) + (not (memq (current-buffer) inhibit-auto-revert-buffers)))) (defun auto-revert-handler () "Revert current buffer, if appropriate. @@ -798,14 +824,17 @@ This is an internal function used by Auto-Revert Mode." (setq size (file-attribute-size (file-attributes buffer-file-name))))) - (funcall (or buffer-stale-function - #'buffer-stale--default-function) - t))) + (and (not (memq (current-buffer) + inhibit-auto-revert-buffers)) + (funcall (or buffer-stale-function + #'buffer-stale--default-function) + t)))) (and (or auto-revert-mode global-auto-revert-non-file-buffers) - (funcall (or buffer-stale-function - #'buffer-stale--default-function) - t)))) + (and (not (memq (current-buffer) inhibit-auto-revert-buffers)) + (funcall (or buffer-stale-function + #'buffer-stale--default-function) + t))))) eob eoblist) (setq auto-revert-notify-modified-p nil auto-revert--last-time (current-time)) diff --git a/lisp/dired.el b/lisp/dired.el index 199244393d0..8a91c04bc4a 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -936,9 +936,6 @@ Return value is the number of files marked, or nil if none were marked." "")))) (and (> count 0) count))) -(defvar-local dired--inhibit-auto-revert nil - "A non-nil value prevents `auto-revert-mode' from reverting the buffer.") - (defmacro dired-map-over-marks (body arg &optional show-progress distinguish-one-marked) "Eval BODY with point on each marked line. Return a list of BODY's results. @@ -975,52 +972,53 @@ marked file, return (t FILENAME) instead of (FILENAME)." ;;endless loop. ;;This warning should not apply any longer, sk 2-Sep-1991 14:10. `(prog1 - (let ((dired--inhibit-auto-revert t) (inhibit-read-only t) - case-fold-search found results) - ,(let ((else `(let ((regexp (dired-marker-regexp)) next-position) - (save-excursion - (goto-char (point-min)) - ;; remember position of next marked file before BODY - ;; can insert lines before the just found file, - ;; confusing us by finding the same marked file again - ;; and again and... - (setq next-position (and (re-search-forward regexp nil t) - (point-marker)) - found (not (null next-position))) - (while next-position - (goto-char next-position) - ,@(when show-progress - `((if ,show-progress (sit-for 0)))) - (setq results (cons ,body results)) - ;; move after last match - (goto-char next-position) - (forward-line 1) - (set-marker next-position nil) - (setq next-position (and (re-search-forward regexp nil t) - (point-marker))))) - ,@(when distinguish-one-marked - `((if (and ,distinguish-one-marked (= (length results) 1)) - (setq results (cons t results))))) - (if found - results - (unless (eq ,arg 'marked) - (list ,body)))))) - (if (byte-compile-nilconstp arg) else - `(if (and ,arg (not (eq ,arg 'marked))) - (if (integerp ,arg) - (progn ;; no save-excursion, want to move point. - (dired-repeat-over-lines - ,arg - (lambda () - ,@(when show-progress - `((if ,show-progress (sit-for 0)))) - (setq results (cons ,body results)))) - (when (< ,arg 0) - (setq results (nreverse results))) - results) - ;; non-nil, non-integer, non-marked ARG means use current file: - (list ,body)) - ,else)))) + (inhibit-auto-revert + (let ((inhibit-read-only t) + case-fold-search found results) + ,(let ((else `(let ((regexp (dired-marker-regexp)) next-position) + (save-excursion + (goto-char (point-min)) + ;; remember position of next marked file before BODY + ;; can insert lines before the just found file, + ;; confusing us by finding the same marked file again + ;; and again and... + (setq next-position (and (re-search-forward regexp nil t) + (point-marker)) + found (not (null next-position))) + (while next-position + (goto-char next-position) + ,@(when show-progress + `((if ,show-progress (sit-for 0)))) + (setq results (cons ,body results)) + ;; move after last match + (goto-char next-position) + (forward-line 1) + (set-marker next-position nil) + (setq next-position (and (re-search-forward regexp nil t) + (point-marker))))) + ,@(when distinguish-one-marked + `((if (and ,distinguish-one-marked (= (length results) 1)) + (setq results (cons t results))))) + (if found + results + (unless (eq ,arg 'marked) + (list ,body)))))) + (if (byte-compile-nilconstp arg) else + `(if (and ,arg (not (eq ,arg 'marked))) + (if (integerp ,arg) + (progn ;; no save-excursion, want to move point. + (dired-repeat-over-lines + ,arg + (lambda () + ,@(when show-progress + `((if ,show-progress (sit-for 0)))) + (setq results (cons ,body results)))) + (when (< ,arg 0) + (setq results (nreverse results))) + results) + ;; non-nil, non-integer, non-marked ARG means use current file: + (list ,body)) + ,else))))) ;; save-excursion loses, again (dired-move-to-filename))) @@ -1286,12 +1284,6 @@ This feature is used by Auto Revert mode." ;; Do not auto-revert when the dired buffer can be currently ;; written by the user as in `wdired-mode'. buffer-read-only - ;; When a dired operation using dired-map-over-marks is in - ;; progress, dired--inhibit-auto-revert is bound to some - ;; non-nil value and we must not auto-revert because that could - ;; change the order of files leading to skipping or - ;; double-processing (see bug#75626). - (not dired--inhibit-auto-revert) (dired-directory-changed-p dirname)))) (defcustom dired-auto-revert-buffer nil @@ -4082,26 +4074,26 @@ non-empty directories is allowed." (while l (goto-char (marker-position (cdr (car l)))) (dired-move-to-filename) - (let ((inhibit-read-only t) - ;; Temporarily prevent auto-revert while deleting - ;; entry in the dired buffer (bug#71264). - (dired--inhibit-auto-revert t)) - (condition-case err - (let ((fn (car (car l)))) - (dired-delete-file fn dired-recursive-deletes trash) - ;; if we get here, removing worked - (setq succ (1+ succ)) - (progress-reporter-update progress-reporter succ) - (dired-fun-in-all-buffers - (file-name-directory fn) (file-name-nondirectory fn) - #'dired-delete-entry fn) - ;; For when FN's directory name is different - ;; from the current buffer's dired-directory. - (dired-delete-entry fn)) - (quit (throw '--delete-cancel (message "OK, canceled"))) - (error ;; catch errors from failed deletions - (dired-log "%s: %s\n" (car err) (error-message-string err)) - (setq failures (cons (car (car l)) failures))))) + ;; Temporarily prevent auto-revert while deleting entry in + ;; the dired buffer (bug#71264). + (inhibit-auto-revert + (let ((inhibit-read-only t)) + (condition-case err + (let ((fn (car (car l)))) + (dired-delete-file fn dired-recursive-deletes trash) + ;; if we get here, removing worked + (setq succ (1+ succ)) + (progress-reporter-update progress-reporter succ) + (dired-fun-in-all-buffers + (file-name-directory fn) (file-name-nondirectory fn) + #'dired-delete-entry fn) + ;; For when FN's directory name is different + ;; from the current buffer's dired-directory. + (dired-delete-entry fn)) + (quit (throw '--delete-cancel (message "OK, canceled"))) + (error ;; catch errors from failed deletions + (dired-log "%s: %s\n" (car err) (error-message-string err)) + (setq failures (cons (car (car l)) failures)))))) (setq l (cdr l))) (if (not failures) (progress-reporter-done progress-reporter) diff --git a/test/lisp/autorevert-tests.el b/test/lisp/autorevert-tests.el index 5e46216cc42..319f3285d2d 100644 --- a/test/lisp/autorevert-tests.el +++ b/test/lisp/autorevert-tests.el @@ -687,6 +687,41 @@ This expects `auto-revert--messages' to be bound by (auto-revert--deftest-remote auto-revert-test07-auto-revert-several-buffers "Check autorevert for several buffers visiting the same remote file.") +(ert-deftest auto-revert-test08-auto-revert-inhibit-auto-revert () + "Check the power of `inhibit-auto-revert'." + ;; `auto-revert-buffers' runs every 5". And we must wait, until the + ;; file has been reverted. + (with-auto-revert-test + (ert-with-temp-file tmpfile + (let ((times '(60 30 15)) + buf) + (unwind-protect + (progn + (auto-revert-tests--write-file "any text" tmpfile (pop times)) + (setq buf (find-file-noselect tmpfile)) + (with-current-buffer buf + (ert-with-message-capture auto-revert--messages + (inhibit-auto-revert + (auto-revert-mode 1) + (should auto-revert-mode) + + (auto-revert-tests--write-file "another text" tmpfile (pop times)) + ;; Check, that the buffer hasn't been reverted. + (auto-revert--wait-for-revert buf) + (should-not (string-match "another text" (buffer-string)))) + + ;; Check, that the buffer has been reverted. + (auto-revert--wait-for-revert buf) + (should (string-match "another text" (buffer-string)))))) + + ;; Exit. + (ignore-errors + (with-current-buffer buf (set-buffer-modified-p nil)) + (kill-buffer buf))))))) + +(auto-revert--deftest-remote auto-revert-test08-auto-revert-inhibit-auto-revert + "Check the power of `inhibit-auto-revert' on a remote file.") + ;; Mark all tests as unstable on Cygwin (bug#49665). (when (eq system-type 'cygwin) (dolist (test (apropos-internal "^auto-revert" #'ert-test-boundp)) -- 2.39.5