1;;; wdired.el --- Rename files editing their names in dired buffers
2
3;; Copyright (C) 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
4
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
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., 51 Franklin Street, Fifth Floor,
25;; Boston, MA 02110-1301, 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;;; Installation:
64
65;; Add this file (byte-compiling it is recommended) to your load-path.
66;; Then add one of these set of lines (or similar ones) to your config:
67;;
68;; This is the easy way:
69;;
70;; (require 'wdired)
71;; (define-key dired-mode-map "r" 'wdired-change-to-wdired-mode)
72;;
73;; This is the recommended way for faster Emacs startup time and lower
74;; memory consumption:
75;;
76;; (autoload 'wdired-change-to-wdired-mode "wdired")
77;; (eval-after-load "dired"
78;;           '(lambda ()
79;;              (define-key dired-mode-map "r" 'wdired-change-to-wdired-mode)
80;;              (define-key dired-mode-map
81;;                [menu-bar immediate wdired-change-to-wdired-mode]
82;;                '("Edit File Names" . wdired-change-to-wdired-mode))))
83;;
84;; Type "M-x customize-group RET wdired" if you want to make changes
85;; to the default behavior.
86
87;;; Usage:
88
89;; Then, you can start editing the names of the files by typing "r"
90;; (or whatever key you choose, or M-x wdired-change-to-wdired-mode).
91;; Use C-c C-c when finished or C-c C-k to abort. You can use also the
92;; menu options: in dired mode, "Edit File Names" under "Immediate".
93;; While editing the names, a new submenu "WDired" is available at top
94;; level. You can customize the behavior of this package from this
95;; menu.
96
97;;; Change Log:
98
99;; Google is your friend (previous versions with complete changelogs
100;; were posted to gnu.emacs.sources)
101
102;;; Code:
103
104(defvar dired-backup-overwrite) ; Only in Emacs 20.x this is a custom var
105
106(eval-when-compile (require 'cl))
107(require 'dired)
108(autoload 'dired-do-create-files-regexp "dired-aux")
109(autoload 'dired-call-process "dired-aux")
110
111(defgroup wdired nil
112  "Mode to rename files by editing their names in dired buffers."
113  :group 'dired)
114
115(defcustom wdired-use-interactive-rename nil
116  "If non-nil, WDired requires confirmation before actually renaming files.
117If nil, WDired doesn't require confirmation to change the file names,
118and the variable `wdired-confirm-overwrite' controls whether it is ok
119to overwrite files without asking."
120  :type 'boolean
121  :group 'wdired)
122
123(defcustom wdired-confirm-overwrite t
124  "If nil the renames can overwrite files without asking.
125This variable has no effect at all if `wdired-use-interactive-rename'
126is not nil."
127  :type 'boolean
128  :group 'wdired)
129
130(defcustom wdired-use-dired-vertical-movement nil
131  "If t, the \"up\" and \"down\" movement works as in Dired mode.
132That is, always move the point to the beginning of the filename at line.
133
134If `sometimes, only move to the beginning of filename if the point is
135before it, and `track-eol' is honored.  This behavior is very handy
136when editing several filenames.
137
138If nil, \"up\" and \"down\" movement is done as in any other buffer."
139  :type '(choice (const :tag "As in any other mode" nil)
140		 (const :tag "Smart cursor placement" sometimes)
141		 (other :tag "As in dired mode" t))
142  :group 'wdired)
143
144(defcustom wdired-allow-to-redirect-links t
145  "If non-nil, the target of the symbolic links are editable.
146In systems without symbolic links support, this variable has no effect
147at all."
148  :type 'boolean
149  :group 'wdired)
150
151(defcustom wdired-allow-to-change-permissions nil
152  "If non-nil, the permissions bits of the files are editable.
153
154If t, to change a single bit, put the cursor over it and press the
155space bar, or left click over it.  You can also hit the letter you want
156to set: if this value is allowed, the character in the buffer will be
157changed.  Anyway, the point is advanced one position, so, for example,
158you can keep the <x> key pressed to give execution permissions to
159everybody to that file.
160
161If `advanced, the bits are freely editable.  You can use
162`string-rectangle', `query-replace', etc.  You can put any value (even
163newlines), but if you want your changes to be useful, you better put a
164intelligible value.
165
166Anyway, the real change of the permissions is done by the external
167program `dired-chmod-program', which must exist."
168  :type '(choice (const :tag "Not allowed" nil)
169                 (const :tag "Toggle/set bits" t)
170		 (other :tag "Bits freely editable" advanced))
171  :group 'wdired)
172
173(defvar wdired-mode-map
174  (let ((map (make-sparse-keymap)))
175    (define-key map "\C-x\C-s" 'wdired-finish-edit)
176    (define-key map "\C-c\C-c" 'wdired-finish-edit)
177    (define-key map "\C-c\C-k" 'wdired-abort-changes)
178    (define-key map "\C-c\C-[" 'wdired-abort-changes)
179    (define-key map "\C-m"     'ignore)
180    (define-key map "\C-j"     'ignore)
181    (define-key map "\C-o"     'ignore)
182    (define-key map [up]       'wdired-previous-line)
183    (define-key map "\C-p"     'wdired-previous-line)
184    (define-key map [down]     'wdired-next-line)
185    (define-key map "\C-n"     'wdired-next-line)
186
187    (define-key map [menu-bar wdired]
188      (cons "WDired" (make-sparse-keymap "WDired")))
189    (define-key map [menu-bar wdired wdired-customize]
190      '("Options" . wdired-customize))
191    (define-key map [menu-bar wdired dashes]
192      '("--"))
193    (define-key map [menu-bar wdired wdired-abort-changes]
194      '(menu-item "Abort Changes" wdired-abort-changes
195		  :help "Abort changes and return to dired mode"))
196    (define-key map [menu-bar wdired wdired-finish-edit]
197      '("Commit Changes" . wdired-finish-edit))
198
199    (define-key map [remap upcase-word] 'wdired-upcase-word)
200    (define-key map [remap capitalize-word] 'wdired-capitalize-word)
201    (define-key map [remap downcase-word] 'wdired-downcase-word)
202
203    map))
204
205(defvar wdired-mode-hook nil
206  "Hooks run when changing to WDired mode.")
207
208;; Local variables (put here to avoid compilation gripes)
209(defvar wdired-col-perm) ;; Column where the permission bits start
210(defvar wdired-old-content)
211(defvar wdired-old-point)
212
213
214(defun wdired-mode ()
215  "\\<wdired-mode-map>File Names Editing mode.
216
217Press \\[wdired-finish-edit] to make the changes to take effect
218and exit.  To abort the edit, use \\[wdired-abort-changes].
219
220In this mode you can edit the names of the files, the target of
221the links and the permission bits of the files.  You can use
222\\[customize-group] RET wdired to customize WDired behavior.
223
224The only editable texts in a WDired buffer are filenames,
225symbolic link targets, and filenames permission."
226  (interactive)
227  (error "This mode can be enabled only by `wdired-change-to-wdired-mode'"))
228(put 'wdired-mode 'mode-class 'special)
229
230
231;;;###autoload
232(defun wdired-change-to-wdired-mode ()
233  "Put a dired buffer in a mode in which filenames are editable.
234\\<wdired-mode-map>
235This mode allows the user to change the names of the files, and after
236typing \\[wdired-finish-edit] Emacs renames the files and directories
237in disk.
238
239See `wdired-mode'."
240  (interactive)
241  (or (eq major-mode 'dired-mode)
242      (error "Not a Dired buffer"))
243  (set (make-local-variable 'wdired-old-content)
244       (buffer-substring (point-min) (point-max)))
245  (set (make-local-variable 'wdired-old-point) (point))
246  (set (make-local-variable 'query-replace-skip-read-only) t)
247  (use-local-map wdired-mode-map)
248  (force-mode-line-update)
249  (setq buffer-read-only nil)
250  (dired-unadvertise default-directory)
251  (add-hook 'kill-buffer-hook 'wdired-check-kill-buffer nil t)
252  (setq major-mode 'wdired-mode)
253  (setq mode-name "Editable Dired")
254  (setq revert-buffer-function 'wdired-revert)
255  ;; I temp disable undo for performance: since I'm going to clear the
256  ;; undo list, it can save more than a 9% of time with big
257  ;; directories because setting properties modify the undo-list.
258  (buffer-disable-undo)
259  (wdired-preprocess-files)
260  (if wdired-allow-to-change-permissions
261      (wdired-preprocess-perms))
262  (if (and wdired-allow-to-redirect-links (fboundp 'make-symbolic-link))
263      (wdired-preprocess-symlinks))
264  (buffer-enable-undo) ; Performance hack. See above.
265  (set-buffer-modified-p nil)
266  (setq buffer-undo-list nil)
267  (run-mode-hooks 'wdired-mode-hook)
268  (message "%s" (substitute-command-keys
269		 "Press \\[wdired-finish-edit] when finished \
270or \\[wdired-abort-changes] to abort changes")))
271
272
273;; Protect the buffer so only the filenames can be changed, and put
274;; properties so filenames (old and new) can be easily found.
275(defun wdired-preprocess-files ()
276  (put-text-property 1 2 'front-sticky t)
277  (save-excursion
278    (goto-char (point-min))
279    (let ((b-protection (point))
280	  filename)
281      (while (not (eobp))
282	(setq filename (dired-get-filename nil t))
283        (when (and filename
284		   (not (member (file-name-nondirectory filename) '("." ".."))))
285	  (dired-move-to-filename)
286	  ;; The rear-nonsticky property below shall ensure that text preceding
287	  ;; the filename can't be modified.
288	  (add-text-properties
289	   (1- (point)) (point) `(old-name ,filename rear-nonsticky (read-only)))
290	  (put-text-property b-protection (point) 'read-only t)
291	  (setq b-protection (dired-move-to-end-of-filename t))
292	  (put-text-property (point) (1+ (point)) 'end-name t))
293        (forward-line))
294      (put-text-property b-protection (point-max) 'read-only t))))
295
296;; This code is a copy of some dired-get-filename lines.
297(defsubst wdired-normalize-filename (file)
298  (setq file
299	;; FIXME: shouldn't we check for a `b' argument or somesuch before
300	;; doing such unquoting?  --Stef
301	(read (concat
302	       "\"" (replace-regexp-in-string
303		     "\\([^\\]\\|\\`\\)\"" "\\1\\\\\"" file)
304	       "\"")))
305  (and file buffer-file-coding-system
306       (not file-name-coding-system)
307       (not default-file-name-coding-system)
308       (setq file (encode-coding-string file buffer-file-coding-system)))
309  file)
310
311(defun wdired-get-filename (&optional no-dir old)
312  "Return the filename at line.
313Similar to `dired-get-filename' but it doesn't rely on regexps.  It
314relies on WDired buffer's properties.  Optional arg NO-DIR with value
315non-nil means don't include directory.  Optional arg OLD with value
316non-nil means return old filename."
317  ;; FIXME: Use dired-get-filename's new properties.
318  (let (beg end file)
319    (save-excursion
320      (setq end (line-end-position))
321      (beginning-of-line)
322      (setq beg (next-single-property-change (point) 'old-name nil end))
323      (unless (eq beg end)
324	(if old
325	    (setq file (get-text-property beg 'old-name))
326	  (setq end (next-single-property-change (1+ beg) 'end-name))
327	  (setq file (buffer-substring-no-properties (1+ beg) end)))
328	(and file (setq file (wdired-normalize-filename file))))
329      (if (or no-dir old)
330	  file
331	(and file (> (length file) 0)
332             (concat (dired-current-directory) file))))))
333
334
335(defun wdired-change-to-dired-mode ()
336  "Change the mode back to dired."
337  (or (eq major-mode 'wdired-mode)
338      (error "Not a Wdired buffer"))
339  (let ((inhibit-read-only t))
340    (remove-text-properties
341     (point-min) (point-max)
342     '(front-sticky nil rear-nonsticky nil read-only nil keymap nil)))
343  (use-local-map dired-mode-map)
344  (force-mode-line-update)
345  (setq buffer-read-only t)
346  (setq major-mode 'dired-mode)
347  (setq mode-name "Dired")
348  (dired-advertise)
349  (remove-hook 'kill-buffer-hook 'wdired-check-kill-buffer t)
350  (set (make-local-variable 'revert-buffer-function) 'dired-revert))
351
352
353(defun wdired-abort-changes ()
354  "Abort changes and return to dired mode."
355  (interactive)
356  (let ((inhibit-read-only t))
357    (erase-buffer)
358    (insert wdired-old-content)
359    (goto-char wdired-old-point))
360  (wdired-change-to-dired-mode)
361  (set-buffer-modified-p nil)
362  (setq buffer-undo-list nil)
363  (message "Changes aborted"))
364
365(defun wdired-finish-edit ()
366  "Actually rename files based on your editing in the Dired buffer."
367  (interactive)
368  (wdired-change-to-dired-mode)
369  (let ((overwrite (or (not wdired-confirm-overwrite) 1))
370	(changes nil)
371	(files-deleted nil)
372	(errors 0)
373	file-ori file-new tmp-value)
374    (save-excursion
375      (when (and wdired-allow-to-redirect-links
376		 (fboundp 'make-symbolic-link))
377	(setq tmp-value (wdired-do-symlink-changes))
378	(setq errors (cdr tmp-value))
379	(setq changes (car tmp-value)))
380      (when (and wdired-allow-to-change-permissions
381		 (boundp 'wdired-col-perm)) ; could have been changed
382	(setq tmp-value (wdired-do-perm-changes))
383	(setq errors (+ errors (cdr tmp-value)))
384	(setq changes (or changes (car tmp-value))))
385      (goto-char (point-max))
386      (while (not (bobp))
387	(setq file-ori (wdired-get-filename nil t))
388	(when file-ori
389	  (setq file-new (wdired-get-filename)))
390	(when (and file-ori (not (equal file-new file-ori)))
391	  (setq changes t)
392	  (if (not file-new)		;empty filename!
393	      (setq files-deleted (cons file-ori files-deleted))
394	    (setq file-new (substitute-in-file-name file-new))
395	    (if wdired-use-interactive-rename
396		(wdired-search-and-rename file-ori file-new)
397	      ;; If dired-rename-file autoloads dired-aux while
398	      ;; dired-backup-overwrite is locally bound,
399	      ;; dired-backup-overwrite won't be initialized.
400	      ;; So we must ensure dired-aux is loaded.
401	      (require 'dired-aux)
402	      (condition-case err
403		  (let ((dired-backup-overwrite nil))
404		    (dired-rename-file file-ori file-new
405				       overwrite))
406		(error
407		 (setq errors (1+ errors))
408		 (dired-log (concat "Rename `" file-ori "' to `"
409				    file-new "' failed:\n%s\n")
410			    err))))))
411	(forward-line -1)))
412    (if changes
413        (revert-buffer) ;The "revert" is necessary to re-sort the buffer
414      (let ((inhibit-read-only t))
415	(remove-text-properties (point-min) (point-max)
416				'(old-name nil end-name nil old-link nil
417					   end-link nil end-perm nil
418					   old-perm nil perm-changed nil))
419	(message "(No changes to be performed)")))
420    (when files-deleted
421      (wdired-flag-for-deletion files-deleted))
422    (when (> errors 0)
423      (dired-log-summary (format "%d rename actions failed" errors) nil)))
424  (set-buffer-modified-p nil)
425  (setq buffer-undo-list nil))
426
427;; Rename a file, searching it in a modified dired buffer, in order
428;; to be able to use `dired-do-create-files-regexp' and get its
429;; "benefits".
430(defun wdired-search-and-rename (filename-ori filename-new)
431  (save-excursion
432    (goto-char (point-max))
433    (forward-line -1)
434    (let ((exit-while nil)
435	  curr-filename)
436      (while (not exit-while)
437        (setq curr-filename (wdired-get-filename))
438        (if (and curr-filename
439                 (equal (substitute-in-file-name curr-filename) filename-new))
440            (progn
441              (setq exit-while t)
442              (let ((inhibit-read-only t))
443                (dired-move-to-filename)
444                (search-forward (wdired-get-filename t) nil t)
445                (replace-match (file-name-nondirectory filename-ori) t t))
446              (dired-do-create-files-regexp
447               (function dired-rename-file)
448               "Move" 1 ".*" filename-new nil t))
449	  (forward-line -1)
450	  (beginning-of-line)
451	  (setq exit-while (bobp)))))))
452
453;; marks a list of files for deletion
454(defun wdired-flag-for-deletion (filenames-ori)
455  (save-excursion
456    (goto-char (point-min))
457    (while (not (eobp))
458      (if (member (dired-get-filename nil t) filenames-ori)
459          (dired-flag-file-deletion 1)
460	(forward-line)))))
461
462(defun wdired-customize ()
463  "Customize WDired options."
464  (interactive)
465  (customize-apropos "wdired" 'groups))
466
467(defun wdired-revert (&optional arg noconfirm)
468  "Discard changes in the buffer and update it based on changes on disk.
469Optional arguments are ignored."
470  (wdired-change-to-dired-mode)
471  (revert-buffer)
472  (wdired-change-to-wdired-mode))
473
474(defun wdired-check-kill-buffer ()
475  ;; FIXME: Can't we use the normal mechanism for that?  --Stef
476  (if (and
477       (buffer-modified-p)
478       (not (y-or-n-p "Buffer changed. Discard changes and kill buffer? ")))
479      (error nil)))
480
481(defun wdired-next-line (arg)
482  "Move down lines then position at filename or the current column.
483See `wdired-use-dired-vertical-movement'.  Optional prefix ARG
484says how many lines to move; default is one line."
485  (interactive "p")
486  (next-line arg)
487  (if (or (eq wdired-use-dired-vertical-movement t)
488	  (and wdired-use-dired-vertical-movement
489	       (< (current-column)
490		  (save-excursion (dired-move-to-filename)
491				  (current-column)))))
492      (dired-move-to-filename)))
493
494(defun wdired-previous-line (arg)
495  "Move up lines then position at filename or the current column.
496See `wdired-use-dired-vertical-movement'.  Optional prefix ARG
497says how many lines to move; default is one line."
498  (interactive "p")
499  (previous-line arg)
500  (if (or (eq wdired-use-dired-vertical-movement t)
501	  (and wdired-use-dired-vertical-movement
502	       (< (current-column)
503		  (save-excursion (dired-move-to-filename)
504				  (current-column)))))
505      (dired-move-to-filename)))
506
507;; Put the needed properties to allow the user to change links' targets
508(defun wdired-preprocess-symlinks ()
509  (let ((inhibit-read-only t))
510    (save-excursion
511      (goto-char (point-min))
512      (while (not (eobp))
513        (if (looking-at dired-re-sym)
514            (progn
515              (re-search-forward " -> \\(.*\\)$")
516	      (put-text-property (- (match-beginning 1) 2)
517				 (1- (match-beginning 1)) 'old-link
518				 (match-string-no-properties 1))
519              (put-text-property (match-end 1) (1+ (match-end 1)) 'end-link t)
520              (put-text-property (1- (match-beginning 1))
521				 (match-beginning 1)
522				 'rear-nonsticky '(read-only))
523	      (put-text-property (match-beginning 1)
524				 (match-end 1) 'read-only nil)))
525        (forward-line)
526	(beginning-of-line)))))
527
528
529(defun wdired-get-previous-link (&optional old move)
530  "Return the next symlink target.
531If OLD, return the old target.  If MOVE, move point before it."
532  (let (beg end target)
533    (setq beg (previous-single-property-change (point) 'old-link nil))
534    (if beg
535	(progn
536	  (if old
537	      (setq target (get-text-property (1- beg) 'old-link))
538	    (setq end (next-single-property-change beg 'end-link))
539	    (setq target (buffer-substring-no-properties (1+ beg) end)))
540	  (if move (goto-char (1- beg)))))
541    (and target (wdired-normalize-filename target))))
542
543
544;; Perform the changes in the target of the changed links.
545(defun wdired-do-symlink-changes ()
546  (let ((changes nil)
547	(errors 0)
548	link-to-ori link-to-new link-from)
549    (goto-char (point-max))
550    (while (setq link-to-new (wdired-get-previous-link))
551      (setq link-to-ori (wdired-get-previous-link t t))
552      (setq link-from (wdired-get-filename nil t))
553      (unless (equal link-to-new link-to-ori)
554        (setq changes t)
555        (if (equal link-to-new "") ;empty filename!
556            (setq link-to-new "/dev/null"))
557        (condition-case err
558            (progn
559              (delete-file link-from)
560              (make-symbolic-link
561               (substitute-in-file-name link-to-new) link-from))
562          (error
563           (setq errors (1+ errors))
564           (dired-log (concat "Link `" link-from "' to `"
565                              link-to-new "' failed:\n%s\n")
566                      err)))))
567    (cons changes errors)))
568
569;; Perform a "case command" skipping read-only words.
570(defun wdired-xcase-word (command arg)
571  (if (< arg 0)
572      (funcall command arg)
573    (while (> arg 0)
574      (condition-case err
575          (progn
576            (funcall command 1)
577            (setq arg (1- arg)))
578        (error
579         (if (forward-word)
580	     ;; Skip any non-word characters to avoid triggering a read-only
581	     ;; error which would cause skipping the next word characters too.
582	     (skip-syntax-forward "^w")
583	   (setq arg 0)))))))
584
585(defun wdired-downcase-word (arg)
586  "WDired version of `downcase-word'.
587Like original function but it skips read-only words."
588  (interactive "p")
589  (wdired-xcase-word 'downcase-word arg))
590
591(defun wdired-upcase-word (arg)
592  "WDired version of `upcase-word'.
593Like original function but it skips read-only words."
594  (interactive "p")
595  (wdired-xcase-word 'upcase-word arg))
596
597(defun wdired-capitalize-word (arg)
598  "WDired version of `capitalize-word'.
599Like original function but it skips read-only words."
600  (interactive "p")
601  (wdired-xcase-word 'capitalize-word arg))
602
603
604;; The following code deals with changing the access bits (or
605;; permissions) of the files.
606
607(defvar wdired-perm-mode-map
608  (let ((map (make-sparse-keymap)))
609    (define-key map " " 'wdired-toggle-bit)
610    (define-key map "r" 'wdired-set-bit)
611    (define-key map "w" 'wdired-set-bit)
612    (define-key map "x" 'wdired-set-bit)
613    (define-key map "-" 'wdired-set-bit)
614    (define-key map "S" 'wdired-set-bit)
615    (define-key map "s" 'wdired-set-bit)
616    (define-key map "T" 'wdired-set-bit)
617    (define-key map "t" 'wdired-set-bit)
618    (define-key map "s" 'wdired-set-bit)
619    (define-key map "l" 'wdired-set-bit)
620    (define-key map [down-mouse-1] 'wdired-mouse-toggle-bit)
621    map))
622
623;; Put a keymap property to the permission bits of the files, and store the
624;; original name and permissions as a property
625(defun wdired-preprocess-perms ()
626  (let ((inhibit-read-only t))
627    (set (make-local-variable 'wdired-col-perm) nil)
628    (save-excursion
629      (goto-char (point-min))
630      (while (not (eobp))
631	(when (and (not (looking-at dired-re-sym))
632		   (wdired-get-filename)
633		   (re-search-forward dired-re-perms (line-end-position) 'eol))
634	  (let ((begin (match-beginning 0))
635		(end (match-end 0)))
636	    (unless wdired-col-perm
637	      (setq wdired-col-perm (- (current-column) 9)))
638	    (if (eq wdired-allow-to-change-permissions 'advanced)
639		(progn
640		  (put-text-property begin end 'read-only nil)
641		  ;; make first permission bit writable
642		  (put-text-property
643		   (1- begin) begin 'rear-nonsticky '(read-only)))
644	      ;; avoid that keymap applies to text following permissions
645	      (add-text-properties
646	       (1+ begin) end
647	       `(keymap ,wdired-perm-mode-map rear-nonsticky (keymap))))
648	    (put-text-property end (1+ end) 'end-perm t)
649	    (put-text-property
650	     begin (1+ begin) 'old-perm (match-string-no-properties 0))))
651        (forward-line)
652	(beginning-of-line)))))
653
654(defun wdired-perm-allowed-in-pos (char pos)
655  (cond
656   ((= char ?-)          t)
657   ((= char ?r)          (= (% pos 3) 0))
658   ((= char ?w)          (= (% pos 3) 1))
659   ((= char ?x)          (= (% pos 3) 2))
660   ((memq char '(?s ?S)) (memq pos '(2 5)))
661   ((memq char '(?t ?T)) (= pos 8))
662   ((= char ?l)          (= pos 5))))
663
664(defun wdired-set-bit ()
665  "Set a permission bit character."
666  (interactive)
667  (if (wdired-perm-allowed-in-pos last-command-char
668                                  (- (current-column) wdired-col-perm))
669      (let ((new-bit (char-to-string last-command-char))
670            (inhibit-read-only t)
671	    (pos-prop (- (point) (- (current-column) wdired-col-perm))))
672        (put-text-property 0 1 'keymap wdired-perm-mode-map new-bit)
673        (put-text-property 0 1 'read-only t new-bit)
674        (insert new-bit)
675        (delete-char 1)
676	(put-text-property (1- pos-prop) pos-prop 'perm-changed t)
677	(put-text-property (1- (point)) (point) 'rear-nonsticky '(keymap)))
678    (forward-char 1)))
679
680(defun wdired-toggle-bit ()
681  "Toggle the permission bit at point."
682  (interactive)
683  (let ((inhibit-read-only t)
684	(new-bit "-")
685	(pos-prop (- (point) (- (current-column) wdired-col-perm))))
686    (if (eq (char-after (point)) ?-)
687	(setq new-bit
688	      (if (= (% (- (current-column) wdired-col-perm) 3) 0) "r"
689		(if (= (% (- (current-column) wdired-col-perm) 3) 1) "w"
690		  "x"))))
691    (put-text-property 0 1 'keymap wdired-perm-mode-map new-bit)
692    (put-text-property 0 1 'read-only t new-bit)
693    (insert new-bit)
694    (delete-char 1)
695    (put-text-property (1- pos-prop) pos-prop 'perm-changed t)
696    (put-text-property (1- (point)) (point) 'rear-nonsticky '(keymap))))
697
698(defun wdired-mouse-toggle-bit (event)
699  "Toggle the permission bit that was left clicked."
700  (interactive "e")
701  (mouse-set-point event)
702  (wdired-toggle-bit))
703
704;; Allowed chars for 4000 bit are Ss  in position 3
705;; Allowed chars for 2000 bit are Ssl in position 6
706;; Allowed chars for 1000 bit are Tt  in position 9
707(defun wdired-perms-to-number (perms)
708  (let ((nperm 0777))
709    (if (= (elt perms 1) ?-) (setq nperm (- nperm 400)))
710    (if (= (elt perms 2) ?-) (setq nperm (- nperm 200)))
711    (let ((p-bit (elt perms 3)))
712      (if (memq p-bit '(?- ?S)) (setq nperm (- nperm 100)))
713      (if (memq p-bit '(?s ?S)) (setq nperm (+ nperm 4000))))
714    (if (= (elt perms 4) ?-) (setq nperm (- nperm 40)))
715    (if (= (elt perms 5) ?-) (setq nperm (- nperm 20)))
716    (let ((p-bit (elt perms 6)))
717      (if (memq p-bit '(?- ?S ?l)) (setq nperm (- nperm 10)))
718      (if (memq p-bit '(?s ?S ?l)) (setq nperm (+ nperm 2000))))
719    (if (= (elt perms 7) ?-) (setq nperm (- nperm 4)))
720    (if (= (elt perms 8) ?-) (setq nperm (- nperm 2)))
721    (let ((p-bit (elt perms 9)))
722      (if (memq p-bit '(?- ?T)) (setq nperm (- nperm 1)))
723      (if (memq p-bit '(?t ?T)) (setq nperm (+ nperm 1000))))
724    nperm))
725
726;; Perform the changes in the permissions of the files that have
727;; changed.
728(defun wdired-do-perm-changes ()
729  (let ((changes nil)
730	(errors 0)
731	(prop-wanted (if (eq wdired-allow-to-change-permissions 'advanced)
732			 'old-perm 'perm-changed))
733	filename perms-ori perms-new perm-tmp)
734    (goto-char (next-single-property-change (point-min) prop-wanted
735					    nil (point-max)))
736    (while (not (eobp))
737      (setq perms-ori (get-text-property (point) 'old-perm))
738      (setq perms-new (buffer-substring-no-properties
739		       (point) (next-single-property-change (point) 'end-perm)))
740      (unless (equal perms-ori perms-new)
741        (setq changes t)
742        (setq filename (wdired-get-filename nil t))
743        (if (= (length perms-new) 10)
744            (progn
745              (setq perm-tmp
746                    (int-to-string (wdired-perms-to-number perms-new)))
747              (unless (equal 0 (dired-call-process dired-chmod-program
748                                                   t perm-tmp filename))
749                (setq errors (1+ errors))
750                (dired-log (concat dired-chmod-program " " perm-tmp
751                                   " `" filename "' failed\n\n"))))
752          (setq errors (1+ errors))
753          (dired-log (concat "Cannot parse permission `" perms-new
754                             "' for file `" filename "'\n\n"))))
755      (goto-char (next-single-property-change (1+ (point)) prop-wanted
756					      nil (point-max))))
757    (cons changes errors)))
758
759(provide 'wdired)
760
761;; Local Variables:
762;; coding: latin-1
763;; byte-compile-dynamic: t
764;; End:
765
766;; arch-tag: bc00902e-526f-4305-bc7f-8862a559184f
767;;; wdired.el ends here
768