Phil Sung : Emacs resources : Improved renaming for wdired
30 May 2008
Purpose
Note This appears to have been obsoleted by an (even better!) implementation in Emacs CVS as of 14 June 2008.
wdired (the Emacs facility for renaming files by editing their names) always performs renames in a fixed order, starting from the bottom of the buffer and working its way up. Therefore, you can easily construct sets of renames where wdired unnecessarily thinks it has to clobber a file; e.g. if you have the following directory structure,
drwxr-xr-x 2 phil phil 4.0K 2008-05-21 02:07 . drwxr-xr-x 10 phil phil 4.0K 2008-05-21 02:07 .. -rw-r--r-- 1 phil phil 536 2008-04-28 00:49 0001.html -rw-r--r-- 1 phil phil 407 2008-05-13 23:18 0002.html
and you rename 0001 to 0000 and 0002 to 0001, then wdired prompts you to ask whether you want to overwrite 0001, since it attempts the second rename first. This is unfortunate since if it just switched the order in which it did the renames, there would be no conflicts.
I modified wdired-finish-edit to compute and apply the "right" order for a set of renames (when such an order exists).
Architecture
wdired-finish-edit, instead of doing the renames as it moves up the buffer, accumulates the list of operations it has to do, calls wdired-reorder-sort-operations to compute a good ordering, and then does all the renames.
wdired-reorder-sort-operations computes a topological ordering on a set of operations in order to prevent rename conflicts when possible. If there is no way to avoid a conflict, wdired will prompt you before it is going to clobber a file (as before).
The future
It would be nice if wdired-reorder-sort-operations learned how to introduce temporary files so that it could do circular renames, like mmv does.
The code
Last update, 30 May 2008: be sure to specify :test
'equal for the hashtable. Without that the data structures may not
work as I intended.
The following code being a derivative of GNU Emacs, you may redistribute it and/or modify it under the terms of the GPL, version 3, or, at your option, any later version.
One way to install this is to add both function definitions to your .emacs file after a (require 'wdired).
(defun wdired-finish-edit ()
"Actually rename files based on your editing in the Dired buffer."
(interactive)
(wdired-change-to-dired-mode)
(let ((overwrite (or (not wdired-confirm-overwrite) 1))
(changes nil)
(files-deleted nil)
(errors 0)
(rename-operations '())
file-ori file-new tmp-value)
(save-excursion
(when (and wdired-allow-to-redirect-links
(fboundp 'make-symbolic-link))
(setq tmp-value (wdired-do-symlink-changes))
(setq errors (cdr tmp-value))
(setq changes (car tmp-value)))
(when (and wdired-allow-to-change-permissions
(boundp 'wdired-col-perm)) ; could have been changed
(setq tmp-value (wdired-do-perm-changes))
(setq errors (+ errors (cdr tmp-value)))
(setq changes (or changes (car tmp-value))))
(goto-char (point-max))
(while (not (bobp))
(setq file-ori (wdired-get-filename nil t))
(when file-ori
(setq file-new (wdired-get-filename)))
(when (and file-ori (not (equal file-new file-ori)))
(setq changes t)
(if (not file-new) ;empty filename!
(setq files-deleted (cons file-ori files-deleted))
(setq file-new (substitute-in-file-name file-new))
(setq rename-operations
(cons (cons file-ori file-new) rename-operations))))
(forward-line -1))
(dolist (operation (wdired-reorder-sort-operations rename-operations))
(let ((file-ori (car operation)) (file-new (cdr operation)))
(if wdired-use-interactive-rename
(wdired-search-and-rename file-ori file-new)
;; If dired-rename-file autoloads dired-aux while
;; dired-backup-overwrite is locally bound,
;; dired-backup-overwrite won't be initialized.
;; So we must ensure dired-aux is loaded.
(require 'dired-aux)
(condition-case err
(let ((dired-backup-overwrite nil))
(dired-rename-file file-ori file-new
overwrite))
(error
(setq errors (1+ errors))
(dired-log (concat "Rename `" file-ori "' to `"
file-new "' failed:\n%s\n")
err)))))))
(if changes
(revert-buffer) ;The "revert" is necessary to re-sort the buffer
(let ((inhibit-read-only t))
(remove-text-properties (point-min) (point-max)
'(old-name nil end-name nil old-link nil
end-link nil end-perm nil
old-perm nil perm-changed nil))
(message "(No changes to be performed)")))
(when files-deleted
(wdired-flag-for-deletion files-deleted))
(when (> errors 0)
(dired-log-summary (format "%d rename actions failed" errors) nil)))
(set-buffer-modified-p nil)
(setq buffer-undo-list nil))
(defun wdired-reorder-sort-operations (operations)
"Return the elements of OPERATIONS, reordered to avoid rename conflicts."
;; Whenever there are two operations, renaming A to B and renaming B to C, we
;; try to ensure that the latter operation happens first so that the former
;; can happen without overwriting B. We do this by generating a constraint
;; graph and performing a topological sort.
;;
;; It would be nice to handle circular renames by using a temporary file and
;; inserting extra renames.
(let ((forward-edges (make-hash-table :test 'equal))
(reverse-edges (make-hash-table :test 'equal))
(L nil)
(pending nil))
;; Determine, for each file A, what A will be renamed to and what, if any,
;; files will be renamed to A.
(dolist (operation operations)
(let ((from (car operation)) (to (cdr operation)))
(puthash from to forward-edges)
(if (not (gethash to reverse-edges))
(puthash to (make-hash-table :test 'equal) reverse-edges))
(puthash from t (gethash to reverse-edges))))
;; Initialize PENDING to contain files A such that nothing is renamed to A.
;; Renames from such files will be the last to happen.
(dolist (operation operations)
(let ((from (car operation)) (to (cdr operation)))
(if (not (gethash from reverse-edges nil))
(setq pending (cons from pending)))))
;; Visit the nodes in BFS order.
(while pending
(let* ((from (car pending))
(to (gethash from forward-edges))
(op (cons from to)))
(setq pending (cdr pending))
(setq L (cons op L))
(remhash from forward-edges)
(when (gethash to forward-edges)
(remhash from (gethash to reverse-edges))
(if (zerop (hash-table-count (gethash to reverse-edges)))
(setq pending (cons to pending))))))
;; Add at the end all the nodes which weren't visited. These nodes are part
;; of a cycle, but we should prompt the user anyway.
(let ((unreached-nodes nil))
(dolist (operation operations)
(if (gethash (car operation) forward-edges)
(setq unreached-nodes (cons operation unreached-nodes))))
(append L unreached-nodes))))