Make with-buffer-unmodified-if-unchanged more resilient

* lisp/emacs-lisp/subr-x.el (with-buffer-unmodified-if-unchanged):
Make more resilient.
This commit is contained in:
Lars Ingebrigtsen 2022-05-03 22:04:39 +02:00
parent b5db5a6443
commit b7ddd0f2fd
2 changed files with 43 additions and 8 deletions

View file

@ -426,22 +426,24 @@ modification status:
(with-buffer-unmodified-if-unchanged
(insert \"a\")
(delete-char -1))
BODY must preserve the current buffer."
(delete-char -1))."
(declare (debug t) (indent 0))
(let ((hash (gensym)))
(let ((hash (gensym))
(buffer (gensym)))
`(let ((,hash (and (not (buffer-modified-p))
(buffer-hash))))
(buffer-hash)))
(,buffer (current-buffer)))
(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 (buffer-modified-p)
(equal ,hash (buffer-hash)))
(restore-buffer-modified-p nil))))))
(when (buffer-live-p ,buffer)
(with-current-buffer ,buffer
(when (and ,hash (buffer-modified-p)
(equal ,hash (buffer-hash)))
(restore-buffer-modified-p nil))))))))
(provide 'subr-x)

View file

@ -106,5 +106,38 @@ reversing the sort."
:generator (lambda (n) (concat (sort-tests-random-word n) " " (sort-tests-random-word n)))
:less-pred (lambda (a b) (string< (field-n a 2) (field-n b 2))))))
(defun test-with-buffer-unmodified-if-unchanged ()
(with-temp-buffer
(with-buffer-unmodified-if-unchanged
(insert "t"))
(should (buffer-modified-p)))
(with-temp-buffer
(with-buffer-unmodified-if-unchanged
(insert "t")
(delete-char -1))
(should (not (buffer-modified-p))))
;; Shouldn't error.
(should
(with-temp-buffer
(let ((inner (current-buffer)))
(with-buffer-unmodified-if-unchanged
(insert "t")
(delete-char -1)
(kill-buffer (current-buffer))
t))))
(with-temp-buffer
(let ((outer (current-buffer)))
(with-temp-buffer
(let ((inner (current-buffer)))
(with-buffer-unmodified-if-unchanged
(insert "t")
(delete-char -1)
(set-buffer outer))
(with-current-buffer inner
(should (not (buffer-modified-p)))))))))
(provide 'sort-tests)
;;; sort-tests.el ends here