comparison lisp/wdired.el @ 55098:dedd285e197e

New file.
author Stefan Monnier <monnier@iro.umontreal.ca>
date Fri, 23 Apr 2004 20:57:46 +0000
parents
children 32bcd1e4bb61
comparison
equal deleted inserted replaced
55097:5c2770cd5506 55098:dedd285e197e
1 ;;; wdired.el --- Rename files editing their names in dired buffers
2
3 ;; Copyright (C) 2001, 2004 Free Software Foundation, Inc.
4
5 ;; Filename: wdired.el
6 ;; Author: Juan León Lahoz García <juan-leon.lahoz@tecsidel.es>
7 ;; Version: 1.91
8 ;; Keywords: dired, environment, files, renaming
9
10 ;; This file is part of GNU Emacs.
11
12 ;; GNU Emacs is free software; you can redistribute it and/or
13 ;; modify it under the terms of the GNU General Public License as
14 ;; published by the Free Software Foundation; either version 2, or (at
15 ;; your option) any later version.
16
17 ;; This program is distributed in the hope that it will be useful, but
18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
20 ;; General Public License for more details.
21
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25 ;; Boston, MA 02111-1307, USA.
26
27 ;;; Commentary:
28
29 ;; wdired.el (the "w" is for writable) provides an alternative way of
30 ;; renaming files.
31 ;;
32 ;; Have you ever wished to use C-x r t (string-rectangle), M-%
33 ;; (query-replace), M-c (capitalize-word), etc to change the name of
34 ;; the files in a "dired" buffer? Now you can do this. All the power
35 ;; of emacs commands are available to renaming files!
36 ;;
37 ;; This package provides a function that makes the filenames of a a
38 ;; dired buffer editable, by changing the buffer mode (which inhibits
39 ;; all of the commands of dired mode). Here you can edit the names of
40 ;; one or more files and directories, and when you press C-c C-c, the
41 ;; renaming takes effect and you are back to dired mode.
42 ;;
43 ;; Another things you can do with wdired:
44 ;;
45 ;; - To move files to another directory (by typing their path,
46 ;; absolute or relative, as a part of the new filename).
47 ;;
48 ;; - To change the target of symbolic links.
49 ;;
50 ;; - To change the permission bits of the filenames (in systems with a
51 ;; working unix-alike `dired-chmod-program'). See and customize the
52 ;; variable `wdired-allow-to-change-permissions'. To change a single
53 ;; char (toggling between its two more usual values) you can press
54 ;; the space bar over it or left-click the mouse. To set any char to
55 ;; an specific value (this includes the SUID, SGID and STI bits) you
56 ;; can use the key labeled as the letter you want. Please note that
57 ;; permissions of the links cannot be changed in that way, because
58 ;; the change would affect to their targets, and this would not be
59 ;; WYSIWYG :-).
60 ;;
61 ;; - To mark files for deletion, by deleting their whole filename.
62 ;;
63 ;; I do not have a URL to hang wdired, but you can use the one below
64 ;; to find the latest version:
65 ;;
66 ;; http://groups.google.com/groups?as_ugroup=gnu.emacs.sources&as_q=wdired
67
68 ;;; Installation:
69
70 ;; Add this file (byte-compiling it is recommended) to your load-path.
71 ;; Then add one of these set of lines (or similar ones) to your config:
72 ;;
73 ;; This is the easy way:
74 ;;
75 ;; (require 'wdired)
76 ;; (define-key dired-mode-map "r" 'wdired-change-to-wdired-mode)
77 ;;
78 ;; This is recommended way for faster emacs startup time and lower
79 ;; memory consumption, but remind to add these lines before dired.el
80 ;; gets loaded (i.e., near the beginning of your .emacs file):
81 ;;
82 ;; (autoload 'wdired-change-to-wdired-mode "wdired")
83 ;; (add-hook 'dired-load-hook
84 ;; '(lambda ()
85 ;; (define-key dired-mode-map "r" 'wdired-change-to-wdired-mode)
86 ;; (define-key dired-mode-map
87 ;; [menu-bar immediate wdired-change-to-wdired-mode]
88 ;; '("Edit File Names" . wdired-change-to-wdired-mode))))
89 ;;
90 ;;
91 ;; Type "M-x customize-group RET wdired" if you want make changes to
92 ;; the default behavior.
93
94 ;;; Usage:
95
96 ;; Then, you can start editing the names of the files by typing "r"
97 ;; (or whatever key you choose, or M-x wdired-change-to-wdired-mode).
98 ;; Use C-c C-c when finished or C-c C-k to abort. You can use also the
99 ;; menu options: in dired mode, "Edit File Names" under "Immediate".
100 ;; While editing the names, a new submenu "WDired" is available at top
101 ;; level. You can customize the behavior of this package from this
102 ;; menu.
103
104 ;;; Change Log:
105
106 ;; From 1.9 to 1.91
107 ;;
108 ;; - Fixed a bug (introduced in 1.9) so now files can be marked for
109 ;; deletion again, by deleting their whole filename.
110
111 ;; From 1.8 to 1.9
112 ;;
113 ;; - Another alternative way of editing permissions allowed, see
114 ;; `wdired-allow-to-change-permissions' for details.
115 ;;
116 ;; - Now wdired doesn`t relies in regexp so much. As a consequence of
117 ;; this, you can add newlines to filenames and symlinks targets
118 ;; (although this is not very usual, IMHO). Please note that dired
119 ;; (at least in Emacs 21.1 and previous) does not work very well
120 ;; with filenames with newlines in them, so RET is deactivated in
121 ;; wdired mode. But you can activate it if you want.
122 ;;
123 ;; - Now `upcase-word' `capitalize-word' and `downcase-word' are not
124 ;; advised to work better with wdired mode, but the keys binded to
125 ;; them use wdired versions of that commands.
126 ;;
127 ;; - Now "undo" actions are not inherited from wdired mode when
128 ;; changing to dired mode.
129 ;;
130 ;; - Code and documentation cleanups.
131 ;;
132 ;; - Fixed a bug that was making wdired to fail on users with
133 ;; `dired-backup-overwrite' set to t.
134 ;;
135 ;; - C-c C-[ now abort changes.
136
137 ;; From 1.7 to 1.8
138 ;;
139 ;; - Now permission (access-control) bits of the files can be changed.
140 ;; Please see the commentary section and the custom variable
141 ;; `wdired-allow-to-change-permissions' for details.
142 ;;
143 ;; - Added another possible value for the variable
144 ;; `wdired-always-move-to-filename-beginning', useful to change
145 ;; permission bits of several files without the cursor jumping to
146 ;; filenames when changing lines.
147
148 ;; From 0.1 to 1.7
149
150 ;; - I've moved the list of changes to another file, because it was
151 ;; huge. Ask me for it or search older versions in google.
152
153 ;;; TODO:
154
155 ;; - Make it to work in XEmacs. Any volunteer?
156
157 ;;; Code:
158
159 (eval-when-compile
160 (require 'advice)
161 (defvar make-symbolic-link) ;Avoid a compilation warning in NTEmacs
162 (defvar dired-backup-overwrite) ; Only in emacs 20.x this is a custom var
163 (set (make-local-variable 'byte-compile-dynamic) t))
164
165 (eval-and-compile
166 (require 'dired)
167 (autoload 'dired-do-create-files-regexp "dired-aux")
168 (autoload 'dired-call-process "dired-aux"))
169
170 (defgroup wdired nil
171 "Mode to rename files by editing their names in dired buffers."
172 :group 'dired)
173
174 (defcustom wdired-use-interactive-rename nil
175 "*If t, confirmation is required before actually rename the files.
176 Confirmation is required also for overwriting files. If nil, no
177 confirmation is required for change the file names, and the variable
178 `wdired-is-ok-overwrite' is used to see if it is ok to overwrite files
179 without asking."
180 :type 'boolean
181 :group 'wdired)
182
183 (defcustom wdired-is-ok-overwrite nil
184 "*If non-nil the renames can overwrite files without asking.
185 This variable is used only if `wdired-use-interactive-rename' is nil."
186 :type 'boolean
187 :group 'wdired)
188
189 (defcustom wdired-always-move-to-filename-beginning nil
190 "*If t the \"up\" and \"down\" movement is done as in dired mode.
191 That is, always move the point to the beginning of the filename at line.
192
193 If `sometimes, only move to the beginning of filename if the point is
194 before it, and `track-eol' is honored. This behavior is very handy
195 when editing several filenames.
196
197 If nil, \"up\" and \"down\" movement is done as in any other buffer."
198 :type '(choice (const :tag "As in any other mode" nil)
199 (const :tag "Smart cursor placement" sometimes)
200 (other :tag "As in dired mode" t))
201 :group 'wdired)
202
203 (defcustom wdired-advise-functions t
204 "*If t some editing commands are advised when wdired is loaded.
205 The advice only has effect in wdired mode. These commands are
206 `query-replace' `query-replace-regexp' `replace-string', and the
207 advice makes them to ignore read-only regions, so no attempts to
208 modify these regions are done by them, and so they don't end
209 prematurely.
210
211 Setting this to nil does not unadvise the functions, if they are
212 already advised, but new Emacs will not advise them."
213 :type 'boolean
214 :group 'wdired)
215
216 (defcustom wdired-allow-to-redirect-links t
217 "*If non-nil, the target of the symbolic links can be changed also.
218 In systems without symbolic links support, this variable has no effect
219 at all."
220 :type 'boolean
221 :group 'wdired)
222
223 (defcustom wdired-allow-to-change-permissions nil
224 "*If non-nil, the permissions bits of the files can be changed also.
225
226 If t, to change a single bit, put the cursor over it and press the
227 space bar, or left click over it. You can also hit the letter you want
228 to set: if this value is allowed, the character in the buffer will be
229 changed. Anyway, the point is advanced one position, so, for example,
230 you can keep the \"x\" key pressed to give execution permissions to
231 everybody to that file.
232
233 If `advanced, the bits are freely editable. You can use
234 `string-rectangle', `query-replace', etc. You can put any value (even
235 newlines), but if you want your changes to be useful, you better put a
236 intelligible value.
237
238 Anyway, the real change of the permissions is done with the external
239 program `dired-chmod-program', which must exist."
240 :type '(choice (const :tag "Not allowed" nil)
241 (const :tag "Toggle/set bits" t)
242 (other :tag "Bits freely editable" advanced))
243 :group 'wdired)
244
245 (define-key dired-mode-map [menu-bar immediate wdired-change-to-wdired-mode]
246 '("Edit File Names" . wdired-change-to-wdired-mode))
247
248 (defvar wdired-mode-map nil)
249 (unless wdired-mode-map
250 (setq wdired-mode-map (make-sparse-keymap))
251 (define-key wdired-mode-map "\C-x\C-s" 'wdired-finish-edit)
252 (define-key wdired-mode-map "\C-c\C-c" 'wdired-finish-edit)
253 (define-key wdired-mode-map "\C-c\C-k" 'wdired-abort-changes)
254 (define-key wdired-mode-map "\C-c\C-[" 'wdired-abort-changes)
255 (define-key wdired-mode-map [return] 'wdired-newline)
256 (define-key wdired-mode-map "\C-j" 'wdired-newline)
257 (define-key wdired-mode-map "\C-o" 'wdired-newline)
258 (define-key wdired-mode-map [up] 'wdired-previous-line)
259 (define-key wdired-mode-map "\C-p" 'wdired-previous-line)
260 (define-key wdired-mode-map [down] 'wdired-next-line)
261 (define-key wdired-mode-map "\C-n" 'wdired-next-line)
262 (define-key wdired-mode-map [menu-bar wdired]
263 (cons "WDired" (make-sparse-keymap "WDired")))
264 (define-key wdired-mode-map [menu-bar wdired wdired-customize]
265 '("Options" . wdired-customize))
266 (define-key wdired-mode-map [menu-bar wdired dashes]
267 '("--"))
268 (define-key wdired-mode-map [menu-bar wdired wdired-abort-changes]
269 '("Abort Changes" . wdired-abort-changes))
270 (define-key wdired-mode-map [menu-bar wdired wdired-finish-edit]
271 '("Validate Changes" . wdired-finish-edit))
272 (substitute-key-definition 'upcase-word 'wdired-upcase-word
273 wdired-mode-map global-map)
274 (substitute-key-definition 'capitalize-word 'wdired-capitalize-word
275 wdired-mode-map global-map)
276 (substitute-key-definition 'downcase-word 'wdired-downcase-word
277 wdired-mode-map global-map))
278
279 (defvar wdired-mode-hooks nil
280 "Hooks run when changing to wdired mode.")
281
282 (defvar wdired-load-hooks nil
283 "Hooks run after loading wdired code.")
284
285 ;; Local variables (put here to avoid compilation gripes)
286 (defvar wdired-col-perm) ;; Column where the permission bits start
287 (defvar wdired-old-content)
288
289
290 (defun wdired-mode ()
291 "\\<wdired-mode-map>File Names Editing mode.
292
293 Press \\[wdired-finish-edit] to make the changes to take effect and
294 exit. To abort the edit, use \\[wdired-abort-changes].
295
296 In this mode you can edit the names of the files, the target of the
297 links and the permission bits of the files. You can `customize-group'
298 wdired.
299
300 Editing things out of the filenames, or adding or deleting lines is
301 not allowed, because the rest of the buffer is read-only."
302 (interactive)
303 (error "This mode can be enabled only by `wdired-change-to-wdired-mode'"))
304 (put 'wdired-mode 'mode-class 'special)
305
306
307 ;;;###autoload
308 (defun wdired-change-to-wdired-mode ()
309 "Put a dired buffer in a mode in which filenames are editable.
310 In this mode the names of the files can be changed, and after
311 typing C-c C-c the files and directories in disk are renamed.
312
313 See `wdired-mode'."
314 (interactive)
315 (set (make-local-variable 'wdired-old-content)
316 (buffer-substring (point-min) (point-max)))
317 (use-local-map wdired-mode-map)
318 (menu-bar-mode (or menu-bar-mode -1)) ;Force redisplay menu
319 (setq buffer-read-only nil)
320 (dired-unadvertise default-directory)
321 (make-local-hook 'kill-buffer-hook)
322 (add-hook 'kill-buffer-hook 'wdired-check-kill-buffer nil t)
323 (setq major-mode 'wdired-mode)
324 (setq mode-name "Edit filenames")
325 (setq revert-buffer-function 'wdired-revert)
326 ;; I temp disable undo for performance: since I'm going to clear the
327 ;; undo list, it can save more than a 9% of time with big
328 ;; directories because setting properties modify the undo-list.
329 (buffer-disable-undo)
330 (wdired-preprocess-files)
331 (if wdired-allow-to-change-permissions
332 (wdired-preprocess-perms))
333 (if (and wdired-allow-to-redirect-links (fboundp 'make-symbolic-link))
334 (wdired-preprocess-symlinks))
335 (buffer-enable-undo) ; Performance hack. See above.
336 (set-buffer-modified-p nil)
337 (setq buffer-undo-list nil)
338 (run-hooks wdired-mode-hooks)
339 (message "Press C-c C-c when finished"))
340
341
342 ;; Protect the buffer so only the filenames can be changed, and put
343 ;; properties so filenames (old and new) can be easily found.
344 (defun wdired-preprocess-files ()
345 (put-text-property 1 2 'front-sticky t)
346 (save-excursion
347 (goto-char (point-min))
348 (let ((b-protection (point))
349 filename)
350 (while (not (eobp))
351 (setq filename (dired-get-filename nil t))
352 (if (and filename (not (string-match "/\\.\\.?$" filename)))
353 (progn
354 (dired-move-to-filename)
355 (put-text-property (- (point) 2) (1- (point)) 'old-name filename)
356 (put-text-property b-protection (1- (point)) 'read-only t)
357 (setq b-protection (dired-move-to-end-of-filename t))))
358 (put-text-property (point) (1+ (point)) 'end-name t)
359 (forward-line))
360 (put-text-property b-protection (point-max) 'read-only t))))
361
362 ;; This code is a copy of some dired-get-filename lines.
363 (defsubst wdired-normalize-filename (file)
364 (setq file
365 (read (concat
366 "\"" (or (dired-string-replace-match
367 "\\([^\\]\\|\\`\\)\"" file
368 "\\1\\\\\"" nil t)
369 file)
370 "\"")))
371 (and file buffer-file-coding-system
372 (not file-name-coding-system)
373 (not default-file-name-coding-system)
374 (setq file (encode-coding-string file buffer-file-coding-system)))
375 file)
376
377 (defun wdired-get-filename (&optional no-dir old)
378 "Return the filename at line.
379 Similar to `dired-get-filename' but it doesn't relies in regexps. It
380 relies in wdired buffer's properties. Optional arg NO-DIR with value
381 non-nil means don't include directory. Optional arg OLD with value
382 non-nil means return old filename."
383 (let (beg end file)
384 (save-excursion
385 (setq end (progn (end-of-line) (point)))
386 (beginning-of-line)
387 (setq beg (next-single-property-change (point) 'old-name nil end))
388 (if (not (eq beg end))
389 (progn
390 (if old
391 (setq file (get-text-property beg 'old-name))
392 (setq end (next-single-property-change (1+ beg) 'end-name))
393 (setq file (buffer-substring-no-properties (+ 2 beg) end)))
394 (and file (setq file (wdired-normalize-filename file)))))
395 (if (or no-dir old)
396 file
397 (and file (> (length file) 0)
398 (concat (dired-current-directory) file))))))
399
400
401 (defun wdired-change-to-dired-mode ()
402 "Change the mode back to dired."
403 (let ((inhibit-read-only t))
404 (remove-text-properties (point-min) (point-max)
405 '(read-only nil local-map nil)))
406 (put-text-property 1 2 'front-sticky nil)
407 (use-local-map dired-mode-map)
408 (menu-bar-mode (or menu-bar-mode -1)) ;Force redisplay menu
409 (setq buffer-read-only t)
410 (setq major-mode 'dired-mode)
411 (setq mode-name "Dired")
412 (dired-advertise)
413 (remove-hook 'kill-buffer-hook 'wdired-check-kill-buffer t)
414 (setq revert-buffer-function 'dired-revert))
415
416
417 (defun wdired-abort-changes ()
418 "Abort changes and return to dired mode."
419 (interactive)
420 (let ((inhibit-read-only t))
421 (erase-buffer)
422 (insert wdired-old-content))
423 (wdired-change-to-dired-mode)
424 (set-buffer-modified-p nil)
425 (setq buffer-undo-list nil))
426
427 (defun wdired-finish-edit ()
428 "Actually rename files based on your editing in the Dired buffer."
429 (interactive)
430 (wdired-change-to-dired-mode)
431 (let ((overwrite (or wdired-is-ok-overwrite 1))
432 (changes nil)
433 (files-deleted nil)
434 (errors 0)
435 file-ori file-new tmp-value)
436 (save-excursion
437 (if (and wdired-allow-to-redirect-links
438 (fboundp 'make-symbolic-link))
439 (progn
440 (setq tmp-value (wdired-do-symlink-changes))
441 (setq errors (cdr tmp-value))
442 (setq changes (car tmp-value))))
443 (if (and wdired-allow-to-change-permissions
444 (boundp 'wdired-col-perm)) ; could have been changed
445 (progn
446 (setq tmp-value (wdired-do-perm-changes))
447 (setq errors (+ errors (cdr tmp-value)))
448 (setq changes (or changes (car tmp-value)))))
449 (goto-char (point-max))
450 (while (not (bobp))
451 (setq file-ori (wdired-get-filename nil t))
452 (if file-ori
453 (setq file-new (wdired-get-filename)))
454 (if (and file-ori (not (equal file-new file-ori)))
455 (progn
456 (setq changes t)
457 (if (not file-new) ;empty filename!
458 (setq files-deleted (cons file-ori files-deleted))
459 (progn
460 (setq file-new (substitute-in-file-name file-new))
461 (if wdired-use-interactive-rename
462 (wdired-search-and-rename file-ori file-new)
463 (condition-case err
464 (let ((dired-backup-overwrite nil))
465 (dired-rename-file file-ori file-new
466 overwrite))
467 (error
468 (setq errors (1+ errors))
469 (dired-log (concat "Rename `" file-ori "' to `"
470 file-new "' failed:\n%s\n")
471 err))))))))
472 (forward-line -1)))
473 (if changes
474 (revert-buffer) ;The "revert" is necessary to re-sort the buffer
475 (let ((buffer-read-only nil))
476 (remove-text-properties (point-min) (point-max)
477 '(old-name nil end-name nil old-link nil
478 end-link nil end-perm nil
479 old-perm nil perm-changed nil))
480 (message "(No changes to be performed)")))
481 (if files-deleted
482 (wdired-flag-for-deletion files-deleted))
483 (if (> errors 0)
484 (dired-log-summary (format "%d rename actions failed" errors) nil)))
485 (set-buffer-modified-p nil)
486 (setq buffer-undo-list nil))
487
488 ;; Renames a file, searching it in a modified dired buffer, in order
489 ;; to be able to use `dired-do-create-files-regexp' and get its
490 ;; "benefits"
491 (defun wdired-search-and-rename (filename-ori filename-new)
492 (save-excursion
493 (goto-char (point-max))
494 (forward-line -1)
495 (let ((exit-while nil)
496 curr-filename)
497 (while (not exit-while)
498 (setq curr-filename (wdired-get-filename))
499 (if (and curr-filename
500 (equal (substitute-in-file-name curr-filename) filename-new))
501 (progn
502 (setq exit-while t)
503 (let ((inhibit-read-only t))
504 (dired-move-to-filename)
505 (search-forward (wdired-get-filename t) nil t)
506 (replace-match (file-name-nondirectory filename-ori) t t))
507 (dired-do-create-files-regexp
508 (function dired-rename-file)
509 "Move" 1 ".*" filename-new nil t))
510 (progn
511 (forward-line -1)
512 (beginning-of-line)
513 (setq exit-while (= 1 (point)))))))))
514
515 ;; marks a list of files for deletion
516 (defun wdired-flag-for-deletion (filenames-ori)
517 (save-excursion
518 (goto-char (point-min))
519 (while (not (eobp))
520 (if (member (dired-get-filename nil t) filenames-ori)
521 (dired-flag-file-deletion 1)
522 (forward-line)))))
523
524 (defun wdired-customize ()
525 "Customize wdired options."
526 (interactive)
527 (customize-apropos "wdired" 'groups))
528
529 (defun wdired-revert (&optional arg noconfirm)
530 "Discard changes in the buffer and update the changes in the disk."
531 (wdired-change-to-dired-mode)
532 (revert-buffer)
533 (wdired-change-to-wdired-mode))
534
535 (defun wdired-check-kill-buffer ()
536 (if (and
537 (buffer-modified-p)
538 (not (y-or-n-p "Buffer changed. Discard changes and kill buffer? ")))
539 (error nil)))
540
541 (defun wdired-next-line (arg)
542 "Move down lines then position at filename or the current column.
543 See `wdired-always-move-to-filename-beginning'. Optional prefix ARG
544 says how many lines to move; default is one line."
545 (interactive "p")
546 (next-line arg)
547 (if (or (eq wdired-always-move-to-filename-beginning t)
548 (and wdired-always-move-to-filename-beginning
549 (< (current-column)
550 (save-excursion (dired-move-to-filename)
551 (current-column)))))
552 (dired-move-to-filename)))
553
554 (defun wdired-previous-line (arg)
555 "Move up lines then position at filename or the current column.
556 See `wdired-always-move-to-filename-beginning'. Optional prefix ARG
557 says how many lines to move; default is one line."
558 (interactive "p")
559 (previous-line arg)
560 (if (or (eq wdired-always-move-to-filename-beginning t)
561 (and wdired-always-move-to-filename-beginning
562 (< (current-column)
563 (save-excursion (dired-move-to-filename)
564 (current-column)))))
565 (dired-move-to-filename)))
566
567 ;; dired doesn't works well with newlines, so ...
568 (defun wdired-newline ()
569 "Do nothing."
570 (interactive))
571
572 ;; Put the needed properties to allow the user to change links' targets
573 (defun wdired-preprocess-symlinks ()
574 (let ((inhibit-read-only t))
575 (save-excursion
576 (goto-char (point-min))
577 (while (not (eobp))
578 (if (looking-at dired-re-sym)
579 (progn
580 (re-search-forward " -> \\(.*\\)$")
581 (put-text-property (- (match-beginning 1) 2)
582 (1- (match-beginning 1)) 'old-link
583 (match-string-no-properties 1))
584 (put-text-property (match-end 1) (1+ (match-end 1)) 'end-link t)
585 (put-text-property (1- (match-beginning 1))
586 (match-end 1) 'read-only nil)))
587 (forward-line)
588 (beginning-of-line)))))
589
590
591 (defun wdired-get-previous-link (&optional old move)
592 "Return the next symlink target.
593 If OLD, return the old target. If MOVE, move point before it."
594 (let (beg end target)
595 (setq beg (previous-single-property-change (point) 'old-link nil))
596 (if beg
597 (progn
598 (if old
599 (setq target (get-text-property (1- beg) 'old-link))
600 (setq end (next-single-property-change beg 'end-link))
601 (setq target (buffer-substring-no-properties (1+ beg) end)))
602 (if move (goto-char (1- beg)))))
603 (and target (wdired-normalize-filename target))))
604
605
606
607 ;; Perform the changes in the target of the changed links.
608 (defun wdired-do-symlink-changes()
609 (let ((changes nil)
610 (errors 0)
611 link-to-ori link-to-new link-from)
612 (goto-char (point-max))
613 (while (setq link-to-new (wdired-get-previous-link))
614 (setq link-to-ori (wdired-get-previous-link t t))
615 (setq link-from (wdired-get-filename nil t))
616 (if (not (equal link-to-new link-to-ori))
617 (progn
618 (setq changes t)
619 (if (equal link-to-new "") ;empty filename!
620 (setq link-to-new "/dev/null"))
621 (condition-case err
622 (progn
623 (delete-file link-from)
624 (make-symbolic-link
625 (substitute-in-file-name link-to-new) link-from))
626 (error
627 (setq errors (1+ errors))
628 (dired-log (concat "Link `" link-from "' to `"
629 link-to-new "' failed:\n%s\n")
630 err))))))
631 (cons changes errors)))
632
633 ;; Perform a "case command" skipping read-only words.
634 (defun wdired-xcase-word (command arg)
635 (if (< arg 0)
636 (funcall command arg)
637 (progn
638 (while (> arg 0)
639 (condition-case err
640 (progn
641 (funcall command 1)
642 (setq arg (1- arg)))
643 (error
644 (if (not (forward-word 1))
645 (setq arg 0))))))))
646
647 (defun wdired-downcase-word (arg)
648 "Wdired version of `downcase-word'.
649 Like original function but it skips read-only words."
650 (interactive "p")
651 (wdired-xcase-word 'downcase-word arg))
652
653 (defun wdired-upcase-word (arg)
654 "Wdired version of `upcase-word'.
655 Like original function but it skips read-only words."
656 (interactive "p")
657 (wdired-xcase-word 'upcase-word arg))
658
659 (defun wdired-capitalize-word (arg)
660 "Wdired version of `capitalize-word'.
661 Like original function but it skips read-only words."
662 (interactive "p")
663 (wdired-xcase-word 'capitalize-word arg))
664
665 ;; The following code is related to advice some interactive functions
666 ;; to make some editing commands in wdired mode not to fail trying to
667 ;; change read-only text. Notice that some advises advice and unadvise
668 ;; them-self to another functions: search-forward and
669 ;; re-search-forward. This is to keep these functions advised only
670 ;; when is necessary. Since they are built-in commands used heavily in
671 ;; lots of places, to have it permanently advised would cause some
672 ;; performance loss.
673
674
675 (defun wdired-add-skip-in-replace (command)
676 "Advice COMMAND to skip matches while they have read-only properties.
677 This is useful to avoid \"read-only\" errors in search and replace
678 commands. This advice only has effect in wdired mode."
679 (eval
680 `(defadvice ,command (around wdired-discard-read-only activate)
681 ,(format "Make %s to work better with wdired,\n%s." command
682 "skipping read-only matches when invoked without argument")
683 ad-do-it
684 (if (eq major-mode 'wdired-mode)
685 (while (and ad-return-value
686 (text-property-any
687 (max 1 (1- (match-beginning 0))) (match-end 0)
688 'read-only t))
689 ad-do-it))
690 ad-return-value)))
691
692
693 (defun wdired-add-replace-advice (command)
694 "Advice COMMAND to skip matches while they have read-only properties.
695 This is useful to avoid \"read-only\" errors in search and replace
696 commands. This advice only has effect in wdired mode."
697 (eval
698 `(defadvice ,command (around wdired-grok-read-only activate)
699 ,(format "Make %s to work better with wdired,\n%s." command
700 "skipping read-only matches when invoked without argument")
701 (if (eq major-mode 'wdired-mode)
702 (progn
703 (wdired-add-skip-in-replace 'search-forward)
704 (wdired-add-skip-in-replace 're-search-forward)
705 (unwind-protect
706 ad-do-it
707 (progn
708 (ad-remove-advice 'search-forward
709 'around 'wdired-discard-read-only)
710 (ad-remove-advice 're-search-forward
711 'around 'wdired-discard-read-only)
712 (ad-update 'search-forward)
713 (ad-update 're-search-forward))))
714 ad-do-it)
715 ad-return-value)))
716
717
718 (if wdired-advise-functions
719 (progn
720 (mapcar 'wdired-add-replace-advice
721 '(query-replace query-replace-regexp replace-string))))
722
723
724 ;; The following code deals with changing the access bits (or
725 ;; permissions) of the files.
726
727 (defvar wdired-perm-mode-map nil)
728 (unless wdired-perm-mode-map
729 (setq wdired-perm-mode-map (copy-keymap wdired-mode-map))
730 (define-key wdired-perm-mode-map " " 'wdired-toggle-bit)
731 (define-key wdired-perm-mode-map "r" 'wdired-set-bit)
732 (define-key wdired-perm-mode-map "w" 'wdired-set-bit)
733 (define-key wdired-perm-mode-map "x" 'wdired-set-bit)
734 (define-key wdired-perm-mode-map "-" 'wdired-set-bit)
735 (define-key wdired-perm-mode-map "S" 'wdired-set-bit)
736 (define-key wdired-perm-mode-map "s" 'wdired-set-bit)
737 (define-key wdired-perm-mode-map "T" 'wdired-set-bit)
738 (define-key wdired-perm-mode-map "t" 'wdired-set-bit)
739 (define-key wdired-perm-mode-map "s" 'wdired-set-bit)
740 (define-key wdired-perm-mode-map "l" 'wdired-set-bit)
741 (define-key wdired-perm-mode-map [down-mouse-1] 'wdired-mouse-toggle-bit))
742
743 ;; Put a local-map to the permission bits of the files, and store the
744 ;; original name and permissions as a property
745 (defun wdired-preprocess-perms()
746 (let ((inhibit-read-only t)
747 filename)
748 (set (make-local-variable 'wdired-col-perm) nil)
749 (save-excursion
750 (goto-char (point-min))
751 (while (not (eobp))
752 (if (and (not (looking-at dired-re-sym))
753 (setq filename (wdired-get-filename)))
754 (progn
755 (re-search-forward dired-re-perms)
756 (or wdired-col-perm
757 (setq wdired-col-perm (- (current-column) 9)))
758 (if (eq wdired-allow-to-change-permissions 'advanced)
759 (put-text-property (match-beginning 0) (match-end 0)
760 'read-only nil)
761 (put-text-property (1+ (match-beginning 0)) (match-end 0)
762 'local-map wdired-perm-mode-map))
763 (put-text-property (match-end 0) (1+ (match-end 0)) 'end-perm t)
764 (put-text-property (match-beginning 0) (1+ (match-beginning 0))
765 'old-perm (match-string-no-properties 0))))
766 (forward-line)
767 (beginning-of-line)))))
768
769 (defun wdired-perm-allowed-in-pos (char pos)
770 (cond
771 ((= char ?-) t)
772 ((= char ?r) (= (% pos 3) 0))
773 ((= char ?w) (= (% pos 3) 1))
774 ((= char ?x) (= (% pos 3) 2))
775 ((memq char '(?s ?S)) (memq pos '(2 5)))
776 ((memq char '(?t ?T)) (= pos 8))
777 ((= char ?l) (= pos 5))))
778
779 (defun wdired-set-bit ()
780 "Set a permission bit character."
781 (interactive)
782 (if (wdired-perm-allowed-in-pos last-command-char
783 (- (current-column) wdired-col-perm))
784 (let ((new-bit (char-to-string last-command-char))
785 (inhibit-read-only t)
786 (pos-prop (- (point) (- (current-column) wdired-col-perm))))
787 (put-text-property 0 1 'local-map wdired-perm-mode-map new-bit)
788 (put-text-property 0 1 'read-only t new-bit)
789 (insert new-bit)
790 (delete-char 1)
791 (put-text-property pos-prop (1- pos-prop) 'perm-changed t))
792 (forward-char 1)))
793
794 (defun wdired-toggle-bit()
795 "Toggle the permission bit at point."
796 (interactive)
797 (let ((inhibit-read-only t)
798 (new-bit "-")
799 (pos-prop (- (point) (- (current-column) wdired-col-perm))))
800 (if (eq (char-after (point)) ?-)
801 (setq new-bit
802 (if (= (% (- (current-column) wdired-col-perm) 3) 0) "r"
803 (if (= (% (- (current-column) wdired-col-perm) 3) 1) "w"
804 "x"))))
805 (put-text-property 0 1 'local-map wdired-perm-mode-map new-bit)
806 (put-text-property 0 1 'read-only t new-bit)
807 (insert new-bit)
808 (delete-char 1)
809 (put-text-property pos-prop (1- pos-prop) 'perm-changed t)))
810
811 (defun wdired-mouse-toggle-bit (event)
812 "Toggle the permission bit that was left clicked."
813 (interactive "e")
814 (mouse-set-point event)
815 (wdired-toggle-bit))
816
817 ;; Allowed chars for 4000 bit are Ss in position 3
818 ;; Allowed chars for 2000 bit are Ssl in position 6
819 ;; Allowed chars for 1000 bit are Tt in position 9
820 (defun wdired-perms-to-number (perms)
821 (let ((nperm 0777))
822 (if (= (elt perms 1) ?-) (setq nperm (- nperm 400)))
823 (if (= (elt perms 2) ?-) (setq nperm (- nperm 200)))
824 (let ((p-bit (elt perms 3)))
825 (if (memq p-bit '(?- ?S)) (setq nperm (- nperm 100)))
826 (if (memq p-bit '(?s ?S)) (setq nperm (+ nperm 4000))))
827 (if (= (elt perms 4) ?-) (setq nperm (- nperm 40)))
828 (if (= (elt perms 5) ?-) (setq nperm (- nperm 20)))
829 (let ((p-bit (elt perms 6)))
830 (if (memq p-bit '(?- ?S ?l)) (setq nperm (- nperm 10)))
831 (if (memq p-bit '(?s ?S ?l)) (setq nperm (+ nperm 2000))))
832 (if (= (elt perms 7) ?-) (setq nperm (- nperm 4)))
833 (if (= (elt perms 8) ?-) (setq nperm (- nperm 2)))
834 (let ((p-bit (elt perms 9)))
835 (if (memq p-bit '(?- ?T)) (setq nperm (- nperm 1)))
836 (if (memq p-bit '(?t ?T)) (setq nperm (+ nperm 1000))))
837 nperm))
838
839 ;; Perform the changes in the permissions of the files that have
840 ;; changed.
841 (defun wdired-do-perm-changes ()
842 (let ((changes nil)
843 (errors 0)
844 (prop-wanted (if (eq wdired-allow-to-change-permissions 'advanced)
845 'old-perm 'perm-changed))
846 filename perms-ori perms-new perm-tmp)
847 (goto-char (next-single-property-change (point-min) prop-wanted
848 nil (point-max)))
849 (while (not (eobp))
850 (setq perms-ori (get-text-property (point) 'old-perm))
851 (setq perms-new (buffer-substring-no-properties
852 (point) (next-single-property-change (point) 'end-perm)))
853 (if (not (equal perms-ori perms-new))
854 (progn
855 (setq changes t)
856 (setq filename (wdired-get-filename nil t))
857 (if (= (length perms-new) 10)
858 (progn
859 (setq perm-tmp
860 (int-to-string (wdired-perms-to-number perms-new)))
861 (if (not (equal 0 (dired-call-process dired-chmod-program
862 t perm-tmp filename)))
863 (progn
864 (setq errors (1+ errors))
865 (dired-log (concat dired-chmod-program " " perm-tmp
866 " `" filename "' failed\n\n")))))
867 (setq errors (1+ errors))
868 (dired-log (concat "Cannot parse permission `" perms-new
869 "' for file `" filename "'\n\n")))))
870 (goto-char (next-single-property-change (1+ (point)) prop-wanted
871 nil (point-max))))
872 (cons changes errors)))
873
874 (provide 'wdired)
875 (run-hooks wdired-load-hooks)
876
877 ;;; wdired.el ends here
878
879