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 @var{parents} is non-@code{nil}, as is always the case in an
interactive call, that means to create the parent directories first, interactive call, that means to create the parent directories first,
if they don't already exist. 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. @code{mkdir} is an alias for this.
@end deffn @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. ** Magic file handlers for make-directory-internal are no longer needed.
Instead, Emacs uses the already-existing make-directory handlers. 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 * 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)) (rename-buffer (generate-new-buffer-name base-name))
(force-mode-line-update)))) (force-mode-line-update))))
(defun files--ensure-directory (dir) (defun files--ensure-directory (mkdir dir)
"Make directory DIR if it is not already a directory. Return nil." "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 (condition-case err
(make-directory-internal dir) (funcall mkdir dir)
(error (error
(unless (file-directory-p dir) (or (file-directory-p dir)
(signal (car err) (cdr err)))))) (signal (car err) (cdr err))))))
(defun make-directory (dir &optional parents) (defun make-directory (dir &optional parents)
"Create the directory DIR and optionally any nonexistent parent dirs. "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 Interactively, the default choice of directory to create is the
current buffer's default directory. That is useful when you have 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 non-nil, says whether to create parent directories that don't
exist. Interactively, this happens by default. exist. Interactively, this happens by default.
If creating the directory or directories fail, an error will be Return non-nil if PARENTS is non-nil and DIR already exists as a
raised." directory, and nil if DIR did not already exist but was created.
Signal an error if unsuccessful."
(interactive (interactive
(list (read-file-name "Make directory: " default-directory default-directory (list (read-file-name "Make directory: " default-directory default-directory
nil nil) nil nil)
@ -6223,25 +6223,27 @@ raised."
;; If default-directory is a remote directory, ;; If default-directory is a remote directory,
;; make sure we find its make-directory handler. ;; make sure we find its make-directory handler.
(setq dir (expand-file-name dir)) (setq dir (expand-file-name dir))
(let ((handler (find-file-name-handler dir 'make-directory))) (let ((mkdir (if-let ((handler (find-file-name-handler dir 'make-directory)))
(if handler #'(lambda (dir) (funcall handler 'make-directory dir))
(funcall handler 'make-directory dir parents) #'make-directory-internal)))
(if (not parents) (if (not parents)
(make-directory-internal dir) (funcall mkdir dir)
(let ((dir (directory-file-name (expand-file-name dir))) (let ((dir (directory-file-name (expand-file-name dir)))
create-list parent) already-dir create-list parent)
(while (progn (while (progn
(setq parent (directory-file-name (setq parent (directory-file-name
(file-name-directory dir))) (file-name-directory dir)))
(condition-case () (condition-case ()
(files--ensure-directory dir) (ignore (setq already-dir
(file-missing (files--ensure-directory mkdir dir)))
;; Do not loop if root does not exist (Bug#2309). (error
(not (string= dir parent))))) ;; Do not loop if root does not exist (Bug#2309).
(setq create-list (cons dir create-list) (not (string= dir parent)))))
dir parent)) (setq create-list (cons dir create-list)
(dolist (dir create-list) dir parent))
(files--ensure-directory dir))))))) (dolist (dir create-list)
(setq already-dir (files--ensure-directory mkdir dir)))
already-dir))))
(defun make-empty-file (filename &optional parents) (defun make-empty-file (filename &optional parents)
"Create an empty file FILENAME. "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"))) (a/b (concat dirname "a/b")))
(write-region "" nil file) (write-region "" nil file)
(should-error (make-directory "/")) (should-error (make-directory "/"))
(should-not (make-directory "/" t)) (should (make-directory "/" t))
(should-error (make-directory dir)) (should-error (make-directory dir))
(should-not (make-directory dir t)) (should (make-directory dir t))
(should-error (make-directory dirname)) (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))
(should-error (make-directory file t)) (should-error (make-directory file t))
(should-not (make-directory subdir1)) (should-not (make-directory subdir1))