andros/emacs-gpu
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add new macro with-buffer-unmodified-if-unchanged

Browse source 
* 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.
This commit is contained in:
Lars Ingebrigtsen 2022-05-03 21:22:53 +02:00
parent 8ef34a065a
commit 59353ec7b5
3 changed files with 94 additions and 69 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
etc/NEWS
View file

@ -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

25
lisp/emacs-lisp/subr-x.el
View file

@ -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

132
lisp/textmodes/fill.el
View file

@ -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))