From: Lars Ingebrigtsen Date: Tue, 3 May 2022 19:22:53 +0000 (+0200) Subject: Add new macro with-buffer-unmodified-if-unchanged X-Git-Tag: emacs-29.0.90~1931^2~94 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=59353ec7b579213de3c70950d5d938b7540ce72f;p=emacs.git 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. --- diff --git a/etc/NEWS b/etc/NEWS index 15c7ce8a908..b0758b60a09 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 6c763bd04d9..afa0423d90e 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 d3c832a40da..88a8395c88a 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))