[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master 704fd2a: delete-directory no longer errors when rac
From: |
Paul Eggert |
Subject: |
[Emacs-diffs] master 704fd2a: delete-directory no longer errors when racing |
Date: |
Tue, 18 Oct 2016 16:37:17 +0000 (UTC) |
branch: master
commit 704fd2a7ae5087f4108cc7a821f856fcdac99eb4
Author: Paul Eggert <address@hidden>
Commit: Paul Eggert <address@hidden>
delete-directory no longer errors when racing
Problem reported by Glenn Morris for package-test.el (Bug#24714).
* doc/lispref/files.texi (Create/Delete Dirs), etc/NEWS: Document this.
* lisp/files.el (files--force): New function.
(delete-directory): Use it to avoid error in this case.
---
doc/lispref/files.texi | 3 +++
etc/NEWS | 5 +++++
lisp/files.el | 46 +++++++++++++++++++++++++++++++---------------
3 files changed, 39 insertions(+), 15 deletions(-)
diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi
index 9af5ce9..62e0199 100644
--- a/doc/lispref/files.texi
+++ b/doc/lispref/files.texi
@@ -2855,6 +2855,9 @@ This command deletes the directory named @var{dirname}.
The function
must use @code{delete-directory} for them. If @var{recursive} is
@code{nil}, and the directory contains any files,
@code{delete-directory} signals an error.
+If recursive is address@hidden, there is no error merely because the
+directory or its files are deleted by some other process before
address@hidden gets to them.
@code{delete-directory} only follows symbolic links at the level of
parent directories.
diff --git a/etc/NEWS b/etc/NEWS
index 1fd2a00..c5245bc 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -619,6 +619,11 @@ collection).
** The new functions 'make-nearby-temp-file' and 'temporary-file-directory'
can be used for creation of temporary files of remote or mounted directories.
++++
+** The function 'delete-directory' no longer signals an error when
+operating recursively and when some other process deletes the directory
+or its files before 'delete-directory' gets to them.
+
** Changes in Frame- and Window- Handling
+++
diff --git a/lisp/files.el b/lisp/files.el
index f481b99..12c6c14 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -5336,14 +5336,26 @@ raised."
"^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"
"Regexp matching any file name except \".\" and \"..\".")
+(defun files--force (no-such fn &rest args)
+ "Use NO-SUCH to affect behavior of function FN applied to list ARGS.
+This acts like (apply FN ARGS) except it returns NO-SUCH if it is
+non-nil and if FN fails due to a missing file or directory."
+ (condition-case err
+ (apply fn args)
+ (file-error
+ (or (pcase err (`(,_ ,_ "No such file or directory" . ,_) no-such))
+ (signal (car err) (cdr err))))))
+
(defun delete-directory (directory &optional recursive trash)
"Delete the directory named DIRECTORY. Does not follow symlinks.
-If RECURSIVE is non-nil, all files in DIRECTORY are deleted as well.
+If RECURSIVE is non-nil, delete files in DIRECTORY as well, with
+no error if something else is simultaneously deleting them.
TRASH non-nil means to trash the directory instead, provided
`delete-by-moving-to-trash' is non-nil.
-When called interactively, TRASH is t if no prefix argument is
-given. With a prefix argument, TRASH is nil."
+When called interactively, TRASH is nil if and only if a prefix
+argument is given, and a further prompt asks the user for
+RECURSIVE if DIRECTORY is nonempty."
(interactive
(let* ((trashing (and delete-by-moving-to-trash
(null current-prefix-arg)))
@@ -5381,18 +5393,22 @@ given. With a prefix argument, TRASH is nil."
(move-file-to-trash directory)))
;; Otherwise, call ourselves recursively if needed.
(t
- (if (and recursive (not (file-symlink-p directory)))
- (mapc (lambda (file)
- ;; This test is equivalent to
- ;; (and (file-directory-p fn) (not (file-symlink-p fn)))
- ;; but more efficient
- (if (eq t (car (file-attributes file)))
- (delete-directory file recursive nil)
- (delete-file file nil)))
- ;; We do not want to delete "." and "..".
- (directory-files
- directory 'full directory-files-no-dot-files-regexp)))
- (delete-directory-internal directory)))))
+ (when (or (not recursive) (file-symlink-p directory)
+ (let* ((files
+ (files--force t #'directory-files directory 'full
+ directory-files-no-dot-files-regexp))
+ (directory-exists (listp files)))
+ (when directory-exists
+ (mapc (lambda (file)
+ ;; This test is equivalent to but more efficient
+ ;; than (and (file-directory-p fn)
+ ;; (not (file-symlink-p fn))).
+ (if (eq t (car (file-attributes file)))
+ (delete-directory file recursive)
+ (files--force t #'delete-file file)))
+ files))
+ directory-exists))
+ (files--force recursive #'delete-directory-internal directory))))))
(defun file-equal-p (file1 file2)
"Return non-nil if files FILE1 and FILE2 name the same file.
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] master 704fd2a: delete-directory no longer errors when racing,
Paul Eggert <=