wdired-do-renames: Speed up for long Emacs sessions

`dired-rename-file' calls unconditionally `dired-rename-subdir'.
The second function performs performs a loop on all the Emacs
buffers; this step is only needed if FILE is a directory (bug#32899).

In a long lived Emacs session, this can make a difference
when renaming a bunch of files with `wdired'.
For instance, in my 40 days old Emacs session, with ~ 700 buffers,
this patch increases the speed to rename 2000 files a factor ~ 15.

* lisp/dired-aux.el (dired-rename-file): Call `dired-rename-subdir'
iif FILE is a directory.  Add docstring.
(dired-rename-subdir, dired-remove-entry)
(dired-remove-file): Add docstring.

(dired-remove-entry): Move definition into `dired.el'.

* lisp/wdired.el (wdired-do-renames): Use a progress-reporter.

* lisp/dired.el (dired-delete-entry):
Use `dired-remove-entry'.  Add docstring.

(dired-buffers-for-dir, dired-fun-in-all-buffers):
Change comment into docstring.
(dired-fun-in-all-buffers): Prefer `when' and `push' here.
This commit is contained in:
Tino Calancha 2020-09-04 06:09:23 +02:00 committed by Lars Ingebrigtsen
parent 70af9a9cb9
commit 7769cad1e3
3 changed files with 34 additions and 21 deletions

View file

@ -1549,17 +1549,13 @@ files matching `dired-omit-regexp'."
;;;###autoload
(defun dired-remove-file (file)
"Remove entry FILE on each dired buffer.
Note this doesn't delete FILE in the file system.
See `dired-delete-file' in case you wish that."
(dired-fun-in-all-buffers
(file-name-directory file) (file-name-nondirectory file)
#'dired-remove-entry file))
(defun dired-remove-entry (file)
(save-excursion
(and (dired-goto-file file)
(let (buffer-read-only)
(delete-region (progn (beginning-of-line) (point))
(line-beginning-position 2))))))
;;;###autoload
(defun dired-relist-file (file)
"Create or update the line for FILE in all Dired buffers it would belong in."
@ -1676,6 +1672,9 @@ rename them using `vc-rename-file'."
;;;###autoload
(defun dired-rename-file (file newname ok-if-already-exists)
"Rename FILE to NEWNAME.
Signal a `file-already-exists' error if a file NEWNAME already exists
unless OK-IF-ALREADY-EXISTS is non-nil."
(dired-handle-overwrite newname)
(dired-maybe-create-dirs (file-name-directory newname))
(if (and dired-vc-rename-file

View file

@ -2908,12 +2908,12 @@ You can then feed the file name(s) to other commands with \\[yank]."
;; Keeping Dired buffers in sync with the filesystem and with each other
(defun dired-buffers-for-dir (dir &optional file)
;; Return a list of buffers for DIR (top level or in-situ subdir).
;; If FILE is non-nil, include only those whose wildcard pattern (if any)
;; matches FILE.
;; The list is in reverse order of buffer creation, most recent last.
;; As a side effect, killed dired buffers for DIR are removed from
;; dired-buffers.
"Return a list of buffers for DIR (top level or in-situ subdir).
If FILE is non-nil, include only those whose wildcard pattern (if any)
matches FILE.
The list is in reverse order of buffer creation, most recent last.
As a side effect, killed dired buffers for DIR are removed from
dired-buffers."
(setq dir (file-name-as-directory dir))
(let (result buf)
(dolist (elt dired-buffers)
@ -3462,18 +3462,28 @@ Return list of buffers where FUN succeeded (i.e., returned non-nil)."
(let (success-list)
(dolist (buf (dired-buffers-for-dir (expand-file-name directory) file))
(with-current-buffer buf
(if (apply fun args)
(push buf success-list))))
(when (apply fun args)
(push (buffer-name buf) success-list))))
;; FIXME: AFAICT, this return value is not used by any of the callers!
success-list))
;; Delete the entry for FILE from
(defun dired-delete-entry (file)
(defun dired-remove-entry (file)
"Remove entry FILE in the current dired buffer.
Note this doesn't delete FILE in the file system.
See `dired-delete-file' in case you wish that."
(save-excursion
(and (dired-goto-file file)
(let ((inhibit-read-only t))
(delete-region (progn (beginning-of-line) (point))
(save-excursion (forward-line 1) (point))))))
(line-beginning-position 2))))))
(defun dired-delete-entry (file)
"Remove entry FILE in the current dired buffer.
Like `dired-remove-entry' followed by `dired-clean-up-after-deletion'.
Note this doesn't delete FILE in the file system.
See `dired-delete-file' in case you wish that."
(dired-remove-entry file)
(dired-clean-up-after-deletion file))
(defvar dired-clean-up-buffers-too)

View file

@ -461,10 +461,12 @@ non-nil means return old filename."
(defun wdired-do-renames (renames)
"Perform RENAMES in parallel."
(let ((residue ())
(progress nil)
(errors 0)
(overwrite (or (not wdired-confirm-overwrite) 1)))
(let* ((residue ())
(progress nil)
(errors 0)
(total (1- (length renames)))
(prep (make-progress-reporter "Renaming" 0 total))
(overwrite (or (not wdired-confirm-overwrite) 1)))
(while (or renames
;; We've done one round through the renames, we have found
;; some residue, but we also made some progress, so maybe
@ -472,6 +474,7 @@ non-nil means return old filename."
(prog1 (setq renames residue)
(setq progress nil)
(setq residue nil)))
(progress-reporter-update prep (- total (length renames)))
(let* ((rename (pop renames))
(file-new (cdr rename)))
(cond
@ -519,6 +522,7 @@ non-nil means return old filename."
(dired-log "Rename `%s' to `%s' failed:\n%s\n"
file-ori file-new
err)))))))))
(progress-reporter-done prep)
errors))
(defun wdired-create-parentdirs (file-new)