]> git.eshelyaron.com Git - emacs.git/commitdiff
Handle make-directory return values in file name handlers
authorMichael Albinus <michael.albinus@gmx.de>
Thu, 22 Dec 2022 18:39:59 +0000 (19:39 +0100)
committerMichael Albinus <michael.albinus@gmx.de>
Thu, 22 Dec 2022 18:39:59 +0000 (19:39 +0100)
* 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
lisp/net/tramp-adb.el
lisp/net/tramp-crypt.el
lisp/net/tramp-fuse.el
lisp/net/tramp-gvfs.el
lisp/net/tramp-sh.el
lisp/net/tramp-smb.el
lisp/net/tramp-sudoedit.el
lisp/net/tramp.el
test/lisp/net/tramp-tests.el

index 9781ebf863a8cbea8916c36a1df8ccc24656642b..f8e2858bc3f0cc77d2d5d7b820b46046f85c9206 100644 (file)
@@ -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)
index 90020fbb1b642afe34634e032293219c3906fd93..5a025130ecf6c14d417af086ba8c54efe72fafe3 100644 (file)
@@ -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)
index 249b3fcd4d79a5228d4d34de01088f9edc27c13b..e6c0ebccbff95b449b784d4465b1c5fc2538b5c0 100644 (file)
@@ -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)
index ea6b5a0622cc0c594d67c4a432a5c5b96b8f06b5..5176c6e9c48e55d3515ed6b1358c5954b13bb02d 100644 (file)
 
 (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)))
 
 \f
 ;; File name helper functions.
index da7641774fbe96a39dbfd9ca3f48d9ca4f0dd96d..66f4de989d02aa70a4cc38ca79f6340c77fe0b32 100644 (file)
@@ -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)
index 6087f16431e643bc4d09cf7d258b5391b6c38ece..19c160f4d6d8b1bd8eac70418cf52b748064a4c3 100644 (file)
@@ -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)))
 
index cd73b9b8ecaad967a2df6d6463f15b7ee302db56..b51f42deb4541dfb4d2c01e662938062b898a3b0 100644 (file)
@@ -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)
index fcc27dd83432004d5b09dc193e791ab1c43b08bd..8774367cefe73d1195d7b8ac39a8310153204cca 100644 (file)
@@ -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))))
 
index ca8963fbf548741e63d4fb7b164e7c9322f78994..e39c9ccc31aa98aeec40bcad30e9ee3967ea2e3a 100644 (file)
@@ -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}'.
index 79b2fc803d6be6c6e3067ec109d4b681c1553730..d7f4576335c83e411be0a442e2aae9d3717557ac 100644 (file)
@@ -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))))))