master 59353ec7b5 1/2: Add new macro with-buffer-unmodified-if-unchanged

[Lars Ingebrigtsen]

branch: master
commit 59353ec7b579213de3c70950d5d938b7540ce72f
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    Add new macro with-buffer-unmodified-if-unchanged
    
    * lisp/emacs-lisp/subr-x.el (with-buffer-unmodified-if-unchanged):
    New macro.
    * lisp/textmodes/fill.el (fill-paragraph): Macro code copied from
    here.  Adjust and use the macro.
---
 etc/NEWS                  |   6 +++
 lisp/emacs-lisp/subr-x.el |  25 +++++++++
 lisp/textmodes/fill.el    | 132 ++++++++++++++++++++++------------------------
 3 files changed, 94 insertions(+), 69 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 15c7ce8a90..b0758b60a0 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1625,6 +1625,12 @@ functions.
 
 * Lisp Changes in Emacs 29.1
 
+---
+** New macro 'with-buffer-unmodified-if-unchanged'.
+If the buffer is marked as unmodified, and code does modifications
+that, in total, means that the buffer is identical to the buffer
+before, mark the buffer as unmodified again.
+
 ---
 ** New function 'malloc-trim'.
 This function allows returning unused memory back to the operating
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index 6c763bd04d..afa0423d90 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -416,6 +416,31 @@ this defaults to the current buffer."
         (error "No process selected"))
       process)))
 
+(defmacro with-buffer-unmodified-if-unchanged (&rest body)
+  "Like `progn', but change buffer modification status only if buffer is 
changed.
+That is, if the buffer is marked as unmodified before BODY, and
+BODY does modifications that, in total, means that the buffer is
+identical to the buffer before BODY, mark the buffer as
+unmodified again.  In other words, this won't change buffer
+modification status:
+
+  (with-buffer-unmodified-if-unchanged
+    (insert \"a\")
+    (delete-char -1))"
+  (declare (debug t) (indent 0))
+  (let ((hash (gensym)))
+    `(let ((,hash (and (not (buffer-modified-p))
+                       (buffer-hash))))
+       (prog1
+           (progn
+             ,@body)
+         ;; If we didn't change anything in the buffer (and the buffer
+         ;; was previously unmodified), then flip the modification status
+         ;; back to "unchanged".
+         (when (and ,hash
+                    (equal ,hash (buffer-hash)))
+           (set-buffer-modified-p nil))))))
+
 (provide 'subr-x)
 
 ;;; subr-x.el ends here
diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el
index d3c832a40d..88a8395c88 100644
--- a/lisp/textmodes/fill.el
+++ b/lisp/textmodes/fill.el
@@ -29,6 +29,8 @@
 
 ;;; Code:
 
+(eval-when-compile (require 'subr-x))
+
 (defgroup fill nil
   "Indenting and filling text."
   :link '(custom-manual "(emacs)Filling")
@@ -839,75 +841,67 @@ region, instead of just filling the current paragraph."
   (interactive (progn
                 (barf-if-buffer-read-only)
                 (list (if current-prefix-arg 'full) t)))
-  (let ((hash (and (not (buffer-modified-p))
-                   (buffer-hash))))
-    (prog1
-        (or
-         ;; 1. Fill the region if it is active when called interactively.
-         (and region transient-mark-mode mark-active
-              (not (eq (region-beginning) (region-end)))
-              (or (fill-region (region-beginning) (region-end) justify) t))
-         ;; 2. Try fill-paragraph-function.
-         (and (not (eq fill-paragraph-function t))
-              (or fill-paragraph-function
-                  (and (minibufferp (current-buffer))
-                       (= 1 (point-min))))
-              (let ((function (or fill-paragraph-function
-                                  ;; In the minibuffer, don't count
-                                  ;; the width of the prompt.
-                                  'fill-minibuffer-function))
-                    ;; If fill-paragraph-function is set, it probably
-                    ;; takes care of comments and stuff.  If not, it
-                    ;; will have to set fill-paragraph-handle-comment
-                    ;; back to t explicitly or return nil.
-                    (fill-paragraph-handle-comment nil)
-                    (fill-paragraph-function t))
-                (funcall function justify)))
-         ;; 3. Try our syntax-aware filling code.
-         (and fill-paragraph-handle-comment
-              ;; Our code only handles \n-terminated comments right now.
-              comment-start (equal comment-end "")
-              (let ((fill-paragraph-handle-comment nil))
-                (fill-comment-paragraph justify)))
-         ;; 4. If it all fails, default to the good ol' text paragraph filling.
-         (let ((before (point))
-               (paragraph-start paragraph-start)
-               ;; Fill prefix used for filling the paragraph.
-               fill-pfx)
-           ;; Try to prevent code sections and comment sections from being
-           ;; filled together.
-           (when (and fill-paragraph-handle-comment comment-start-skip)
-             (setq paragraph-start
-                   (concat paragraph-start "\\|[ \t]*\\(?:"
-                           comment-start-skip "\\)")))
-           (save-excursion
-             ;; To make sure the return value of forward-paragraph is
-             ;; meaningful, we have to start from the beginning of
-             ;; line, otherwise skipping past the last few chars of a
-             ;; paragraph-separator would count as a paragraph (and
-             ;; not skipping any chars at EOB would not count as a
-             ;; paragraph even if it is).
-             (move-to-left-margin)
-             (if (not (zerop (fill-forward-paragraph 1)))
-                 ;; There's no paragraph at or after point: give up.
-                 (setq fill-pfx "")
-               (let ((end (point))
-                     (beg (progn (fill-forward-paragraph -1) (point))))
-                 (goto-char before)
-                 (setq fill-pfx
-                       (if use-hard-newlines
-                           ;; Can't use fill-region-as-paragraph, since this
-                           ;; paragraph may still contain hard newlines.  See
-                           ;; fill-region.
-                           (fill-region beg end justify)
-                         (fill-region-as-paragraph beg end justify))))))
-           fill-pfx))
-      ;; If we didn't change anything in the buffer (and the buffer
-      ;; was previously unmodified), then flip the modification status
-      ;; back to "unchanged".
-      (when (and hash
-                 (equal hash (buffer-hash)))
-        (set-buffer-modified-p nil)))))
+  (with-buffer-unmodified-if-unchanged
+    (or
+     ;; 1. Fill the region if it is active when called interactively.
+     (and region transient-mark-mode mark-active
+          (not (eq (region-beginning) (region-end)))
+          (or (fill-region (region-beginning) (region-end) justify) t))
+     ;; 2. Try fill-paragraph-function.
+     (and (not (eq fill-paragraph-function t))
+          (or fill-paragraph-function
+              (and (minibufferp (current-buffer))
+                   (= 1 (point-min))))
+          (let ((function (or fill-paragraph-function
+                              ;; In the minibuffer, don't count
+                              ;; the width of the prompt.
+                              'fill-minibuffer-function))
+                ;; If fill-paragraph-function is set, it probably
+                ;; takes care of comments and stuff.  If not, it
+                ;; will have to set fill-paragraph-handle-comment
+                ;; back to t explicitly or return nil.
+                (fill-paragraph-handle-comment nil)
+                (fill-paragraph-function t))
+            (funcall function justify)))
+     ;; 3. Try our syntax-aware filling code.
+     (and fill-paragraph-handle-comment
+          ;; Our code only handles \n-terminated comments right now.
+          comment-start (equal comment-end "")
+          (let ((fill-paragraph-handle-comment nil))
+            (fill-comment-paragraph justify)))
+     ;; 4. If it all fails, default to the good ol' text paragraph filling.
+     (let ((before (point))
+           (paragraph-start paragraph-start)
+           ;; Fill prefix used for filling the paragraph.
+           fill-pfx)
+       ;; Try to prevent code sections and comment sections from being
+       ;; filled together.
+       (when (and fill-paragraph-handle-comment comment-start-skip)
+         (setq paragraph-start
+               (concat paragraph-start "\\|[ \t]*\\(?:"
+                       comment-start-skip "\\)")))
+       (save-excursion
+         ;; To make sure the return value of forward-paragraph is
+         ;; meaningful, we have to start from the beginning of
+         ;; line, otherwise skipping past the last few chars of a
+         ;; paragraph-separator would count as a paragraph (and
+         ;; not skipping any chars at EOB would not count as a
+         ;; paragraph even if it is).
+         (move-to-left-margin)
+         (if (not (zerop (fill-forward-paragraph 1)))
+             ;; There's no paragraph at or after point: give up.
+             (setq fill-pfx "")
+           (let ((end (point))
+                 (beg (progn (fill-forward-paragraph -1) (point))))
+             (goto-char before)
+             (setq fill-pfx
+                   (if use-hard-newlines
+                       ;; Can't use fill-region-as-paragraph, since this
+                       ;; paragraph may still contain hard newlines.  See
+                       ;; fill-region.
+                       (fill-region beg end justify)
+                     (fill-region-as-paragraph beg end justify))))))
+       fill-pfx))))
 
 (declare-function comment-search-forward "newcomment" (limit &optional 
noerror))
 (declare-function comment-string-strip "newcomment" (str beforep afterp))