Allow write-contents-functions to short-circuit buffer save

Bug#28412

* lisp/files.el (basic-save-buffer): Re-arrange function so that
  write-contents-functions are run earlier. If they return non-nil,
  consider the buffer saved without requiring the buffer to be
  visiting a file.
  (save-some-buffers): This function should consider any buffer with a
  buffer-local value for write-contents-functions eligible for
  saving.
* test/lisp/files-tests.el (files-test-no-file-write-contents): New
  test.
* doc/lispref/files.texi (Saving Buffers): Mention in docs.
* etc/NEWS: And in NEWS.
This commit is contained in:
Eric Abrahamsen 2017-09-12 16:06:12 -07:00
parent d07fd34722
commit 9b980e2691
4 changed files with 122 additions and 67 deletions

View file

@ -457,15 +457,23 @@ Even though this is not a normal hook, you can use @code{add-hook} and
@defvar write-contents-functions
This works just like @code{write-file-functions}, but it is intended
for hooks that pertain to the buffer's contents, not to the particular
visited file or its location. Such hooks are usually set up by major
modes, as buffer-local bindings for this variable. This variable
automatically becomes buffer-local whenever it is set; switching to a
new major mode always resets this variable, but calling
@code{set-visited-file-name} does not.
visited file or its location, and can be used to create arbitrary save
processes for buffers that aren't visiting files at all. Such hooks
are usually set up by major modes, as buffer-local bindings for this
variable. This variable automatically becomes buffer-local whenever
it is set; switching to a new major mode always resets this variable,
but calling @code{set-visited-file-name} does not.
If any of the functions in this hook returns non-@code{nil}, the file
is considered already written and the rest are not called and neither
are the functions in @code{write-file-functions}.
When using this hook to save buffers that are not visiting files (for
instance, special-mode buffers), keep in mind that, if the function
fails to save correctly and returns a @code{nil} value,
@code{save-buffer} will go on to prompt the user for a file to save
the buffer in. If this is undesirable, consider having the function
fail by raising an error.
@end defvar
@defopt before-save-hook

View file

@ -108,6 +108,14 @@ The effect is similar to that of "toolBar" resource on the tool bar.
* Changes in Emacs 26.1
+++
** Functions in 'write-contents-functions' can fully short-circuit the
'save-buffer' process. Previously, saving a buffer that was not
visiting a file would always prompt for a file name. Now it only does
so if 'write-contents-functions' is nil (or all its functions return
nil). A non-nil buffer-local value for this variable is sufficient
for 'save-some-buffers' to consider the buffer for saving.
---
** New variable 'executable-prefix-env' for inserting magic signatures.
This variable affects the format of the interpreter magic number

View file

@ -517,10 +517,12 @@ updates before the buffer is saved, use `before-save-hook'.")
'write-contents-functions "22.1")
(defvar write-contents-functions nil
"List of functions to be called before writing out a buffer to a file.
Only used by `save-buffer'.
If one of them returns non-nil, the file is considered already written
and the rest are not called and neither are the functions in
`write-file-functions'.
Only used by `save-buffer'. If one of them returns non-nil, the
file is considered already written and the rest are not called
and neither are the functions in `write-file-functions'. This
hook can thus be used to create save behavior for buffers that
are not visiting a file at all.
This variable is meant to be used for hooks that pertain to the
buffer's contents, not to the particular visited file; thus,
@ -4875,9 +4877,12 @@ in such cases.")
(defun basic-save-buffer (&optional called-interactively)
"Save the current buffer in its visited file, if it has been modified.
The hooks `write-contents-functions' and `write-file-functions' get a chance
to do the job of saving; if they do not, then the buffer is saved in
the visited file in the usual way.
The hooks `write-contents-functions', `local-write-file-hooks'
and `write-file-functions' get a chance to do the job of saving;
if they do not, then the buffer is saved in the visited file in
the usual way.
Before and after saving the buffer, this function runs
`before-save-hook' and `after-save-hook', respectively."
(interactive '(called-interactively))
@ -4886,29 +4891,14 @@ Before and after saving the buffer, this function runs
(if (buffer-base-buffer)
(set-buffer (buffer-base-buffer)))
(if (or (buffer-modified-p)
;; handle the case when no modification has been made but
;; the file disappeared since visited
;; Handle the case when no modification has been made but
;; the file disappeared since visited.
(and buffer-file-name
(not (file-exists-p buffer-file-name))))
(let ((recent-save (recent-auto-save-p))
setmodes)
;; If buffer has no file name, ask user for one.
(or buffer-file-name
(let ((filename
(expand-file-name
(read-file-name "File to save in: "
nil (expand-file-name (buffer-name))))))
(if (file-exists-p filename)
(if (file-directory-p filename)
;; Signal an error if the user specified the name of an
;; existing directory.
(error "%s is a directory" filename)
(unless (y-or-n-p (format-message
"File `%s' exists; overwrite? "
filename))
(error "Canceled"))))
(set-visited-file-name filename)))
(or (verify-visited-file-modtime (current-buffer))
(or (null buffer-file-name)
(verify-visited-file-modtime (current-buffer))
(not (file-exists-p buffer-file-name))
(yes-or-no-p
(format
@ -4920,6 +4910,7 @@ Before and after saving the buffer, this function runs
(save-excursion
(and (> (point-max) (point-min))
(not find-file-literally)
(null buffer-read-only)
(/= (char-after (1- (point-max))) ?\n)
(not (and (eq selective-display t)
(= (char-after (1- (point-max))) ?\r)))
@ -4932,46 +4923,65 @@ Before and after saving the buffer, this function runs
(save-excursion
(goto-char (point-max))
(insert ?\n))))
;; Support VC version backups.
(vc-before-save)
;; Don't let errors prevent saving the buffer.
(with-demoted-errors (run-hooks 'before-save-hook))
(or (run-hook-with-args-until-success 'write-contents-functions)
(run-hook-with-args-until-success 'local-write-file-hooks)
(run-hook-with-args-until-success 'write-file-functions)
;; If a hook returned t, file is already "written".
;; Otherwise, write it the usual way now.
(let ((dir (file-name-directory
(expand-file-name buffer-file-name))))
(unless (file-exists-p dir)
(if (y-or-n-p
(format-message
"Directory `%s' does not exist; create? " dir))
(make-directory dir t)
(error "Canceled")))
(setq setmodes (basic-save-buffer-1))))
;; Give `write-contents-functions' a chance to
;; short-circuit the whole process.
(unless (run-hook-with-args-until-success 'write-contents-functions)
;; If buffer has no file name, ask user for one.
(or buffer-file-name
(let ((filename
(expand-file-name
(read-file-name "File to save in: "
nil (expand-file-name (buffer-name))))))
(if (file-exists-p filename)
(if (file-directory-p filename)
;; Signal an error if the user specified the name of an
;; existing directory.
(error "%s is a directory" filename)
(unless (y-or-n-p (format-message
"File `%s' exists; overwrite? "
filename))
(error "Canceled"))))
(set-visited-file-name filename)))
;; Support VC version backups.
(vc-before-save)
(or (run-hook-with-args-until-success 'local-write-file-hooks)
(run-hook-with-args-until-success 'write-file-functions)
;; If a hook returned t, file is already "written".
;; Otherwise, write it the usual way now.
(let ((dir (file-name-directory
(expand-file-name buffer-file-name))))
(unless (file-exists-p dir)
(if (y-or-n-p
(format-message
"Directory `%s' does not exist; create? " dir))
(make-directory dir t)
(error "Canceled")))
(setq setmodes (basic-save-buffer-1)))))
;; Now we have saved the current buffer. Let's make sure
;; that buffer-file-coding-system is fixed to what
;; actually used for saving by binding it locally.
(if save-buffer-coding-system
(setq save-buffer-coding-system last-coding-system-used)
(setq buffer-file-coding-system last-coding-system-used))
(setq buffer-file-number
(nthcdr 10 (file-attributes buffer-file-name)))
(if setmodes
(condition-case ()
(progn
(unless
(with-demoted-errors
(set-file-modes buffer-file-name (car setmodes)))
(set-file-extended-attributes buffer-file-name
(nth 1 setmodes))))
(error nil))))
;; If the auto-save file was recent before this command,
;; delete it now.
(delete-auto-save-file-if-necessary recent-save)
;; Support VC `implicit' locking.
(vc-after-save)
(when buffer-file-name
(if save-buffer-coding-system
(setq save-buffer-coding-system last-coding-system-used)
(setq buffer-file-coding-system last-coding-system-used))
(setq buffer-file-number
(nthcdr 10 (file-attributes buffer-file-name)))
(if setmodes
(condition-case ()
(progn
(unless
(with-demoted-errors
(set-file-modes buffer-file-name (car setmodes)))
(set-file-extended-attributes buffer-file-name
(nth 1 setmodes))))
(error nil)))
;; Support VC `implicit' locking.
(vc-after-save))
;; If the auto-save file was recent before this command,
;; delete it now.
(delete-auto-save-file-if-necessary recent-save))
(run-hooks 'after-save-hook))
(or noninteractive
(not called-interactively)
@ -5183,7 +5193,9 @@ change the additional actions you can take on files."
(and pred
(progn
(set-buffer buffer)
(and buffer-offer-save (> (buffer-size) 0)))))
(and buffer-offer-save (> (buffer-size) 0))))
(buffer-local-value
'write-contents-functions buffer))
(or (not (functionp pred))
(with-current-buffer buffer (funcall pred)))
(if arg

View file

@ -365,6 +365,33 @@ be invoked with the right arguments."
(should-error (make-directory a/b))
(should-not (make-directory a/b t))))
(ert-deftest files-test-no-file-write-contents ()
"Test that `write-contents-functions' permits saving a file.
Usually `basic-save-buffer' will prompt for a file name if the
current buffer has none. It should first call the functions in
`write-contents-functions', and if one of them returns non-nil,
consider the buffer saved, without prompting for a file
name (Bug#28412)."
(let ((read-file-name-function
(lambda (&rest _ignore)
(error "Prompting for file name"))))
;; With contents function, and no file.
(with-temp-buffer
(setq write-contents-functions (lambda () t))
(set-buffer-modified-p t)
(should (null (save-buffer))))
;; With no contents function and no file. This should reach the
;; `read-file-name' prompt.
(with-temp-buffer
(set-buffer-modified-p t)
(should-error (save-buffer) :type 'error))
;; Then a buffer visiting a file: should save normally.
(files-tests--with-temp-file temp-file-name
(with-current-buffer (find-file-noselect temp-file-name)
(setq write-contents-functions nil)
(insert "p")
(should (null (save-buffer)))
(should (eq (buffer-size) 1))))))
(provide 'files-tests)
;;; files-tests.el ends here