[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
emacs-29 bef1edc9ca 2/4: make-directory now returns t if dir already exi
From: |
Paul Eggert |
Subject: |
emacs-29 bef1edc9ca 2/4: make-directory now returns t if dir already exists |
Date: |
Sat, 17 Dec 2022 17:24:26 -0500 (EST) |
branch: emacs-29
commit bef1edc9cacb976120dff73b4d7bbdce6ade982b
Author: Paul Eggert <eggert@cs.ucla.edu>
Commit: Paul Eggert <eggert@cs.ucla.edu>
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.
---
doc/lispref/files.texi | 3 +++
etc/NEWS | 5 +++++
lisp/files.el | 58 +++++++++++++++++++++++++-----------------------
test/lisp/files-tests.el | 6 ++---
4 files changed, 41 insertions(+), 31 deletions(-)
diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi
index b3f63b8f32..a767f9c28d 100644
--- a/doc/lispref/files.texi
+++ b/doc/lispref/files.texi
@@ -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
diff --git a/etc/NEWS b/etc/NEWS
index 72421b0319..c5820a5f04 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -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
diff --git a/lisp/files.el b/lisp/files.el
index c74e7e808e..235eacee70 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -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.
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index efafb5583a..b9fbeb8a4e 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -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))