make-directory now returns t if dir already exists

This new feature will help fix a copy-directory bug (Bug#58919).
Its implementation does not rely on make-directory handlers
supporting the new feature, as it no longer uses a make-directory
handler H in any way other than (funcall H DIR), thus using
only the intersection of the old and new behavior for handlers.
This will give us time to fix handlers at our leisure.
* lisp/files.el (files--ensure-directory): New arg MKDIR.
All uses changed.
(files--ensure-directory, make-directory):
Return non-nil if DIR is already a directory.  All uses changed.
* test/lisp/files-tests.el (files-tests-make-directory):
Test new return-value convention.
This commit is contained in:
Paul Eggert 2022-12-17 12:15:30 -08:00
parent 8a9579ca29
commit bef1edc9ca
4 changed files with 41 additions and 31 deletions

View file

@ -3209,6 +3209,9 @@ This command creates a directory named @var{dirname}. If
@var{parents} is non-@code{nil}, as is always the case in an
interactive call, that means to create the parent directories first,
if they don't already exist.
As a function, @code{make-directory} returns non-@code{nil} if @var{dirname}
already exists as a directory and @var{parents} is non-@code{nil},
and returns @code{nil} if it successfully created @var{dirname}.
@code{mkdir} is an alias for this.
@end deffn

View file

@ -4486,6 +4486,11 @@ and cannot work with regular styles such as 'basic' or 'flex'.
** Magic file handlers for make-directory-internal are no longer needed.
Instead, Emacs uses the already-existing make-directory handlers.
+++
** (make-directory DIR t) returns non-nil if DIR already exists.
This can let a caller know whether it created DIR. Formerly,
make-directory's return value was unspecified.
* Changes in Emacs 29.1 on Non-Free Operating Systems

View file

@ -6193,18 +6193,17 @@ instance of such commands."
(rename-buffer (generate-new-buffer-name base-name))
(force-mode-line-update))))
(defun files--ensure-directory (dir)
"Make directory DIR if it is not already a directory. Return nil."
(defun files--ensure-directory (mkdir dir)
"Use function MKDIR to make directory DIR if it is not already a directory.
Return non-nil if DIR is already a directory."
(condition-case err
(make-directory-internal dir)
(funcall mkdir dir)
(error
(unless (file-directory-p dir)
(signal (car err) (cdr err))))))
(or (file-directory-p dir)
(signal (car err) (cdr err))))))
(defun make-directory (dir &optional parents)
"Create the directory DIR and optionally any nonexistent parent dirs.
If DIR already exists as a directory, signal an error, unless
PARENTS is non-nil.
Interactively, the default choice of directory to create is the
current buffer's default directory. That is useful when you have
@ -6214,8 +6213,9 @@ Noninteractively, the second (optional) argument PARENTS, if
non-nil, says whether to create parent directories that don't
exist. Interactively, this happens by default.
If creating the directory or directories fail, an error will be
raised."
Return non-nil if PARENTS is non-nil and DIR already exists as a
directory, and nil if DIR did not already exist but was created.
Signal an error if unsuccessful."
(interactive
(list (read-file-name "Make directory: " default-directory default-directory
nil nil)
@ -6223,25 +6223,27 @@ raised."
;; If default-directory is a remote directory,
;; make sure we find its make-directory handler.
(setq dir (expand-file-name dir))
(let ((handler (find-file-name-handler dir 'make-directory)))
(if handler
(funcall handler 'make-directory dir parents)
(if (not parents)
(make-directory-internal dir)
(let ((dir (directory-file-name (expand-file-name dir)))
create-list parent)
(while (progn
(setq parent (directory-file-name
(file-name-directory dir)))
(condition-case ()
(files--ensure-directory dir)
(file-missing
;; Do not loop if root does not exist (Bug#2309).
(not (string= dir parent)))))
(setq create-list (cons dir create-list)
dir parent))
(dolist (dir create-list)
(files--ensure-directory dir)))))))
(let ((mkdir (if-let ((handler (find-file-name-handler dir 'make-directory)))
#'(lambda (dir) (funcall handler 'make-directory dir))
#'make-directory-internal)))
(if (not parents)
(funcall mkdir dir)
(let ((dir (directory-file-name (expand-file-name dir)))
already-dir create-list parent)
(while (progn
(setq parent (directory-file-name
(file-name-directory dir)))
(condition-case ()
(ignore (setq already-dir
(files--ensure-directory mkdir dir)))
(error
;; Do not loop if root does not exist (Bug#2309).
(not (string= dir parent)))))
(setq create-list (cons dir create-list)
dir parent))
(dolist (dir create-list)
(setq already-dir (files--ensure-directory mkdir dir)))
already-dir))))
(defun make-empty-file (filename &optional parents)
"Create an empty file FILENAME.

View file

@ -1261,11 +1261,11 @@ works as expected if the default directory is quoted."
(a/b (concat dirname "a/b")))
(write-region "" nil file)
(should-error (make-directory "/"))
(should-not (make-directory "/" t))
(should (make-directory "/" t))
(should-error (make-directory dir))
(should-not (make-directory dir t))
(should (make-directory dir t))
(should-error (make-directory dirname))
(should-not (make-directory dirname t))
(should (make-directory dirname t))
(should-error (make-directory file))
(should-error (make-directory file t))
(should-not (make-directory subdir1))