diff options
| author | Paul Eggert | 2016-10-18 09:36:03 -0700 |
|---|---|---|
| committer | Paul Eggert | 2016-10-18 09:37:13 -0700 |
| commit | 704fd2a7ae5087f4108cc7a821f856fcdac99eb4 (patch) | |
| tree | 91d5068d98c6d86755d9df25841ba7a3769962f0 | |
| parent | 0956a3e41eea6a651a40bdbb8f8310a23733a739 (diff) | |
| download | emacs-704fd2a7ae5087f4108cc7a821f856fcdac99eb4.tar.gz emacs-704fd2a7ae5087f4108cc7a821f856fcdac99eb4.zip | |
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.
| -rw-r--r-- | doc/lispref/files.texi | 3 | ||||
| -rw-r--r-- | etc/NEWS | 5 | ||||
| -rw-r--r-- | lisp/files.el | 46 |
3 files changed, 39 insertions, 15 deletions
diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 9af5ce967c2..62e0199f1ff 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 | |||
| 2855 | must use @code{delete-directory} for them. If @var{recursive} is | 2855 | must use @code{delete-directory} for them. If @var{recursive} is |
| 2856 | @code{nil}, and the directory contains any files, | 2856 | @code{nil}, and the directory contains any files, |
| 2857 | @code{delete-directory} signals an error. | 2857 | @code{delete-directory} signals an error. |
| 2858 | If recursive is non-@code{nil}, there is no error merely because the | ||
| 2859 | directory or its files are deleted by some other process before | ||
| 2860 | @code{delete-directory} gets to them. | ||
| 2858 | 2861 | ||
| 2859 | @code{delete-directory} only follows symbolic links at the level of | 2862 | @code{delete-directory} only follows symbolic links at the level of |
| 2860 | parent directories. | 2863 | parent directories. |
| @@ -619,6 +619,11 @@ collection). | |||
| 619 | ** The new functions 'make-nearby-temp-file' and 'temporary-file-directory' | 619 | ** The new functions 'make-nearby-temp-file' and 'temporary-file-directory' |
| 620 | can be used for creation of temporary files of remote or mounted directories. | 620 | can be used for creation of temporary files of remote or mounted directories. |
| 621 | 621 | ||
| 622 | +++ | ||
| 623 | ** The function 'delete-directory' no longer signals an error when | ||
| 624 | operating recursively and when some other process deletes the directory | ||
| 625 | or its files before 'delete-directory' gets to them. | ||
| 626 | |||
| 622 | ** Changes in Frame- and Window- Handling | 627 | ** Changes in Frame- and Window- Handling |
| 623 | 628 | ||
| 624 | +++ | 629 | +++ |
diff --git a/lisp/files.el b/lisp/files.el index f481b9967c4..12c6c14d534 100644 --- a/lisp/files.el +++ b/lisp/files.el | |||
| @@ -5336,14 +5336,26 @@ raised." | |||
| 5336 | "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*" | 5336 | "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*" |
| 5337 | "Regexp matching any file name except \".\" and \"..\".") | 5337 | "Regexp matching any file name except \".\" and \"..\".") |
| 5338 | 5338 | ||
| 5339 | (defun files--force (no-such fn &rest args) | ||
| 5340 | "Use NO-SUCH to affect behavior of function FN applied to list ARGS. | ||
| 5341 | This acts like (apply FN ARGS) except it returns NO-SUCH if it is | ||
| 5342 | non-nil and if FN fails due to a missing file or directory." | ||
| 5343 | (condition-case err | ||
| 5344 | (apply fn args) | ||
| 5345 | (file-error | ||
| 5346 | (or (pcase err (`(,_ ,_ "No such file or directory" . ,_) no-such)) | ||
| 5347 | (signal (car err) (cdr err)))))) | ||
| 5348 | |||
| 5339 | (defun delete-directory (directory &optional recursive trash) | 5349 | (defun delete-directory (directory &optional recursive trash) |
| 5340 | "Delete the directory named DIRECTORY. Does not follow symlinks. | 5350 | "Delete the directory named DIRECTORY. Does not follow symlinks. |
| 5341 | If RECURSIVE is non-nil, all files in DIRECTORY are deleted as well. | 5351 | If RECURSIVE is non-nil, delete files in DIRECTORY as well, with |
| 5352 | no error if something else is simultaneously deleting them. | ||
| 5342 | TRASH non-nil means to trash the directory instead, provided | 5353 | TRASH non-nil means to trash the directory instead, provided |
| 5343 | `delete-by-moving-to-trash' is non-nil. | 5354 | `delete-by-moving-to-trash' is non-nil. |
| 5344 | 5355 | ||
| 5345 | When called interactively, TRASH is t if no prefix argument is | 5356 | When called interactively, TRASH is nil if and only if a prefix |
| 5346 | given. With a prefix argument, TRASH is nil." | 5357 | argument is given, and a further prompt asks the user for |
| 5358 | RECURSIVE if DIRECTORY is nonempty." | ||
| 5347 | (interactive | 5359 | (interactive |
| 5348 | (let* ((trashing (and delete-by-moving-to-trash | 5360 | (let* ((trashing (and delete-by-moving-to-trash |
| 5349 | (null current-prefix-arg))) | 5361 | (null current-prefix-arg))) |
| @@ -5381,18 +5393,22 @@ given. With a prefix argument, TRASH is nil." | |||
| 5381 | (move-file-to-trash directory))) | 5393 | (move-file-to-trash directory))) |
| 5382 | ;; Otherwise, call ourselves recursively if needed. | 5394 | ;; Otherwise, call ourselves recursively if needed. |
| 5383 | (t | 5395 | (t |
| 5384 | (if (and recursive (not (file-symlink-p directory))) | 5396 | (when (or (not recursive) (file-symlink-p directory) |
| 5385 | (mapc (lambda (file) | 5397 | (let* ((files |
| 5386 | ;; This test is equivalent to | 5398 | (files--force t #'directory-files directory 'full |
| 5387 | ;; (and (file-directory-p fn) (not (file-symlink-p fn))) | 5399 | directory-files-no-dot-files-regexp)) |
| 5388 | ;; but more efficient | 5400 | (directory-exists (listp files))) |
| 5389 | (if (eq t (car (file-attributes file))) | 5401 | (when directory-exists |
| 5390 | (delete-directory file recursive nil) | 5402 | (mapc (lambda (file) |
| 5391 | (delete-file file nil))) | 5403 | ;; This test is equivalent to but more efficient |
| 5392 | ;; We do not want to delete "." and "..". | 5404 | ;; than (and (file-directory-p fn) |
| 5393 | (directory-files | 5405 | ;; (not (file-symlink-p fn))). |
| 5394 | directory 'full directory-files-no-dot-files-regexp))) | 5406 | (if (eq t (car (file-attributes file))) |
| 5395 | (delete-directory-internal directory))))) | 5407 | (delete-directory file recursive) |
| 5408 | (files--force t #'delete-file file))) | ||
| 5409 | files)) | ||
| 5410 | directory-exists)) | ||
| 5411 | (files--force recursive #'delete-directory-internal directory)))))) | ||
| 5396 | 5412 | ||
| 5397 | (defun file-equal-p (file1 file2) | 5413 | (defun file-equal-p (file1 file2) |
| 5398 | "Return non-nil if files FILE1 and FILE2 name the same file. | 5414 | "Return non-nil if files FILE1 and FILE2 name the same file. |