Small edits for doc/lispref/minibuf.texi
[emacs.git] / lisp / wdired.el
blobfe5b4ef7b79d145cb4b8b7ed2d3ea22bc5ebd9da
1 ;;; wdired.el --- Rename files editing their names in dired buffers
3 ;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
5 ;; Filename: wdired.el
6 ;; Author: Juan León Lahoz García <juanleon1@gmail.com>
7 ;; Version: 2.0
8 ;; Keywords: dired, environment, files, renaming
10 ;; This file is part of GNU Emacs.
12 ;; GNU Emacs is free software: you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation, either version 3 of the License, or
15 ;; (at your option) any later version.
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25 ;;; Commentary:
27 ;; wdired.el (the "w" is for writable) provides an alternative way of
28 ;; renaming files.
30 ;; Have you ever wished to use C-x r t (string-rectangle), M-%
31 ;; (query-replace), M-c (capitalize-word), etc... to change the name of
32 ;; the files in a "dired" buffer? Now you can do this. All the power
33 ;; of Emacs commands are available to renaming files!
35 ;; This package provides a function that makes the filenames of a
36 ;; dired buffer editable, by changing the buffer mode (which inhibits
37 ;; all of the commands of dired mode). Here you can edit the names of
38 ;; one or more files and directories, and when you press C-c C-c, the
39 ;; renaming takes effect and you are back to dired mode.
41 ;; Another things you can do with WDired:
43 ;; - To move files to another directory (by typing their path,
44 ;; absolute or relative, as a part of the new filename).
46 ;; - To change the target of symbolic links.
48 ;; - To change the permission bits of the filenames (in systems with a
49 ;; working unix-alike `dired-chmod-program'). See and customize the
50 ;; variable `wdired-allow-to-change-permissions'. To change a single
51 ;; char (toggling between its two more usual values) you can press
52 ;; the space bar over it or left-click the mouse. To set any char to
53 ;; an specific value (this includes the SUID, SGID and STI bits) you
54 ;; can use the key labeled as the letter you want. Please note that
55 ;; permissions of the links cannot be changed in that way, because
56 ;; the change would affect to their targets, and this would not be
57 ;; WYSIWYG :-).
59 ;; - To mark files for deletion, by deleting their whole filename.
61 ;;; Usage:
63 ;; You can edit the names of the files by typing C-x C-q or by
64 ;; executing M-x wdired-change-to-wdired-mode. Use C-c C-c when
65 ;; finished or C-c C-k to abort. While editing filenames, a new
66 ;; submenu "WDired" is available at top level. You can customize the
67 ;; behavior of this package from this menu.
69 ;;; Change Log:
71 ;; Google is your friend (previous versions with complete changelogs
72 ;; were posted to gnu.emacs.sources)
74 ;;; Code:
76 (defvar dired-backup-overwrite) ; Only in Emacs 20.x this is a custom var
78 (eval-when-compile (require 'cl))
79 (require 'dired)
80 (autoload 'dired-do-create-files-regexp "dired-aux")
82 (defgroup wdired nil
83 "Mode to rename files by editing their names in dired buffers."
84 :group 'dired)
86 (defcustom wdired-use-interactive-rename nil
87 "If non-nil, WDired requires confirmation before actually renaming files.
88 If nil, WDired doesn't require confirmation to change the file names,
89 and the variable `wdired-confirm-overwrite' controls whether it is ok
90 to overwrite files without asking."
91 :type 'boolean
92 :group 'wdired)
94 (defcustom wdired-confirm-overwrite t
95 "If nil the renames can overwrite files without asking.
96 This variable has no effect at all if `wdired-use-interactive-rename'
97 is not nil."
98 :type 'boolean
99 :group 'wdired)
101 (defcustom wdired-use-dired-vertical-movement nil
102 "If t, the \"up\" and \"down\" movement works as in Dired mode.
103 That is, always move the point to the beginning of the filename at line.
105 If `sometimes', only move to the beginning of filename if the point is
106 before it, and `track-eol' is non-nil. This behavior is very handy
107 when editing several filenames.
109 If nil, \"up\" and \"down\" movement is done as in any other buffer."
110 :type '(choice (const :tag "As in any other mode" nil)
111 (const :tag "Smart cursor placement" sometimes)
112 (other :tag "As in dired mode" t))
113 :group 'wdired)
115 (defcustom wdired-allow-to-redirect-links t
116 "If non-nil, the target of the symbolic links are editable.
117 In systems without symbolic links support, this variable has no effect
118 at all."
119 :type 'boolean
120 :group 'wdired)
122 (defcustom wdired-allow-to-change-permissions nil
123 "If non-nil, the permissions bits of the files are editable.
125 If t, to change a single bit, put the cursor over it and press the
126 space bar, or left click over it. You can also hit the letter you want
127 to set: if this value is allowed, the character in the buffer will be
128 changed. Anyway, the point is advanced one position, so, for example,
129 you can keep the <x> key pressed to give execution permissions to
130 everybody to that file.
132 If `advanced', the bits are freely editable. You can use
133 `string-rectangle', `query-replace', etc. You can put any value (even
134 newlines), but if you want your changes to be useful, you better put a
135 intelligible value.
137 Anyway, the real change of the permissions is done by the external
138 program `dired-chmod-program', which must exist."
139 :type '(choice (const :tag "Not allowed" nil)
140 (const :tag "Toggle/set bits" t)
141 (other :tag "Bits freely editable" advanced))
142 :group 'wdired)
144 (defvar wdired-mode-map
145 (let ((map (make-sparse-keymap)))
146 (define-key map "\C-x\C-s" 'wdired-finish-edit)
147 (define-key map "\C-c\C-c" 'wdired-finish-edit)
148 (define-key map "\C-c\C-k" 'wdired-abort-changes)
149 (define-key map "\C-c\C-[" 'wdired-abort-changes)
150 (define-key map "\C-x\C-q" 'wdired-exit)
151 (define-key map "\C-m" 'ignore)
152 (define-key map "\C-j" 'ignore)
153 (define-key map "\C-o" 'ignore)
154 (define-key map [up] 'wdired-previous-line)
155 (define-key map "\C-p" 'wdired-previous-line)
156 (define-key map [down] 'wdired-next-line)
157 (define-key map "\C-n" 'wdired-next-line)
159 (define-key map [menu-bar wdired]
160 (cons "WDired" (make-sparse-keymap "WDired")))
161 (define-key map [menu-bar wdired wdired-customize]
162 '("Options" . wdired-customize))
163 (define-key map [menu-bar wdired dashes]
164 '("--"))
165 (define-key map [menu-bar wdired wdired-abort-changes]
166 '(menu-item "Abort Changes" wdired-abort-changes
167 :help "Abort changes and return to dired mode"))
168 (define-key map [menu-bar wdired wdired-finish-edit]
169 '("Commit Changes" . wdired-finish-edit))
171 (define-key map [remap upcase-word] 'wdired-upcase-word)
172 (define-key map [remap capitalize-word] 'wdired-capitalize-word)
173 (define-key map [remap downcase-word] 'wdired-downcase-word)
175 map))
177 (defvar wdired-mode-hook nil
178 "Hooks run when changing to WDired mode.")
180 ;; Local variables (put here to avoid compilation gripes)
181 (defvar wdired-col-perm) ;; Column where the permission bits start
182 (defvar wdired-old-content)
183 (defvar wdired-old-point)
186 (defun wdired-mode ()
187 "\\<wdired-mode-map>File Names Editing mode.
189 Press \\[wdired-finish-edit] to make the changes to take effect
190 and exit. To abort the edit, use \\[wdired-abort-changes].
192 In this mode you can edit the names of the files, the target of
193 the links and the permission bits of the files. You can use
194 \\[customize-group] RET wdired to customize WDired behavior.
196 The only editable texts in a WDired buffer are filenames,
197 symbolic link targets, and filenames permission."
198 (interactive)
199 (error "This mode can be enabled only by `wdired-change-to-wdired-mode'"))
200 (put 'wdired-mode 'mode-class 'special)
203 ;;;###autoload
204 (defun wdired-change-to-wdired-mode ()
205 "Put a dired buffer in a mode in which filenames are editable.
206 \\<wdired-mode-map>
207 This mode allows the user to change the names of the files, and after
208 typing \\[wdired-finish-edit] Emacs renames the files and directories
209 in disk.
211 See `wdired-mode'."
212 (interactive)
213 (or (eq major-mode 'dired-mode)
214 (error "Not a Dired buffer"))
215 (set (make-local-variable 'wdired-old-content)
216 (buffer-substring (point-min) (point-max)))
217 (set (make-local-variable 'wdired-old-point) (point))
218 (set (make-local-variable 'query-replace-skip-read-only) t)
219 (set (make-local-variable 'isearch-filter-predicate)
220 'wdired-isearch-filter-read-only)
221 (use-local-map wdired-mode-map)
222 (force-mode-line-update)
223 (setq buffer-read-only nil)
224 (dired-unadvertise default-directory)
225 (add-hook 'kill-buffer-hook 'wdired-check-kill-buffer nil t)
226 (setq major-mode 'wdired-mode)
227 (setq mode-name "Editable Dired")
228 (setq revert-buffer-function 'wdired-revert)
229 ;; I temp disable undo for performance: since I'm going to clear the
230 ;; undo list, it can save more than a 9% of time with big
231 ;; directories because setting properties modify the undo-list.
232 (buffer-disable-undo)
233 (wdired-preprocess-files)
234 (if wdired-allow-to-change-permissions
235 (wdired-preprocess-perms))
236 (if (and wdired-allow-to-redirect-links (fboundp 'make-symbolic-link))
237 (wdired-preprocess-symlinks))
238 (buffer-enable-undo) ; Performance hack. See above.
239 (set-buffer-modified-p nil)
240 (setq buffer-undo-list nil)
241 (run-mode-hooks 'wdired-mode-hook)
242 (message "%s" (substitute-command-keys
243 "Press \\[wdired-finish-edit] when finished \
244 or \\[wdired-abort-changes] to abort changes")))
246 (defun wdired-isearch-filter-read-only (beg end)
247 "Skip matches that have a read-only property."
248 (and (isearch-filter-visible beg end)
249 (not (text-property-not-all (min beg end) (max beg end)
250 'read-only nil))))
252 ;; Protect the buffer so only the filenames can be changed, and put
253 ;; properties so filenames (old and new) can be easily found.
254 (defun wdired-preprocess-files ()
255 (put-text-property (point-min) (1+ (point-min))'front-sticky t)
256 (save-excursion
257 (goto-char (point-min))
258 (let ((b-protection (point))
259 filename)
260 (while (not (eobp))
261 (setq filename (dired-get-filename nil t))
262 (when (and filename
263 (not (member (file-name-nondirectory filename) '("." ".."))))
264 (dired-move-to-filename)
265 ;; The rear-nonsticky property below shall ensure that text preceding
266 ;; the filename can't be modified.
267 (add-text-properties
268 (1- (point)) (point) `(old-name ,filename rear-nonsticky (read-only)))
269 (put-text-property b-protection (point) 'read-only t)
270 (setq b-protection (dired-move-to-end-of-filename t))
271 (put-text-property (point) (1+ (point)) 'end-name t))
272 (forward-line))
273 (put-text-property b-protection (point-max) 'read-only t))))
275 ;; This code is a copy of some dired-get-filename lines.
276 (defsubst wdired-normalize-filename (file)
277 (setq file
278 ;; FIXME: shouldn't we check for a `b' argument or somesuch before
279 ;; doing such unquoting? --Stef
280 (read (concat
281 "\"" (replace-regexp-in-string
282 "\\([^\\]\\|\\`\\)\"" "\\1\\\\\"" file)
283 "\"")))
284 (and file buffer-file-coding-system
285 (not file-name-coding-system)
286 (not default-file-name-coding-system)
287 (setq file (encode-coding-string file buffer-file-coding-system)))
288 file)
290 (defun wdired-get-filename (&optional no-dir old)
291 "Return the filename at line.
292 Similar to `dired-get-filename' but it doesn't rely on regexps. It
293 relies on WDired buffer's properties. Optional arg NO-DIR with value
294 non-nil means don't include directory. Optional arg OLD with value
295 non-nil means return old filename."
296 ;; FIXME: Use dired-get-filename's new properties.
297 (let (beg end file)
298 (save-excursion
299 (setq end (line-end-position))
300 (beginning-of-line)
301 (setq beg (next-single-property-change (point) 'old-name nil end))
302 (unless (eq beg end)
303 (if old
304 (setq file (get-text-property beg 'old-name))
305 ;; In the following form changed `(1+ beg)' to `beg' so that
306 ;; the filename end is found even when the filename is empty.
307 ;; Fixes error and spurious newlines when marking files for
308 ;; deletion.
309 (setq end (next-single-property-change beg 'end-name))
310 (setq file (buffer-substring-no-properties (1+ beg) end)))
311 (and file (setq file (wdired-normalize-filename file))))
312 (if (or no-dir old)
313 file
314 (and file (> (length file) 0)
315 (concat (dired-current-directory) file))))))
318 (defun wdired-change-to-dired-mode ()
319 "Change the mode back to dired."
320 (or (eq major-mode 'wdired-mode)
321 (error "Not a Wdired buffer"))
322 (let ((inhibit-read-only t))
323 (remove-text-properties
324 (point-min) (point-max)
325 '(front-sticky nil rear-nonsticky nil read-only nil keymap nil)))
326 (use-local-map dired-mode-map)
327 (force-mode-line-update)
328 (setq buffer-read-only t)
329 (setq major-mode 'dired-mode)
330 (setq mode-name "Dired")
331 (dired-advertise)
332 (remove-hook 'kill-buffer-hook 'wdired-check-kill-buffer t)
333 (set (make-local-variable 'revert-buffer-function) 'dired-revert))
336 (defun wdired-abort-changes ()
337 "Abort changes and return to dired mode."
338 (interactive)
339 (let ((inhibit-read-only t))
340 (erase-buffer)
341 (insert wdired-old-content)
342 (goto-char wdired-old-point))
343 (wdired-change-to-dired-mode)
344 (set-buffer-modified-p nil)
345 (setq buffer-undo-list nil)
346 (message "Changes aborted"))
348 (defun wdired-finish-edit ()
349 "Actually rename files based on your editing in the Dired buffer."
350 (interactive)
351 (wdired-change-to-dired-mode)
352 (let ((changes nil)
353 (errors 0)
354 files-deleted
355 files-renamed
356 some-file-names-unchanged
357 file-old file-new tmp-value)
358 (save-excursion
359 (when (and wdired-allow-to-redirect-links
360 (fboundp 'make-symbolic-link))
361 (setq tmp-value (wdired-do-symlink-changes))
362 (setq errors (cdr tmp-value))
363 (setq changes (car tmp-value)))
364 (when (and wdired-allow-to-change-permissions
365 (boundp 'wdired-col-perm)) ; could have been changed
366 (setq tmp-value (wdired-do-perm-changes))
367 (setq errors (+ errors (cdr tmp-value)))
368 (setq changes (or changes (car tmp-value))))
369 (goto-char (point-max))
370 (while (not (bobp))
371 (setq file-old (wdired-get-filename nil t))
372 (when file-old
373 (setq file-new (wdired-get-filename))
374 (if (equal file-new file-old)
375 (setq some-file-names-unchanged t)
376 (setq changes t)
377 (if (not file-new) ;empty filename!
378 (push file-old files-deleted)
379 (push (cons file-old (substitute-in-file-name file-new))
380 files-renamed))))
381 (forward-line -1)))
382 (when files-renamed
383 (setq errors (+ errors (wdired-do-renames files-renamed))))
384 (if changes
385 (progn
386 ;; If we are displaying a single file (rather than the
387 ;; contents of a directory), change dired-directory if that
388 ;; file was renamed. (This ought to be generalized to
389 ;; handle the multiple files case, but that's less trivial).
390 (when (and (stringp dired-directory)
391 (not (file-directory-p dired-directory))
392 (null some-file-names-unchanged)
393 (= (length files-renamed) 1))
394 (setq dired-directory (cdr (car files-renamed))))
395 ;; Re-sort the buffer.
396 (revert-buffer))
397 (let ((inhibit-read-only t))
398 (remove-text-properties (point-min) (point-max)
399 '(old-name nil end-name nil old-link nil
400 end-link nil end-perm nil
401 old-perm nil perm-changed nil))
402 (message "(No changes to be performed)")))
403 (when files-deleted
404 (wdired-flag-for-deletion files-deleted))
405 (when (> errors 0)
406 (dired-log-summary (format "%d rename actions failed" errors) nil)))
407 (set-buffer-modified-p nil)
408 (setq buffer-undo-list nil))
410 (defun wdired-do-renames (renames)
411 "Perform RENAMES in parallel."
412 (let ((residue ())
413 (progress nil)
414 (errors 0)
415 (overwrite (or (not wdired-confirm-overwrite) 1)))
416 (while (or renames
417 ;; We've done one round through the renames, we have found
418 ;; some residue, but we also made some progress, so maybe
419 ;; some of the residue were resolved: try again.
420 (prog1 (setq renames residue)
421 (setq progress nil)
422 (setq residue nil)))
423 (let* ((rename (pop renames))
424 (file-new (cdr rename)))
425 (cond
426 ((rassoc file-new renames)
427 (error "Trying to rename 2 files to the same name"))
428 ((assoc file-new renames)
429 ;; Renaming to a file name that already exists but will itself be
430 ;; renamed as well. Let's wait until that one gets renamed.
431 (push rename residue))
432 ((and (assoc file-new residue)
433 ;; Make sure the file really exists: if it doesn't it's
434 ;; not really a conflict. It might be a temp-file generated
435 ;; specifically to break a circular renaming.
436 (file-exists-p file-new))
437 ;; Renaming to a file name that already exists, needed to be renamed,
438 ;; but whose renaming could not be performed right away.
439 (if (or progress renames)
440 ;; There's still a chance the conflict will be resolved.
441 (push rename residue)
442 ;; We have not made any progress and we've reached the end of
443 ;; the renames, so we really have a circular conflict, and we
444 ;; have to forcefully break the cycle.
445 (message "Circular renaming: using temporary file name")
446 (let ((tmp (make-temp-name file-new)))
447 (push (cons (car rename) tmp) renames)
448 (push (cons tmp file-new) residue))))
450 (setq progress t)
451 (let ((file-ori (car rename)))
452 (if wdired-use-interactive-rename
453 (wdired-search-and-rename file-ori file-new)
454 ;; If dired-rename-file autoloads dired-aux while
455 ;; dired-backup-overwrite is locally bound,
456 ;; dired-backup-overwrite won't be initialized.
457 ;; So we must ensure dired-aux is loaded.
458 (require 'dired-aux)
459 (condition-case err
460 (let ((dired-backup-overwrite nil))
461 (dired-rename-file file-ori file-new
462 overwrite))
463 (error
464 (setq errors (1+ errors))
465 (dired-log (concat "Rename `" file-ori "' to `"
466 file-new "' failed:\n%s\n")
467 err)))))))))
468 errors))
471 (defun wdired-exit ()
472 "Exit wdired and return to dired mode.
473 Just return to dired mode if there are no changes. Otherwise,
474 ask a yes-or-no question whether to save or cancel changes,
475 and proceed depending on the answer."
476 (interactive)
477 (if (buffer-modified-p)
478 (if (y-or-n-p (format "Buffer %s modified; save changes? "
479 (current-buffer)))
480 (wdired-finish-edit)
481 (wdired-abort-changes))
482 (wdired-change-to-dired-mode)
483 (set-buffer-modified-p nil)
484 (setq buffer-undo-list nil)
485 (message "(No changes need to be saved)")))
487 ;; Rename a file, searching it in a modified dired buffer, in order
488 ;; to be able to use `dired-do-create-files-regexp' and get its
489 ;; "benefits".
490 (defun wdired-search-and-rename (filename-ori filename-new)
491 (save-excursion
492 (goto-char (point-max))
493 (forward-line -1)
494 (let ((done nil)
495 curr-filename)
496 (while (and (not done) (not (bobp)))
497 (setq curr-filename (wdired-get-filename nil t))
498 (if (equal curr-filename filename-ori)
499 (progn
500 (setq done t)
501 (let ((inhibit-read-only t))
502 (dired-move-to-filename)
503 (search-forward (wdired-get-filename t) nil t)
504 (replace-match (file-name-nondirectory filename-ori) t t))
505 (dired-do-create-files-regexp
506 (function dired-rename-file)
507 "Move" 1 ".*" filename-new nil t))
508 (forward-line -1))))))
510 ;; marks a list of files for deletion
511 (defun wdired-flag-for-deletion (filenames-ori)
512 (save-excursion
513 (goto-char (point-min))
514 (while (not (eobp))
515 (if (member (dired-get-filename nil t) filenames-ori)
516 (dired-flag-file-deletion 1)
517 (forward-line)))))
519 (defun wdired-customize ()
520 "Customize WDired options."
521 (interactive)
522 (customize-apropos "wdired" 'groups))
524 (defun wdired-revert (&optional _arg _noconfirm)
525 "Discard changes in the buffer and update it based on changes on disk.
526 Optional arguments are ignored."
527 (wdired-change-to-dired-mode)
528 (revert-buffer)
529 (wdired-change-to-wdired-mode))
531 (defun wdired-check-kill-buffer ()
532 ;; FIXME: Can't we use the normal mechanism for that? --Stef
533 (if (and
534 (buffer-modified-p)
535 (not (y-or-n-p "Buffer changed. Discard changes and kill buffer? ")))
536 (error "Error")))
538 (defun wdired-next-line (arg)
539 "Move down lines then position at filename or the current column.
540 See `wdired-use-dired-vertical-movement'. Optional prefix ARG
541 says how many lines to move; default is one line."
542 (interactive "p")
543 (with-no-warnings (next-line arg))
544 (if (or (eq wdired-use-dired-vertical-movement t)
545 (and wdired-use-dired-vertical-movement
546 (< (current-column)
547 (save-excursion (dired-move-to-filename)
548 (current-column)))))
549 (dired-move-to-filename)))
551 (defun wdired-previous-line (arg)
552 "Move up lines then position at filename or the current column.
553 See `wdired-use-dired-vertical-movement'. Optional prefix ARG
554 says how many lines to move; default is one line."
555 (interactive "p")
556 (with-no-warnings (previous-line arg))
557 (if (or (eq wdired-use-dired-vertical-movement t)
558 (and wdired-use-dired-vertical-movement
559 (< (current-column)
560 (save-excursion (dired-move-to-filename)
561 (current-column)))))
562 (dired-move-to-filename)))
564 ;; Put the needed properties to allow the user to change links' targets
565 (defun wdired-preprocess-symlinks ()
566 (let ((inhibit-read-only t))
567 (save-excursion
568 (goto-char (point-min))
569 (while (not (eobp))
570 (if (looking-at dired-re-sym)
571 (progn
572 (re-search-forward " -> \\(.*\\)$")
573 (put-text-property (- (match-beginning 1) 2)
574 (1- (match-beginning 1)) 'old-link
575 (match-string-no-properties 1))
576 (put-text-property (match-end 1) (1+ (match-end 1)) 'end-link t)
577 (put-text-property (1- (match-beginning 1))
578 (match-beginning 1)
579 'rear-nonsticky '(read-only))
580 (put-text-property (match-beginning 1)
581 (match-end 1) 'read-only nil)))
582 (forward-line)
583 (beginning-of-line)))))
586 (defun wdired-get-previous-link (&optional old move)
587 "Return the next symlink target.
588 If OLD, return the old target. If MOVE, move point before it."
589 (let (beg end target)
590 (setq beg (previous-single-property-change (point) 'old-link nil))
591 (if beg
592 (progn
593 (if old
594 (setq target (get-text-property (1- beg) 'old-link))
595 (setq end (next-single-property-change beg 'end-link))
596 (setq target (buffer-substring-no-properties (1+ beg) end)))
597 (if move (goto-char (1- beg)))))
598 (and target (wdired-normalize-filename target))))
600 (declare-function make-symbolic-link "fileio.c")
602 ;; Perform the changes in the target of the changed links.
603 (defun wdired-do-symlink-changes ()
604 (let ((changes nil)
605 (errors 0)
606 link-to-ori link-to-new link-from)
607 (goto-char (point-max))
608 (while (setq link-to-new (wdired-get-previous-link))
609 (setq link-to-ori (wdired-get-previous-link t t))
610 (setq link-from (wdired-get-filename nil t))
611 (unless (equal link-to-new link-to-ori)
612 (setq changes t)
613 (if (equal link-to-new "") ;empty filename!
614 (setq link-to-new "/dev/null"))
615 (condition-case err
616 (progn
617 (delete-file link-from)
618 (make-symbolic-link
619 (substitute-in-file-name link-to-new) link-from))
620 (error
621 (setq errors (1+ errors))
622 (dired-log (concat "Link `" link-from "' to `"
623 link-to-new "' failed:\n%s\n")
624 err)))))
625 (cons changes errors)))
627 ;; Perform a "case command" skipping read-only words.
628 (defun wdired-xcase-word (command arg)
629 (if (< arg 0)
630 (funcall command arg)
631 (while (> arg 0)
632 (condition-case nil
633 (progn
634 (funcall command 1)
635 (setq arg (1- arg)))
636 (error
637 (if (forward-word)
638 ;; Skip any non-word characters to avoid triggering a read-only
639 ;; error which would cause skipping the next word characters too.
640 (skip-syntax-forward "^w")
641 (setq arg 0)))))))
643 (defun wdired-downcase-word (arg)
644 "WDired version of `downcase-word'.
645 Like original function but it skips read-only words."
646 (interactive "p")
647 (wdired-xcase-word 'downcase-word arg))
649 (defun wdired-upcase-word (arg)
650 "WDired version of `upcase-word'.
651 Like original function but it skips read-only words."
652 (interactive "p")
653 (wdired-xcase-word 'upcase-word arg))
655 (defun wdired-capitalize-word (arg)
656 "WDired version of `capitalize-word'.
657 Like original function but it skips read-only words."
658 (interactive "p")
659 (wdired-xcase-word 'capitalize-word arg))
662 ;; The following code deals with changing the access bits (or
663 ;; permissions) of the files.
665 (defvar wdired-perm-mode-map
666 (let ((map (make-sparse-keymap)))
667 (define-key map " " 'wdired-toggle-bit)
668 (define-key map "r" 'wdired-set-bit)
669 (define-key map "w" 'wdired-set-bit)
670 (define-key map "x" 'wdired-set-bit)
671 (define-key map "-" 'wdired-set-bit)
672 (define-key map "S" 'wdired-set-bit)
673 (define-key map "s" 'wdired-set-bit)
674 (define-key map "T" 'wdired-set-bit)
675 (define-key map "t" 'wdired-set-bit)
676 (define-key map "s" 'wdired-set-bit)
677 (define-key map "l" 'wdired-set-bit)
678 (define-key map [down-mouse-1] 'wdired-mouse-toggle-bit)
679 map))
681 ;; Put a keymap property to the permission bits of the files, and store the
682 ;; original name and permissions as a property
683 (defun wdired-preprocess-perms ()
684 (let ((inhibit-read-only t))
685 (set (make-local-variable 'wdired-col-perm) nil)
686 (save-excursion
687 (goto-char (point-min))
688 (while (not (eobp))
689 (when (and (not (looking-at dired-re-sym))
690 (wdired-get-filename)
691 (re-search-forward dired-re-perms (line-end-position) 'eol))
692 (let ((begin (match-beginning 0))
693 (end (match-end 0)))
694 (unless wdired-col-perm
695 (setq wdired-col-perm (- (current-column) 9)))
696 (if (eq wdired-allow-to-change-permissions 'advanced)
697 (progn
698 (put-text-property begin end 'read-only nil)
699 ;; make first permission bit writable
700 (put-text-property
701 (1- begin) begin 'rear-nonsticky '(read-only)))
702 ;; avoid that keymap applies to text following permissions
703 (add-text-properties
704 (1+ begin) end
705 `(keymap ,wdired-perm-mode-map rear-nonsticky (keymap))))
706 (put-text-property end (1+ end) 'end-perm t)
707 (put-text-property
708 begin (1+ begin) 'old-perm (match-string-no-properties 0))))
709 (forward-line)
710 (beginning-of-line)))))
712 (defun wdired-perm-allowed-in-pos (char pos)
713 (cond
714 ((= char ?-) t)
715 ((= char ?r) (= (% pos 3) 0))
716 ((= char ?w) (= (% pos 3) 1))
717 ((= char ?x) (= (% pos 3) 2))
718 ((memq char '(?s ?S)) (memq pos '(2 5)))
719 ((memq char '(?t ?T)) (= pos 8))
720 ((= char ?l) (= pos 5))))
722 (defun wdired-set-bit ()
723 "Set a permission bit character."
724 (interactive)
725 (if (wdired-perm-allowed-in-pos last-command-event
726 (- (current-column) wdired-col-perm))
727 (let ((new-bit (char-to-string last-command-event))
728 (inhibit-read-only t)
729 (pos-prop (- (point) (- (current-column) wdired-col-perm))))
730 (put-text-property 0 1 'keymap wdired-perm-mode-map new-bit)
731 (put-text-property 0 1 'read-only t new-bit)
732 (insert new-bit)
733 (delete-char 1)
734 (put-text-property (1- pos-prop) pos-prop 'perm-changed t)
735 (put-text-property (1- (point)) (point) 'rear-nonsticky '(keymap)))
736 (forward-char 1)))
738 (defun wdired-toggle-bit ()
739 "Toggle the permission bit at point."
740 (interactive)
741 (let ((inhibit-read-only t)
742 (new-bit "-")
743 (pos-prop (- (point) (- (current-column) wdired-col-perm))))
744 (if (eq (char-after (point)) ?-)
745 (setq new-bit
746 (if (= (% (- (current-column) wdired-col-perm) 3) 0) "r"
747 (if (= (% (- (current-column) wdired-col-perm) 3) 1) "w"
748 "x"))))
749 (put-text-property 0 1 'keymap wdired-perm-mode-map new-bit)
750 (put-text-property 0 1 'read-only t new-bit)
751 (insert new-bit)
752 (delete-char 1)
753 (put-text-property (1- pos-prop) pos-prop 'perm-changed t)
754 (put-text-property (1- (point)) (point) 'rear-nonsticky '(keymap))))
756 (defun wdired-mouse-toggle-bit (event)
757 "Toggle the permission bit that was left clicked."
758 (interactive "e")
759 (mouse-set-point event)
760 (wdired-toggle-bit))
762 ;; Allowed chars for 4000 bit are Ss in position 3
763 ;; Allowed chars for 2000 bit are Ssl in position 6
764 ;; Allowed chars for 1000 bit are Tt in position 9
765 (defun wdired-perms-to-number (perms)
766 (let ((nperm 0777))
767 (if (= (elt perms 1) ?-) (setq nperm (- nperm 400)))
768 (if (= (elt perms 2) ?-) (setq nperm (- nperm 200)))
769 (let ((p-bit (elt perms 3)))
770 (if (memq p-bit '(?- ?S)) (setq nperm (- nperm 100)))
771 (if (memq p-bit '(?s ?S)) (setq nperm (+ nperm 4000))))
772 (if (= (elt perms 4) ?-) (setq nperm (- nperm 40)))
773 (if (= (elt perms 5) ?-) (setq nperm (- nperm 20)))
774 (let ((p-bit (elt perms 6)))
775 (if (memq p-bit '(?- ?S ?l)) (setq nperm (- nperm 10)))
776 (if (memq p-bit '(?s ?S ?l)) (setq nperm (+ nperm 2000))))
777 (if (= (elt perms 7) ?-) (setq nperm (- nperm 4)))
778 (if (= (elt perms 8) ?-) (setq nperm (- nperm 2)))
779 (let ((p-bit (elt perms 9)))
780 (if (memq p-bit '(?- ?T)) (setq nperm (- nperm 1)))
781 (if (memq p-bit '(?t ?T)) (setq nperm (+ nperm 1000))))
782 nperm))
784 ;; Perform the changes in the permissions of the files that have
785 ;; changed.
786 (defun wdired-do-perm-changes ()
787 (let ((changes nil)
788 (errors 0)
789 (prop-wanted (if (eq wdired-allow-to-change-permissions 'advanced)
790 'old-perm 'perm-changed))
791 filename perms-ori perms-new perm-tmp)
792 (goto-char (next-single-property-change (point-min) prop-wanted
793 nil (point-max)))
794 (while (not (eobp))
795 (setq perms-ori (get-text-property (point) 'old-perm))
796 (setq perms-new (buffer-substring-no-properties
797 (point) (next-single-property-change (point) 'end-perm)))
798 (unless (equal perms-ori perms-new)
799 (setq changes t)
800 (setq filename (wdired-get-filename nil t))
801 (if (= (length perms-new) 10)
802 (progn
803 (setq perm-tmp
804 (int-to-string (wdired-perms-to-number perms-new)))
805 (unless (equal 0 (process-file dired-chmod-program
806 nil nil nil perm-tmp filename))
807 (setq errors (1+ errors))
808 (dired-log (concat dired-chmod-program " " perm-tmp
809 " `" filename "' failed\n\n"))))
810 (setq errors (1+ errors))
811 (dired-log (concat "Cannot parse permission `" perms-new
812 "' for file `" filename "'\n\n"))))
813 (goto-char (next-single-property-change (1+ (point)) prop-wanted
814 nil (point-max))))
815 (cons changes errors)))
817 (provide 'wdired)
819 ;; Local Variables:
820 ;; coding: latin-1
821 ;; byte-compile-dynamic: t
822 ;; End:
824 ;;; wdired.el ends here