diff options
| -rw-r--r-- | lisp/net/tramp-compat.el | 17 | ||||
| -rw-r--r-- | lisp/net/tramp-gvfs.el | 24 | ||||
| -rw-r--r-- | lisp/net/tramp-smb.el | 17 | ||||
| -rw-r--r-- | test/lisp/net/tramp-tests.el | 6 |
4 files changed, 35 insertions, 29 deletions
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 0e9fcb501a7..c84fb5ac428 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el | |||
| @@ -174,8 +174,7 @@ Add the extension of F, if existing." | |||
| 174 | (tramp-compat-copy-directory file newname keep-time parents) | 174 | (tramp-compat-copy-directory file newname keep-time parents) |
| 175 | (copy-file file newname t keep-time))) | 175 | (copy-file file newname t keep-time))) |
| 176 | ;; We do not want to delete "." and "..". | 176 | ;; We do not want to delete "." and "..". |
| 177 | (directory-files | 177 | (directory-files directory 'full directory-files-no-dot-files-regexp)) |
| 178 | directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")) | ||
| 179 | 178 | ||
| 180 | ;; Set directory attributes. | 179 | ;; Set directory attributes. |
| 181 | (set-file-modes newname (file-modes directory)) | 180 | (set-file-modes newname (file-modes directory)) |
| @@ -209,13 +208,13 @@ Add the extension of F, if existing." | |||
| 209 | ;; implementation from Emacs 23.2. | 208 | ;; implementation from Emacs 23.2. |
| 210 | (wrong-number-of-arguments | 209 | (wrong-number-of-arguments |
| 211 | (setq directory (directory-file-name (expand-file-name directory))) | 210 | (setq directory (directory-file-name (expand-file-name directory))) |
| 212 | (if (not (file-symlink-p directory)) | 211 | (when (not (file-symlink-p directory)) |
| 213 | (mapc (lambda (file) | 212 | (mapc (lambda (file) |
| 214 | (if (eq t (car (file-attributes file))) | 213 | (if (eq t (car (file-attributes file))) |
| 215 | (tramp-compat-delete-directory file recursive trash) | 214 | (tramp-compat-delete-directory file recursive trash) |
| 216 | (tramp-compat-delete-file file trash))) | 215 | (tramp-compat-delete-file file trash))) |
| 217 | (directory-files | 216 | (directory-files |
| 218 | directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))) | 217 | directory 'full directory-files-no-dot-files-regexp))) |
| 219 | (delete-directory directory)))) | 218 | (delete-directory directory)))) |
| 220 | 219 | ||
| 221 | (defun tramp-compat-process-running-p (process-name) | 220 | (defun tramp-compat-process-running-p (process-name) |
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 8e7ef0f4079..a22bd89fe90 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el | |||
| @@ -746,14 +746,18 @@ file names." | |||
| 746 | 746 | ||
| 747 | (defun tramp-gvfs-handle-delete-directory (directory &optional recursive trash) | 747 | (defun tramp-gvfs-handle-delete-directory (directory &optional recursive trash) |
| 748 | "Like `delete-directory' for Tramp files." | 748 | "Like `delete-directory' for Tramp files." |
| 749 | (when (and recursive (not (file-symlink-p directory))) | ||
| 750 | (mapc (lambda (file) | ||
| 751 | (if (eq t (car (file-attributes file))) | ||
| 752 | (tramp-compat-delete-directory file recursive trash) | ||
| 753 | (tramp-compat-delete-file file trash))) | ||
| 754 | (directory-files | ||
| 755 | directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))) | ||
| 756 | (with-parsed-tramp-file-name directory nil | 749 | (with-parsed-tramp-file-name directory nil |
| 750 | (if (and recursive (not (file-symlink-p directory))) | ||
| 751 | (mapc (lambda (file) | ||
| 752 | (if (eq t (car (file-attributes file))) | ||
| 753 | (tramp-compat-delete-directory file recursive trash) | ||
| 754 | (tramp-compat-delete-file file trash))) | ||
| 755 | (directory-files | ||
| 756 | directory 'full directory-files-no-dot-files-regexp)) | ||
| 757 | (when (directory-files directory nil directory-files-no-dot-files-regexp) | ||
| 758 | (tramp-error | ||
| 759 | v 'file-error "Couldn't delete non-empty %s" directory))) | ||
| 760 | |||
| 757 | (tramp-flush-file-property v (file-name-directory localname)) | 761 | (tramp-flush-file-property v (file-name-directory localname)) |
| 758 | (tramp-flush-directory-property v localname) | 762 | (tramp-flush-directory-property v localname) |
| 759 | (unless | 763 | (unless |
| @@ -1409,7 +1413,7 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"." | |||
| 1409 | signal-name (tramp-gvfs-stringify-dbus-message mount-info)) | 1413 | signal-name (tramp-gvfs-stringify-dbus-message mount-info)) |
| 1410 | (tramp-set-file-property v "/" "list-mounts" 'undef) | 1414 | (tramp-set-file-property v "/" "list-mounts" 'undef) |
| 1411 | (if (string-equal (downcase signal-name) "unmounted") | 1415 | (if (string-equal (downcase signal-name) "unmounted") |
| 1412 | (tramp-set-file-property v "/" "fuse-mountpoint" nil) | 1416 | (tramp-flush-file-property v "/") |
| 1413 | ;; Set prefix, mountpoint and location. | 1417 | ;; Set prefix, mountpoint and location. |
| 1414 | (unless (string-equal prefix "/") | 1418 | (unless (string-equal prefix "/") |
| 1415 | (tramp-set-file-property v "/" "prefix" prefix)) | 1419 | (tramp-set-file-property v "/" "prefix" prefix)) |
| @@ -1701,7 +1705,9 @@ COMMAND is usually a command from the gvfs-* utilities. | |||
| 1701 | (with-current-buffer (tramp-get-connection-buffer vec) | 1705 | (with-current-buffer (tramp-get-connection-buffer vec) |
| 1702 | (tramp-gvfs-maybe-open-connection vec) | 1706 | (tramp-gvfs-maybe-open-connection vec) |
| 1703 | (erase-buffer) | 1707 | (erase-buffer) |
| 1704 | (zerop (apply 'tramp-call-process vec command nil t nil args))))) | 1708 | (or (zerop (apply 'tramp-call-process vec command nil t nil args)) |
| 1709 | ;; Remove information about mounted connection. | ||
| 1710 | (and (tramp-flush-file-property vec "/") nil))))) | ||
| 1705 | 1711 | ||
| 1706 | 1712 | ||
| 1707 | ;; D-Bus BLUEZ functions. | 1713 | ;; D-Bus BLUEZ functions. |
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index a526fd93ab4..1c43ce2f097 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el | |||
| @@ -597,15 +597,14 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." | |||
| 597 | "Like `delete-directory' for Tramp files." | 597 | "Like `delete-directory' for Tramp files." |
| 598 | (setq directory (directory-file-name (expand-file-name directory))) | 598 | (setq directory (directory-file-name (expand-file-name directory))) |
| 599 | (when (file-exists-p directory) | 599 | (when (file-exists-p directory) |
| 600 | (if recursive | 600 | (when recursive |
| 601 | (mapc | 601 | (mapc |
| 602 | (lambda (file) | 602 | (lambda (file) |
| 603 | (if (file-directory-p file) | 603 | (if (file-directory-p file) |
| 604 | (delete-directory file recursive) | 604 | (delete-directory file recursive) |
| 605 | (delete-file file))) | 605 | (delete-file file))) |
| 606 | ;; We do not want to delete "." and "..". | 606 | ;; We do not want to delete "." and "..". |
| 607 | (directory-files | 607 | (directory-files directory 'full directory-files-no-dot-files-regexp))) |
| 608 | directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))) | ||
| 609 | 608 | ||
| 610 | (with-parsed-tramp-file-name directory nil | 609 | (with-parsed-tramp-file-name directory nil |
| 611 | ;; We must also flush the cache of the directory, because | 610 | ;; We must also flush the cache of the directory, because |
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index fe927bb25fd..f1f722b272b 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el | |||
| @@ -115,8 +115,8 @@ being the result.") | |||
| 115 | (defmacro tramp--instrument-test-case (verbose &rest body) | 115 | (defmacro tramp--instrument-test-case (verbose &rest body) |
| 116 | "Run BODY with `tramp-verbose' equal VERBOSE. | 116 | "Run BODY with `tramp-verbose' equal VERBOSE. |
| 117 | Print the the content of the Tramp debug buffer, if BODY does not | 117 | Print the the content of the Tramp debug buffer, if BODY does not |
| 118 | eval properly in `should', `should-not' or `should-error'. BODY | 118 | eval properly in `should' or `should-not'. `should-error' is not |
| 119 | shall not contain a timeout." | 119 | handled properly. BODY shall not contain a timeout." |
| 120 | (declare (indent 1) (debug (natnump body))) | 120 | (declare (indent 1) (debug (natnump body))) |
| 121 | `(let ((tramp-verbose ,verbose) | 121 | `(let ((tramp-verbose ,verbose) |
| 122 | (tramp-debug-on-error t) | 122 | (tramp-debug-on-error t) |
| @@ -951,7 +951,9 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." | |||
| 951 | (should-not (file-directory-p tmp-name)) | 951 | (should-not (file-directory-p tmp-name)) |
| 952 | ;; Delete non-empty directory. | 952 | ;; Delete non-empty directory. |
| 953 | (make-directory tmp-name) | 953 | (make-directory tmp-name) |
| 954 | (should (file-directory-p tmp-name)) | ||
| 954 | (write-region "foo" nil (expand-file-name "bla" tmp-name)) | 955 | (write-region "foo" nil (expand-file-name "bla" tmp-name)) |
| 956 | (should (file-exists-p (expand-file-name "bla" tmp-name))) | ||
| 955 | (should-error (delete-directory tmp-name)) | 957 | (should-error (delete-directory tmp-name)) |
| 956 | (delete-directory tmp-name 'recursive) | 958 | (delete-directory tmp-name 'recursive) |
| 957 | (should-not (file-directory-p tmp-name)))) | 959 | (should-not (file-directory-p tmp-name)))) |