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.

4 files changed, 41 insertions, 31 deletions

diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi
index b3f63b8f32a..a767f9c28d5 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 72421b03191..c5820a5f045 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 c74e7e808e4..235eacee704 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 efafb5583ac..b9fbeb8a4e0 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))