master d3f1682ae9: Handle make-directory return values in file name handlers

[Michael Albinus]

branch: master
commit d3f1682ae9f95ee912d9bc5a2ab5c58659abf065
Author: Michael Albinus <michael.albinus@gmx.de>
Commit: Michael Albinus <michael.albinus@gmx.de>

    Handle make-directory return values in file name handlers
    
    * lisp/net/ange-ftp.el (ange-ftp-make-directory): Handle return
    values.
    
    * lisp/net/tramp.el (tramp-skeleton-make-directory): New defmacro.
    Handle also return values.
    * lisp/net/tramp-adb.el (tramp-adb-handle-make-directory):
    * lisp/net/tramp-crypt.el (tramp-crypt-handle-make-directory):
    * lisp/net/tramp-fuse.el (tramp-fuse-handle-make-directory):
    * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-make-directory):
    * lisp/net/tramp-sh.el (tramp-sh-handle-make-directory):
    * lisp/net/tramp-smb.el (tramp-smb-handle-make-directory):
    * lisp/net/tramp-sudoedit.el (tramp-sudoedit-handle-make-directory):
    Use it.
    
    * test/lisp/net/tramp-tests.el (tramp-test13-make-directory):
    Handle return values.
---
 lisp/net/ange-ftp.el         |  5 +++--
 lisp/net/tramp-adb.el        | 19 +++++--------------
 lisp/net/tramp-crypt.el      | 11 ++---------
 lisp/net/tramp-fuse.el       | 10 ++--------
 lisp/net/tramp-gvfs.el       | 26 ++++++--------------------
 lisp/net/tramp-sh.el         | 13 ++-----------
 lisp/net/tramp-smb.el        | 32 ++++++++------------------------
 lisp/net/tramp-sudoedit.el   | 13 ++-----------
 lisp/net/tramp.el            | 21 +++++++++++++++++++++
 test/lisp/net/tramp-tests.el | 15 +++++++++++----
 10 files changed, 62 insertions(+), 103 deletions(-)

diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el
index 9781ebf863..f8e2858bc3 100644
--- a/lisp/net/ange-ftp.el
+++ b/lisp/net/ange-ftp.el
@@ -4129,7 +4129,7 @@ directory, so that Emacs will know its current contents."
        (or (file-exists-p parent)
            (ange-ftp-make-directory parent parents))))
   (if (file-exists-p dir)
-      (unless parents
+      (if parents t
        (signal
          'file-already-exists
          (list "Cannot make directory: file already exists" dir)))
@@ -4158,7 +4158,8 @@ directory, so that Emacs will know its current contents."
                                (format "Could not make directory %s: %s"
                                        dir
                                        (cdr result))))
-           (ange-ftp-add-file-entry dir t))
+           (ange-ftp-add-file-entry dir t)
+            nil)
        (ange-ftp-real-make-directory dir)))))
 
 (defun ange-ftp-delete-directory (dir &optional recursive trash)
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 90020fbb1b..5a025130ec 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -411,20 +411,11 @@ Emacs dired can't find files."
 
 (defun tramp-adb-handle-make-directory (dir &optional parents)
   "Like `make-directory' for Tramp files."
-  (setq dir (expand-file-name dir))
-  (with-parsed-tramp-file-name dir nil
-    (when (and (null parents) (file-exists-p dir))
-      (tramp-error v 'file-already-exists dir))
-    (when parents
-      (let ((par (expand-file-name ".." dir)))
-       (unless (file-directory-p par)
-         (make-directory par parents))))
-    (tramp-flush-directory-properties v localname)
-    (unless (or (tramp-adb-send-command-and-check
-                v (format "mkdir -m %#o %s"
-                          (default-file-modes)
-                          (tramp-shell-quote-argument localname)))
-               (and parents (file-directory-p dir)))
+  (tramp-skeleton-make-directory dir parents
+    (unless (tramp-adb-send-command-and-check
+            v (format "mkdir -m %#o %s"
+                      (default-file-modes)
+                      (tramp-shell-quote-argument localname)))
       (tramp-error v 'file-error "Couldn't make directory %s" dir))))
 
 (defun tramp-adb-handle-delete-directory (directory &optional recursive trash)
diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el
index 249b3fcd4d..e6c0ebccbf 100644
--- a/lisp/net/tramp-crypt.el
+++ b/lisp/net/tramp-crypt.el
@@ -800,16 +800,9 @@ WILDCARD is not supported."
 
 (defun tramp-crypt-handle-make-directory (dir &optional parents)
   "Like `make-directory' for Tramp files."
-  (with-parsed-tramp-file-name (expand-file-name dir) nil
-    (when (and (null parents) (file-exists-p dir))
-      (tramp-error v 'file-already-exists dir))
+  (tramp-skeleton-make-directory dir parents
     (let (tramp-crypt-enabled)
-      (make-directory (tramp-crypt-encrypt-file-name dir) parents))
-    ;; When PARENTS is non-nil, DIR could be a chain of non-existent
-    ;; directories a/b/c/...  Instead of checking, we simply flush the
-    ;; whole cache.
-    (tramp-flush-directory-properties
-     v (if parents "/" (file-name-directory localname)))))
+      (make-directory (tramp-crypt-encrypt-file-name dir) parents))))
 
 (defun tramp-crypt-handle-rename-file
   (filename newname &optional ok-if-already-exists)
diff --git a/lisp/net/tramp-fuse.el b/lisp/net/tramp-fuse.el
index ea6b5a0622..5176c6e9c4 100644
--- a/lisp/net/tramp-fuse.el
+++ b/lisp/net/tramp-fuse.el
@@ -127,14 +127,8 @@
 
 (defun tramp-fuse-handle-make-directory (dir &optional parents)
   "Like `make-directory' for Tramp files."
-  (with-parsed-tramp-file-name (expand-file-name dir) nil
-    (make-directory (tramp-fuse-local-file-name dir) parents)
-    ;; When PARENTS is non-nil, DIR could be a chain of non-existent
-    ;; directories a/b/c/...  Instead of checking, we simply flush the
-    ;; whole file cache.
-    (tramp-flush-file-properties v localname)
-    (tramp-flush-directory-properties
-     v (if parents "/" (file-name-directory localname)))))
+  (tramp-skeleton-make-directory dir parents
+    (make-directory (tramp-fuse-local-file-name dir) parents)))
 
 
 ;; File name helper functions.
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index da7641774f..66f4de989d 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -1560,27 +1560,13 @@ If FILE-SYSTEM is non-nil, return file system 
attributes."
 
 (defun tramp-gvfs-handle-make-directory (dir &optional parents)
   "Like `make-directory' for Tramp files."
-  (setq dir (directory-file-name (expand-file-name dir)))
-  (with-parsed-tramp-file-name dir nil
-    (when (and (null parents) (file-exists-p dir))
-      (tramp-error v 'file-already-exists dir))
-    (tramp-flush-directory-properties v localname)
+  (tramp-skeleton-make-directory dir parents
     (save-match-data
-      (let ((ldir (file-name-directory dir)))
-       ;; Make missing directory parts.  "gvfs-mkdir -p ..." does not
-       ;; work robust.
-       (when (and parents (not (file-directory-p ldir)))
-         (make-directory ldir parents))
-       ;; Just do it.
-       (or (when-let ((mkdir-succeeded
-                       (and
-                        (tramp-gvfs-send-command
-                         v "gvfs-mkdir" (tramp-gvfs-url-file-name dir))
-                        (tramp-gvfs-info dir))))
-             (set-file-modes dir (default-file-modes))
-             mkdir-succeeded)
-           (and parents (file-directory-p dir))
-           (tramp-error v 'file-error "Couldn't make directory %s" dir))))))
+      (if (and (tramp-gvfs-send-command
+               v "gvfs-mkdir" (tramp-gvfs-url-file-name dir))
+              (tramp-gvfs-info dir))
+         (set-file-modes dir (default-file-modes))
+       (tramp-error v 'file-error "Couldn't make directory %s" dir)))))
 
 (defun tramp-gvfs-handle-rename-file
   (filename newname &optional ok-if-already-exists)
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 6087f16431..19c160f4d6 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -2559,19 +2559,10 @@ The method used must be an out-of-band method."
 
 (defun tramp-sh-handle-make-directory (dir &optional parents)
   "Like `make-directory' for Tramp files."
-  (setq dir (expand-file-name dir))
-  (with-parsed-tramp-file-name dir nil
-    (when (and (null parents) (file-exists-p dir))
-      (tramp-error v 'file-already-exists dir))
-    ;; When PARENTS is non-nil, DIR could be a chain of non-existent
-    ;; directories a/b/c/...  Instead of checking, we simply flush the
-    ;; whole cache.
-    (tramp-flush-directory-properties
-     v (if parents "/" (file-name-directory localname)))
+  (tramp-skeleton-make-directory dir parents
     (tramp-barf-unless-okay
      v (format "%s -m %#o %s"
-              (if parents "mkdir -p" "mkdir")
-              (default-file-modes)
+              "mkdir" (default-file-modes)
               (tramp-shell-quote-argument localname))
      "Couldn't make directory %s" dir)))
 
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index cd73b9b8ec..b51f42deb4 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -1172,30 +1172,14 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are 
completely ignored."
 
 (defun tramp-smb-handle-make-directory (dir &optional parents)
   "Like `make-directory' for Tramp files."
-  (setq dir (directory-file-name (expand-file-name dir)))
-  (unless (file-name-absolute-p dir)
-    (setq dir (expand-file-name dir default-directory)))
-  (with-parsed-tramp-file-name dir nil
-    (when (and (null parents) (file-exists-p dir))
-      (tramp-error v 'file-already-exists dir))
-    (let* ((ldir (file-name-directory dir)))
-      ;; Make missing directory parts.
-      (when (and parents
-                (tramp-smb-get-share v)
-                (not (file-directory-p ldir)))
-       (make-directory ldir parents))
-      ;; Just do it.
-      (when (file-directory-p ldir)
-       (tramp-smb-send-command
-        v (if (tramp-smb-get-cifs-capabilities v)
-              (format "posix_mkdir %s %o"
-                      (tramp-smb-shell-quote-localname v) (default-file-modes))
-            (format "mkdir %s" (tramp-smb-shell-quote-localname v))))
-       ;; We must also flush the cache of the directory, because
-       ;; `file-attributes' reads the values from there.
-       (tramp-flush-file-properties v localname))
-      (unless (file-directory-p dir)
-       (tramp-error v 'file-error "Couldn't make directory %s" dir)))))
+  (tramp-skeleton-make-directory dir parents
+    (tramp-smb-send-command
+     v (if (tramp-smb-get-cifs-capabilities v)
+          (format "posix_mkdir %s %o"
+                  (tramp-smb-shell-quote-localname v) (default-file-modes))
+        (format "mkdir %s" (tramp-smb-shell-quote-localname v))))
+    (unless (file-directory-p dir)
+      (tramp-error v 'file-error "Couldn't make directory %s" dir))))
 
 ;; This is not used anymore.
 (defun tramp-smb-handle-make-directory-internal (directory)
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el
index fcc27dd834..8774367cef 100644
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -626,18 +626,9 @@ the result will be a local, non-Tramp, file name."
 
 (defun tramp-sudoedit-handle-make-directory (dir &optional parents)
   "Like `make-directory' for Tramp files."
-  (setq dir (expand-file-name dir))
-  (with-parsed-tramp-file-name dir nil
-    (when (and (null parents) (file-exists-p dir))
-      (tramp-error v 'file-already-exists "Directory already exists %s" dir))
-    ;; When PARENTS is non-nil, DIR could be a chain of non-existent
-    ;; directories a/b/c/...  Instead of checking, we simply flush the
-    ;; whole cache.
-    (tramp-flush-directory-properties
-     v (if parents "/" (file-name-directory localname)))
+  (tramp-skeleton-make-directory dir parents
     (unless (tramp-sudoedit-send-command
-            v (if parents '("mkdir" "-p") "mkdir")
-            "-m" (format "%#o" (default-file-modes))
+            v "mkdir" "-m" (format "%#o" (default-file-modes))
             (tramp-compat-file-name-unquote localname))
       (tramp-error v 'file-error "Couldn't make directory %s" dir))))
 
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index ca8963fbf5..e39c9ccc31 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -3537,6 +3537,27 @@ BODY is the backend specific code."
        ;; Trigger the `file-missing' error.
        (signal 'error nil)))))
 
+(defmacro tramp-skeleton-make-directory (dir &optional parents &rest body)
+  "Skeleton for `tramp-*-handle-make-directory'.
+BODY is the backend specific code."
+  ;; Since Emacs 29.1, PARENTS isn't propagated to the handlers
+  ;; anymore.  And the return values are specified since then as well.
+  (declare (indent 2) (debug t))
+  `(let* ((dir (directory-file-name (expand-file-name ,dir)))
+         (par (file-name-directory dir)))
+     (with-parsed-tramp-file-name dir nil
+       (when (and (null ,parents) (file-exists-p dir))
+        (tramp-error v 'file-already-exists dir))
+       ;; Make missing directory parts.
+       (when ,parents
+        (unless (file-directory-p par)
+          (make-directory par ,parents)))
+       ;; Just do it.
+       (if (file-exists-p dir) t
+        (tramp-flush-file-properties v localname)
+        ,@body
+        nil))))
+
 (defmacro tramp-skeleton-set-file-modes-times-uid-gid
     (filename &rest body)
   "Skeleton for `tramp-*-set-file-{modes,times,uid-gid}'.
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 79b2fc803d..d7f4576335 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -2857,6 +2857,7 @@ This checks also `file-name-as-directory', 
`file-name-directory',
 This tests also `file-directory-p' and `file-accessible-directory-p'."
   (skip-unless (tramp--test-enabled))
 
+  ;; Since Emacs 29.1, `make-directory' has defined return values.
   (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
     (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted))
           (tmp-name2 (expand-file-name "foo/bar" tmp-name1))
@@ -2865,7 +2866,9 @@ This tests also `file-directory-p' and 
`file-accessible-directory-p'."
       (unwind-protect
          (progn
            (with-file-modes unusual-file-mode-1
-             (make-directory tmp-name1))
+             (if (tramp--test-emacs29-p)
+                 (should-not (make-directory tmp-name1))
+               (make-directory tmp-name1)))
            (should-error
             (make-directory tmp-name1)
             :type 'file-already-exists)
@@ -2878,15 +2881,19 @@ This tests also `file-directory-p' and 
`file-accessible-directory-p'."
             (make-directory tmp-name2)
             :type 'file-error)
            (with-file-modes unusual-file-mode-2
-             (make-directory tmp-name2 'parents))
+             (if (tramp--test-emacs29-p)
+                 (should-not (make-directory tmp-name2 'parents))
+               (make-directory tmp-name2 'parents)))
            (should (file-directory-p tmp-name2))
            (should (file-accessible-directory-p tmp-name2))
            (when (tramp--test-supports-set-file-modes-p)
              (should (equal (format "%#o" unusual-file-mode-2)
                             (format "%#o" (file-modes tmp-name2)))))
            ;; If PARENTS is non-nil, `make-directory' shall not
-           ;; signal an error when DIR exists already.
-           (make-directory tmp-name2 'parents))
+           ;; signal an error when DIR exists already.  It returns t.
+           (if (tramp--test-emacs29-p)
+               (should (make-directory tmp-name2 'parents))
+             (make-directory tmp-name2 'parents)))
 
        ;; Cleanup.
        (ignore-errors (delete-directory tmp-name1 'recursive))))))