;;; wdired.el --- Rename files editing their names in dired buffers
-;; Copyright (C) 2004, 2005, 2006 Free Software Foundation, Inc.
+;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009
+;; Free Software Foundation, Inc.
;; Filename: wdired.el
;; Author: Juan León Lahoz García <juanleon1@gmail.com>
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 2, or (at
-;; your option) any later version.
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
-;; This program is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
(defvar dired-backup-overwrite) ; Only in Emacs 20.x this is a custom var
+(eval-when-compile (require 'cl))
(require 'dired)
(autoload 'dired-do-create-files-regexp "dired-aux")
-(autoload 'dired-call-process "dired-aux")
(defgroup wdired nil
"Mode to rename files by editing their names in dired buffers."
"If t, the \"up\" and \"down\" movement works as in Dired mode.
That is, always move the point to the beginning of the filename at line.
-If `sometimes, only move to the beginning of filename if the point is
-before it, and `track-eol' is honored. This behavior is very handy
+If `sometimes', only move to the beginning of filename if the point is
+before it, and `track-eol' is non-nil. This behavior is very handy
when editing several filenames.
If nil, \"up\" and \"down\" movement is done as in any other buffer."
you can keep the <x> key pressed to give execution permissions to
everybody to that file.
-If `advanced, the bits are freely editable. You can use
+If `advanced', the bits are freely editable. You can use
`string-rectangle', `query-replace', etc. You can put any value (even
newlines), but if you want your changes to be useful, you better put a
intelligible value.
(define-key map "\C-c\C-c" 'wdired-finish-edit)
(define-key map "\C-c\C-k" 'wdired-abort-changes)
(define-key map "\C-c\C-[" 'wdired-abort-changes)
+ (define-key map "\C-x\C-q" 'wdired-exit)
(define-key map "\C-m" 'ignore)
(define-key map "\C-j" 'ignore)
(define-key map "\C-o" 'ignore)
See `wdired-mode'."
(interactive)
+ (or (eq major-mode 'dired-mode)
+ (error "Not a Dired buffer"))
(set (make-local-variable 'wdired-old-content)
(buffer-substring (point-min) (point-max)))
(set (make-local-variable 'wdired-old-point) (point))
;; Protect the buffer so only the filenames can be changed, and put
;; properties so filenames (old and new) can be easily found.
(defun wdired-preprocess-files ()
- (put-text-property 1 2 'front-sticky t)
+ (put-text-property (point-min) (1+ (point-min))'front-sticky t)
(save-excursion
(goto-char (point-min))
(let ((b-protection (point))
(when (and filename
(not (member (file-name-nondirectory filename) '("." ".."))))
(dired-move-to-filename)
- (put-text-property (- (point) 2) (1- (point)) 'old-name filename)
- (put-text-property b-protection (1- (point)) 'read-only t)
- (setq b-protection (dired-move-to-end-of-filename t)))
- (put-text-property (point) (1+ (point)) 'end-name t)
+ ;; The rear-nonsticky property below shall ensure that text preceding
+ ;; the filename can't be modified.
+ (add-text-properties
+ (1- (point)) (point) `(old-name ,filename rear-nonsticky (read-only)))
+ (put-text-property b-protection (point) 'read-only t)
+ (setq b-protection (dired-move-to-end-of-filename t))
+ (put-text-property (point) (1+ (point)) 'end-name t))
(forward-line))
(put-text-property b-protection (point-max) 'read-only t))))
non-nil means don't include directory. Optional arg OLD with value
non-nil means return old filename."
;; FIXME: Use dired-get-filename's new properties.
- (let* ((end (line-end-position))
- (beg (next-single-property-change
- (line-beginning-position) 'old-name nil end)))
- (unless (eq beg end)
- (let ((file
- (if old
- (get-text-property beg 'old-name)
- (wdired-normalize-filename
- (buffer-substring-no-properties
- (+ 2 beg) (next-single-property-change (1+ beg) 'end-name))))))
- (if (or no-dir old)
- file
- (and file (> (length file) 0)
- (concat (dired-current-directory) file)))))))
+ (let (beg end file)
+ (save-excursion
+ (setq end (line-end-position))
+ (beginning-of-line)
+ (setq beg (next-single-property-change (point) 'old-name nil end))
+ (unless (eq beg end)
+ (if old
+ (setq file (get-text-property beg 'old-name))
+ ;; In the following form changed `(1+ beg)' to `beg' so that
+ ;; the filename end is found even when the filename is empty.
+ ;; Fixes error and spurious newlines when marking files for
+ ;; deletion.
+ (setq end (next-single-property-change beg 'end-name))
+ (setq file (buffer-substring-no-properties (1+ beg) end)))
+ (and file (setq file (wdired-normalize-filename file))))
+ (if (or no-dir old)
+ file
+ (and file (> (length file) 0)
+ (concat (dired-current-directory) file))))))
(defun wdired-change-to-dired-mode ()
"Change the mode back to dired."
+ (or (eq major-mode 'wdired-mode)
+ (error "Not a Wdired buffer"))
(let ((inhibit-read-only t))
- (remove-text-properties (point-min) (point-max)
- '(read-only nil local-map nil)))
- (put-text-property 1 2 'front-sticky nil)
+ (remove-text-properties
+ (point-min) (point-max)
+ '(front-sticky nil rear-nonsticky nil read-only nil keymap nil)))
(use-local-map dired-mode-map)
(force-mode-line-update)
(setq buffer-read-only t)
"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)
+ (let ((changes nil)
(errors 0)
- file-ori file-new tmp-value)
+ files-deleted
+ files-renamed
+ some-file-names-unchanged
+ file-old file-new tmp-value)
(save-excursion
- (if (and wdired-allow-to-redirect-links
- (fboundp 'make-symbolic-link))
- (progn
- (setq tmp-value (wdired-do-symlink-changes))
- (setq errors (cdr tmp-value))
- (setq changes (car tmp-value))))
- (if (and wdired-allow-to-change-permissions
- (boundp 'wdired-col-perm)) ; could have been changed
- (progn
- (setq tmp-value (wdired-do-perm-changes))
- (setq errors (+ errors (cdr tmp-value)))
- (setq changes (or changes (car tmp-value)))))
+ (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))
- (if file-ori
- (setq file-new (wdired-get-filename)))
- (if (and file-ori (not (equal file-new file-ori)))
- (progn
- (setq changes t)
- (if (not file-new) ;empty filename!
- (setq files-deleted (cons file-ori files-deleted))
- (progn
- (setq file-new (substitute-in-file-name file-new))
- (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))))))))
+ (setq file-old (wdired-get-filename nil t))
+ (when file-old
+ (setq file-new (wdired-get-filename))
+ (if (equal file-new file-old)
+ (setq some-file-names-unchanged t)
+ (setq changes t)
+ (if (not file-new) ;empty filename!
+ (push file-old files-deleted)
+ (push (cons file-old (substitute-in-file-name file-new))
+ files-renamed))))
(forward-line -1)))
+ (when files-renamed
+ (setq errors (+ errors (wdired-do-renames files-renamed))))
(if changes
- (revert-buffer) ;The "revert" is necessary to re-sort the buffer
+ (progn
+ ;; If we are displaying a single file (rather than the
+ ;; contents of a directory), change dired-directory if that
+ ;; file was renamed. (This ought to be generalized to
+ ;; handle the multiple files case, but that's less trivial).
+ (when (and (stringp dired-directory)
+ (not (file-directory-p dired-directory))
+ (null some-file-names-unchanged)
+ (= (length files-renamed) 1))
+ (setq dired-directory (cdr (car files-renamed))))
+ ;; Re-sort the buffer.
+ (revert-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)")))
- (if files-deleted
- (wdired-flag-for-deletion files-deleted))
- (if (> errors 0)
- (dired-log-summary (format "%d rename actions failed" errors) nil)))
+ (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-do-renames (renames)
+ "Perform RENAMES in parallel."
+ (let ((residue ())
+ (progress nil)
+ (errors 0)
+ (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
+ ;; some of the residue were resolved: try again.
+ (prog1 (setq renames residue)
+ (setq progress nil)
+ (setq residue nil)))
+ (let* ((rename (pop renames))
+ (file-new (cdr rename)))
+ (cond
+ ((rassoc file-new renames)
+ (error "Trying to rename 2 files to the same name"))
+ ((assoc file-new renames)
+ ;; Renaming to a file name that already exists but will itself be
+ ;; renamed as well. Let's wait until that one gets renamed.
+ (push rename residue))
+ ((and (assoc file-new residue)
+ ;; Make sure the file really exists: if it doesn't it's
+ ;; not really a conflict. It might be a temp-file generated
+ ;; specifically to break a circular renaming.
+ (file-exists-p file-new))
+ ;; Renaming to a file name that already exists, needed to be renamed,
+ ;; but whose renaming could not be performed right away.
+ (if (or progress renames)
+ ;; There's still a chance the conflict will be resolved.
+ (push rename residue)
+ ;; We have not made any progress and we've reached the end of
+ ;; the renames, so we really have a circular conflict, and we
+ ;; have to forcefully break the cycle.
+ (message "Circular renaming: using temporary file name")
+ (let ((tmp (make-temp-name file-new)))
+ (push (cons (car rename) tmp) renames)
+ (push (cons tmp file-new) residue))))
+ (t
+ (setq progress t)
+ (let ((file-ori (car rename)))
+ (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)))))))))
+ errors))
+
+
+(defun wdired-exit ()
+ "Exit wdired and return to dired mode.
+Just return to dired mode if there are no changes. Otherwise,
+ask a yes-or-no question whether to save or cancel changes,
+and proceed depending on the answer."
+ (interactive)
+ (if (buffer-modified-p)
+ (if (y-or-n-p (format "Buffer %s modified; save changes? "
+ (current-buffer)))
+ (wdired-finish-edit)
+ (wdired-abort-changes))
+ (wdired-change-to-dired-mode)
+ (set-buffer-modified-p nil)
+ (setq buffer-undo-list nil)
+ (message "(No changes need to be saved)")))
+
;; Rename a file, searching it in a modified dired buffer, in order
;; to be able to use `dired-do-create-files-regexp' and get its
;; "benefits".
(save-excursion
(goto-char (point-max))
(forward-line -1)
- (let ((exit-while nil)
+ (let ((done nil)
curr-filename)
- (while (not exit-while)
- (setq curr-filename (wdired-get-filename))
- (if (and curr-filename
- (equal (substitute-in-file-name curr-filename) filename-new))
+ (while (and (not done) (not (bobp)))
+ (setq curr-filename (wdired-get-filename nil t))
+ (if (equal curr-filename filename-ori)
(progn
- (setq exit-while t)
+ (setq done t)
(let ((inhibit-read-only t))
(dired-move-to-filename)
(search-forward (wdired-get-filename t) nil t)
(dired-do-create-files-regexp
(function dired-rename-file)
"Move" 1 ".*" filename-new nil t))
- (progn
- (forward-line -1)
- (beginning-of-line)
- (setq exit-while (= 1 (point)))))))))
+ (forward-line -1))))))
;; marks a list of files for deletion
(defun wdired-flag-for-deletion (filenames-ori)
(if (and
(buffer-modified-p)
(not (y-or-n-p "Buffer changed. Discard changes and kill buffer? ")))
- (error nil)))
+ (error "Error")))
(defun wdired-next-line (arg)
"Move down lines then position at filename or the current column.
See `wdired-use-dired-vertical-movement'. Optional prefix ARG
says how many lines to move; default is one line."
(interactive "p")
- (next-line arg)
+ (with-no-warnings (next-line arg))
(if (or (eq wdired-use-dired-vertical-movement t)
(and wdired-use-dired-vertical-movement
(< (current-column)
See `wdired-use-dired-vertical-movement'. Optional prefix ARG
says how many lines to move; default is one line."
(interactive "p")
- (previous-line arg)
+ (with-no-warnings (previous-line arg))
(if (or (eq wdired-use-dired-vertical-movement t)
(and wdired-use-dired-vertical-movement
(< (current-column)
(1- (match-beginning 1)) 'old-link
(match-string-no-properties 1))
(put-text-property (match-end 1) (1+ (match-end 1)) 'end-link t)
- (put-text-property (1- (match-beginning 1))
+ (put-text-property (1- (match-beginning 1))
+ (match-beginning 1)
+ 'rear-nonsticky '(read-only))
+ (put-text-property (match-beginning 1)
(match-end 1) 'read-only nil)))
(forward-line)
(beginning-of-line)))))
(defun wdired-get-previous-link (&optional old move)
"Return the next symlink target.
If OLD, return the old target. If MOVE, move point before it."
- (let ((beg (previous-single-property-change (point) 'old-link nil)))
- (when beg
- (let ((target
- (if old
- (get-text-property (1- beg) 'old-link)
- (buffer-substring-no-properties
- (1+ beg) (next-single-property-change beg 'end-link)))))
- (if move (goto-char (1- beg)))
- (and target (wdired-normalize-filename target))))))
+ (let (beg end target)
+ (setq beg (previous-single-property-change (point) 'old-link nil))
+ (if beg
+ (progn
+ (if old
+ (setq target (get-text-property (1- beg) 'old-link))
+ (setq end (next-single-property-change beg 'end-link))
+ (setq target (buffer-substring-no-properties (1+ beg) end)))
+ (if move (goto-char (1- beg)))))
+ (and target (wdired-normalize-filename target))))
+
+(declare-function make-symbolic-link "fileio.c")
;; Perform the changes in the target of the changed links.
(defun wdired-do-symlink-changes ()
(funcall command 1)
(setq arg (1- arg)))
(error
- (if (not (forward-word 1))
- (setq arg 0)))))))
+ (if (forward-word)
+ ;; Skip any non-word characters to avoid triggering a read-only
+ ;; error which would cause skipping the next word characters too.
+ (skip-syntax-forward "^w")
+ (setq arg 0)))))))
(defun wdired-downcase-word (arg)
"WDired version of `downcase-word'.
(define-key map [down-mouse-1] 'wdired-mouse-toggle-bit)
map))
-;; Put a local-map to the permission bits of the files, and store the
+;; Put a keymap property to the permission bits of the files, and store the
;; original name and permissions as a property
(defun wdired-preprocess-perms ()
- (let ((inhibit-read-only t)
- filename)
+ (let ((inhibit-read-only t))
(set (make-local-variable 'wdired-col-perm) nil)
(save-excursion
(goto-char (point-min))
(while (not (eobp))
- (if (and (not (looking-at dired-re-sym))
- (setq filename (wdired-get-filename)))
- (progn
- (re-search-forward dired-re-perms)
- (or wdired-col-perm
- (setq wdired-col-perm (- (current-column) 9)))
- (if (eq wdired-allow-to-change-permissions 'advanced)
- (put-text-property (match-beginning 0) (match-end 0)
- 'read-only nil)
- (put-text-property (1+ (match-beginning 0)) (match-end 0)
- 'keymap wdired-perm-mode-map))
- (put-text-property (match-end 0) (1+ (match-end 0)) 'end-perm t)
- (put-text-property (match-beginning 0) (1+ (match-beginning 0))
- 'old-perm (match-string-no-properties 0))))
+ (when (and (not (looking-at dired-re-sym))
+ (wdired-get-filename)
+ (re-search-forward dired-re-perms (line-end-position) 'eol))
+ (let ((begin (match-beginning 0))
+ (end (match-end 0)))
+ (unless wdired-col-perm
+ (setq wdired-col-perm (- (current-column) 9)))
+ (if (eq wdired-allow-to-change-permissions 'advanced)
+ (progn
+ (put-text-property begin end 'read-only nil)
+ ;; make first permission bit writable
+ (put-text-property
+ (1- begin) begin 'rear-nonsticky '(read-only)))
+ ;; avoid that keymap applies to text following permissions
+ (add-text-properties
+ (1+ begin) end
+ `(keymap ,wdired-perm-mode-map rear-nonsticky (keymap))))
+ (put-text-property end (1+ end) 'end-perm t)
+ (put-text-property
+ begin (1+ begin) 'old-perm (match-string-no-properties 0))))
(forward-line)
(beginning-of-line)))))
(defun wdired-set-bit ()
"Set a permission bit character."
(interactive)
- (if (wdired-perm-allowed-in-pos last-command-char
+ (if (wdired-perm-allowed-in-pos last-command-event
(- (current-column) wdired-col-perm))
- (let ((new-bit (char-to-string last-command-char))
+ (let ((new-bit (char-to-string last-command-event))
(inhibit-read-only t)
(pos-prop (- (point) (- (current-column) wdired-col-perm))))
(put-text-property 0 1 'keymap wdired-perm-mode-map new-bit)
(put-text-property 0 1 'read-only t new-bit)
(insert new-bit)
(delete-char 1)
- (put-text-property pos-prop (1- pos-prop) 'perm-changed t))
+ (put-text-property (1- pos-prop) pos-prop 'perm-changed t)
+ (put-text-property (1- (point)) (point) 'rear-nonsticky '(keymap)))
(forward-char 1)))
(defun wdired-toggle-bit ()
"Toggle the permission bit at point."
(interactive)
(let ((inhibit-read-only t)
- (new-bit (cond
- ((not (eq (char-after (point)) ?-)) "-")
- ((= (% (- (current-column) wdired-col-perm) 3) 0) "r")
- ((= (% (- (current-column) wdired-col-perm) 3) 1) "w")
- (t "x")))
+ (new-bit "-")
(pos-prop (- (point) (- (current-column) wdired-col-perm))))
+ (if (eq (char-after (point)) ?-)
+ (setq new-bit
+ (if (= (% (- (current-column) wdired-col-perm) 3) 0) "r"
+ (if (= (% (- (current-column) wdired-col-perm) 3) 1) "w"
+ "x"))))
(put-text-property 0 1 'keymap wdired-perm-mode-map new-bit)
(put-text-property 0 1 'read-only t new-bit)
(insert new-bit)
(delete-char 1)
- (put-text-property pos-prop (1- pos-prop) 'perm-changed t)))
+ (put-text-property (1- pos-prop) pos-prop 'perm-changed t)
+ (put-text-property (1- (point)) (point) 'rear-nonsticky '(keymap))))
(defun wdired-mouse-toggle-bit (event)
"Toggle the permission bit that was left clicked."
;; Allowed chars for 2000 bit are Ssl in position 6
;; Allowed chars for 1000 bit are Tt in position 9
(defun wdired-perms-to-number (perms)
- (+
- (if (= (elt perms 1) ?-) 0 400)
- (if (= (elt perms 2) ?-) 0 200)
- (case (elt perms 3)
- (?- 0)
- (?S 4000)
- (?s 4100)
- (t 100))
- (if (= (elt perms 4) ?-) 0 40)
- (if (= (elt perms 5) ?-) 0 20)
- (case (elt perms 6)
- (?- 0)
- (?S 2000)
- (?s 2010)
- (t 10))
- (if (= (elt perms 7) ?-) 0 4)
- (if (= (elt perms 8) ?-) 0 2)
- (case (elt perms 9)
- (?- 0)
- (?T 1000)
- (?t 1001)
- (t 1))))
+ (let ((nperm 0777))
+ (if (= (elt perms 1) ?-) (setq nperm (- nperm 400)))
+ (if (= (elt perms 2) ?-) (setq nperm (- nperm 200)))
+ (let ((p-bit (elt perms 3)))
+ (if (memq p-bit '(?- ?S)) (setq nperm (- nperm 100)))
+ (if (memq p-bit '(?s ?S)) (setq nperm (+ nperm 4000))))
+ (if (= (elt perms 4) ?-) (setq nperm (- nperm 40)))
+ (if (= (elt perms 5) ?-) (setq nperm (- nperm 20)))
+ (let ((p-bit (elt perms 6)))
+ (if (memq p-bit '(?- ?S ?l)) (setq nperm (- nperm 10)))
+ (if (memq p-bit '(?s ?S ?l)) (setq nperm (+ nperm 2000))))
+ (if (= (elt perms 7) ?-) (setq nperm (- nperm 4)))
+ (if (= (elt perms 8) ?-) (setq nperm (- nperm 2)))
+ (let ((p-bit (elt perms 9)))
+ (if (memq p-bit '(?- ?T)) (setq nperm (- nperm 1)))
+ (if (memq p-bit '(?t ?T)) (setq nperm (+ nperm 1000))))
+ nperm))
;; Perform the changes in the permissions of the files that have
;; changed.
(progn
(setq perm-tmp
(int-to-string (wdired-perms-to-number perms-new)))
- (unless (equal 0 (dired-call-process dired-chmod-program
- t perm-tmp filename))
+ (unless (equal 0 (process-file dired-chmod-program
+ nil nil nil perm-tmp filename))
(setq errors (1+ errors))
(dired-log (concat dired-chmod-program " " perm-tmp
" `" filename "' failed\n\n"))))