Commit | Line | Data |
---|---|---|
6a84b1a2 SM |
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 |