wdired.el 27.5 KB
Newer Older
Stefan Monnier's avatar
Stefan Monnier committed
1 2
;;; wdired.el --- Rename files editing their names in dired buffers

3
;; Copyright (C) 2004, 2005 Free Software Foundation, Inc.
Stefan Monnier's avatar
Stefan Monnier committed
4 5

;; Filename: wdired.el
6 7
;; Author: Juan León Lahoz García <juanleon1@gmail.com>
;; Version: 2.0
Stefan Monnier's avatar
Stefan Monnier committed
8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
;; Keywords: dired, environment, files, renaming

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2, or (at
;; your option) any later version.

;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
Lute Kamstra's avatar
Lute Kamstra committed
24 25
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
Stefan Monnier's avatar
Stefan Monnier committed
26 27 28 29 30 31 32

;;; Commentary:

;; wdired.el (the "w" is for writable) provides an alternative way of
;; renaming files.
;;
;; 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
Stefan Monnier's avatar
Stefan Monnier committed
34 35
;; the files in a "dired" buffer? Now you can do this.  All the power
;; of Emacs commands are available to renaming files!
Stefan Monnier's avatar
Stefan Monnier committed
36 37 38 39 40 41 42
;; 
;; This package provides a function that makes the filenames of a a
;; dired buffer editable, by changing the buffer mode (which inhibits
;; all of the commands of dired mode). Here you can edit the names of
;; one or more files and directories, and when you press C-c C-c, the
;; renaming takes effect and you are back to dired mode.
;;
Stefan Monnier's avatar
Stefan Monnier committed
43
;; Another things you can do with WDired:
Stefan Monnier's avatar
Stefan Monnier committed
44 45 46 47 48 49 50 51
;;
;; - To move files to another directory (by typing their path,
;;   absolute or relative, as a part of the new filename).
;;
;; - To change the target of symbolic links.
;;
;; - To change the permission bits of the filenames (in systems with a
;;   working unix-alike `dired-chmod-program'). See and customize the
Stefan Monnier's avatar
Stefan Monnier committed
52
;;   variable `wdired-allow-to-change-permissions'.  To change a single
Stefan Monnier's avatar
Stefan Monnier committed
53
;;   char (toggling between its two more usual values) you can press
Stefan Monnier's avatar
Stefan Monnier committed
54
;;   the space bar over it or left-click the mouse.  To set any char to
Stefan Monnier's avatar
Stefan Monnier committed
55
;;   an specific value (this includes the SUID, SGID and STI bits) you
Stefan Monnier's avatar
Stefan Monnier committed
56
;;   can use the key labeled as the letter you want.  Please note that
Stefan Monnier's avatar
Stefan Monnier committed
57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72
;;   permissions of the links cannot be changed in that way, because
;;   the change would affect to their targets, and this would not be
;;   WYSIWYG :-).
;;
;; - To mark files for deletion, by deleting their whole filename.

;;; Installation:

;; Add this file (byte-compiling it is recommended) to your load-path.
;; Then add one of these set of lines (or similar ones) to your config:
;;
;; This is the easy way:
;;
;; (require 'wdired)
;; (define-key dired-mode-map "r" 'wdired-change-to-wdired-mode)
;;
Stefan Monnier's avatar
Stefan Monnier committed
73 74
;; This is the recommended way for faster Emacs startup time and lower
;; memory consumption:
Stefan Monnier's avatar
Stefan Monnier committed
75 76
;;
;; (autoload 'wdired-change-to-wdired-mode "wdired")
Stefan Monnier's avatar
Stefan Monnier committed
77
;; (eval-after-load "dired"
Stefan Monnier's avatar
Stefan Monnier committed
78 79 80 81 82 83
;;           '(lambda ()
;;              (define-key dired-mode-map "r" 'wdired-change-to-wdired-mode)
;;              (define-key dired-mode-map
;;                [menu-bar immediate wdired-change-to-wdired-mode]
;;                '("Edit File Names" . wdired-change-to-wdired-mode))))
;;
Stefan Monnier's avatar
Stefan Monnier committed
84 85
;; Type "M-x customize-group RET wdired" if you want to make changes
;; to the default behavior.
Stefan Monnier's avatar
Stefan Monnier committed
86 87 88 89 90 91 92 93 94 95 96 97 98

;;; Usage:

;; Then, you can start editing the names of the files by typing "r"
;; (or whatever key you choose, or M-x wdired-change-to-wdired-mode).
;; Use C-c C-c when finished or C-c C-k to abort. You can use also the
;; menu options: in dired mode, "Edit File Names" under "Immediate".
;; While editing the names, a new submenu "WDired" is available at top
;; level. You can customize the behavior of this package from this
;; menu.

;;; Change Log:

Stefan Monnier's avatar
Stefan Monnier committed
99 100
;; Google is your friend (previous versions with complete changelogs
;; were posted to gnu.emacs.sources)
Stefan Monnier's avatar
Stefan Monnier committed
101 102 103

;;; Code:

Stefan Monnier's avatar
Stefan Monnier committed
104
(defvar dired-backup-overwrite) ; Only in Emacs 20.x this is a custom var
Stefan Monnier's avatar
Stefan Monnier committed
105 106 107 108 109 110 111 112 113 114 115 116 117
(eval-when-compile
  (set (make-local-variable 'byte-compile-dynamic) t))

(eval-and-compile
  (require 'dired)
  (autoload 'dired-do-create-files-regexp "dired-aux")
  (autoload 'dired-call-process "dired-aux"))

(defgroup wdired nil
  "Mode to rename files by editing their names in dired buffers."
  :group 'dired)

(defcustom wdired-use-interactive-rename nil
Stefan Monnier's avatar
Stefan Monnier committed
118 119 120 121
  "*If non-nil, WDired requires confirmation before actually renaming files.
If nil, WDired doesn't require confirmation to change the file names,
and the variable `wdired-confirm-overwrite' controls whether it is ok
to overwrite files without asking."
Stefan Monnier's avatar
Stefan Monnier committed
122 123 124
  :type 'boolean
  :group 'wdired)

Stefan Monnier's avatar
Stefan Monnier committed
125 126 127 128
(defcustom wdired-confirm-overwrite t
  "*If nil the renames can overwrite files without asking. 
This variable has no effect at all if `wdired-use-interactive-rename'
is not nil."
Stefan Monnier's avatar
Stefan Monnier committed
129 130 131
  :type 'boolean
  :group 'wdired)

Stefan Monnier's avatar
Stefan Monnier committed
132 133
(defcustom wdired-use-dired-vertical-movement nil
  "*If t, the \"up\" and \"down\" movement works as in Dired mode.
Stefan Monnier's avatar
Stefan Monnier committed
134 135 136 137 138 139 140 141 142 143 144 145 146
That is, always move the point to the beginning of the filename at line.

If `sometimes, only move to the beginning of filename if the point is
before it, and `track-eol' is honored.  This behavior is very handy
when editing several filenames.

If nil, \"up\" and \"down\" movement is done as in any other buffer."
  :type '(choice (const :tag "As in any other mode" nil)
		 (const :tag "Smart cursor placement" sometimes)
		 (other :tag "As in dired mode" t))
  :group 'wdired)

(defcustom wdired-allow-to-redirect-links t
Stefan Monnier's avatar
Stefan Monnier committed
147
  "*If non-nil, the target of the symbolic links are editable.
Stefan Monnier's avatar
Stefan Monnier committed
148 149 150 151 152 153
In systems without symbolic links support, this variable has no effect
at all."
  :type 'boolean
  :group 'wdired)

(defcustom wdired-allow-to-change-permissions nil
Stefan Monnier's avatar
Stefan Monnier committed
154
  "*If non-nil, the permissions bits of the files are editable.
Stefan Monnier's avatar
Stefan Monnier committed
155 156 157 158 159

If t, to change a single bit, put the cursor over it and press the
space bar, or left click over it.  You can also hit the letter you want
to set: if this value is allowed, the character in the buffer will be
changed.  Anyway, the point is advanced one position, so, for example,
Stefan Monnier's avatar
Stefan Monnier committed
160
you can keep the <x> key pressed to give execution permissions to
Stefan Monnier's avatar
Stefan Monnier committed
161 162 163 164 165 166 167
everybody to that file.

If `advanced, the bits are freely editable.  You can use
`string-rectangle', `query-replace', etc.  You can put any value (even
newlines), but if you want your changes to be useful, you better put a
intelligible value.

Stefan Monnier's avatar
Stefan Monnier committed
168
Anyway, the real change of the permissions is done by the external
Stefan Monnier's avatar
Stefan Monnier committed
169 170
program `dired-chmod-program', which must exist."
  :type '(choice (const :tag "Not allowed" nil)
171
                 (const :tag "Toggle/set bits" t)
Stefan Monnier's avatar
Stefan Monnier committed
172 173 174
		 (other :tag "Bits freely editable" advanced))
  :group 'wdired)

175 176 177 178 179 180
(defvar wdired-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map "\C-x\C-s" 'wdired-finish-edit)
    (define-key map "\C-c\C-c" 'wdired-finish-edit)
    (define-key map "\C-c\C-k" 'wdired-abort-changes)
    (define-key map "\C-c\C-[" 'wdired-abort-changes)
Stefan Monnier's avatar
Stefan Monnier committed
181 182 183
    (define-key map "\C-m"     'ignore)
    (define-key map "\C-j"     'ignore)
    (define-key map "\C-o"     'ignore)
184 185 186 187 188 189 190 191 192 193
    (define-key map [up]       'wdired-previous-line)
    (define-key map "\C-p"     'wdired-previous-line)
    (define-key map [down]     'wdired-next-line)
    (define-key map "\C-n"     'wdired-next-line)

    (define-key map [menu-bar wdired]
      (cons "WDired" (make-sparse-keymap "WDired")))
    (define-key map [menu-bar wdired wdired-customize]
      '("Options" . wdired-customize))
    (define-key map [menu-bar wdired dashes]
Stefan Monnier's avatar
Stefan Monnier committed
194
      '("--"))
195 196 197 198 199 200 201 202 203 204 205 206 207 208
    (define-key map [menu-bar wdired wdired-abort-changes]
      '("Abort Changes" . wdired-abort-changes))
    (define-key map [menu-bar wdired wdired-finish-edit]
      '("Commit Changes" . wdired-finish-edit))
    ;; FIXME: Use the new remap trick.
    (substitute-key-definition 'upcase-word 'wdired-upcase-word
			       map global-map)
    (substitute-key-definition 'capitalize-word 'wdired-capitalize-word
			       map global-map)
    (substitute-key-definition 'downcase-word 'wdired-downcase-word
			       map global-map)
    map))

(defvar wdired-mode-hook nil
Stefan Monnier's avatar
Stefan Monnier committed
209
  "Hooks run when changing to WDired mode.")
Stefan Monnier's avatar
Stefan Monnier committed
210 211 212 213 214 215 216 217 218

;; Local variables (put here to avoid compilation gripes)
(defvar wdired-col-perm) ;; Column where the permission bits start
(defvar wdired-old-content)


(defun wdired-mode ()
  "\\<wdired-mode-map>File Names Editing mode.

Stefan Monnier's avatar
Stefan Monnier committed
219 220
Press \\[wdired-finish-edit] to make the changes to take effect
and exit.  To abort the edit, use \\[wdired-abort-changes].
Stefan Monnier's avatar
Stefan Monnier committed
221

Stefan Monnier's avatar
Stefan Monnier committed
222 223 224
In this mode you can edit the names of the files, the target of
the links and the permission bits of the files.  You can use
\\[customize-group] RET wdired to customize WDired behavior.
Stefan Monnier's avatar
Stefan Monnier committed
225

Stefan Monnier's avatar
Stefan Monnier committed
226 227
The only editable texts in a WDired buffer are filenames,
symbolic link targets, and filenames permission."
Stefan Monnier's avatar
Stefan Monnier committed
228 229 230 231 232 233 234 235
  (interactive)
  (error "This mode can be enabled only by `wdired-change-to-wdired-mode'"))
(put 'wdired-mode 'mode-class 'special)


;;;###autoload
(defun wdired-change-to-wdired-mode ()
  "Put a dired buffer in a mode in which filenames are editable.
Stefan Monnier's avatar
Stefan Monnier committed
236 237 238 239
\\<wdired-mode-map>
This mode allows the user to change the names of the files, and after
typing \\[wdired-finish-edit] Emacs renames the files and directories
in disk.
Stefan Monnier's avatar
Stefan Monnier committed
240 241 242 243 244

See `wdired-mode'."
  (interactive)
  (set (make-local-variable 'wdired-old-content)
       (buffer-substring (point-min) (point-max)))
245
  (set (make-local-variable 'query-replace-skip-read-only) t)
Stefan Monnier's avatar
Stefan Monnier committed
246
  (use-local-map wdired-mode-map)
247
  (force-mode-line-update)
Stefan Monnier's avatar
Stefan Monnier committed
248 249 250 251
  (setq buffer-read-only nil)
  (dired-unadvertise default-directory)
  (add-hook 'kill-buffer-hook 'wdired-check-kill-buffer nil t)
  (setq major-mode 'wdired-mode)
Stefan Monnier's avatar
Stefan Monnier committed
252
  (setq mode-name "Editable Dired")
Stefan Monnier's avatar
Stefan Monnier committed
253 254 255 256 257 258 259 260 261 262 263 264 265
  (setq revert-buffer-function 'wdired-revert)
  ;; I temp disable undo for performance: since I'm going to clear the
  ;; undo list, it can save more than a 9% of time with big
  ;; directories because setting properties modify the undo-list.
  (buffer-disable-undo)
  (wdired-preprocess-files)
  (if wdired-allow-to-change-permissions
      (wdired-preprocess-perms))
  (if (and wdired-allow-to-redirect-links (fboundp 'make-symbolic-link))
      (wdired-preprocess-symlinks))
  (buffer-enable-undo) ; Performance hack. See above.
  (set-buffer-modified-p nil)
  (setq buffer-undo-list nil)
266
  (run-mode-hooks 'wdired-mode-hook)
Deepak Goel's avatar
Deepak Goel committed
267
  (message "%s" (substitute-command-keys "Press \\[wdired-finish-edit] when finished \
Juri Linkov's avatar
Juri Linkov committed
268
or \\[wdired-abort-changes] to abort changes")))
Stefan Monnier's avatar
Stefan Monnier committed
269 270 271 272 273 274 275 276 277 278 279 280


;; Protect the buffer so only the filenames can be changed, and put
;; properties so filenames (old and new) can be easily found.
(defun wdired-preprocess-files ()
  (put-text-property 1 2 'front-sticky t)
  (save-excursion
    (goto-char (point-min))
    (let ((b-protection (point))
	  filename)
      (while (not (eobp))
	(setq filename (dired-get-filename nil t))
281 282 283 284 285 286 287
        (when (and filename
		   (not (member (file-name-nondirectory filename) '("." ".."))))
	  (dired-move-to-filename)
	  (put-text-property (- (point) 2) (1- (point)) 'old-name filename)
	  (put-text-property b-protection (1- (point)) 'read-only t)
	  (setq b-protection (dired-move-to-end-of-filename t)))
	(put-text-property (point) (1+ (point)) 'end-name t)
Stefan Monnier's avatar
Stefan Monnier committed
288 289 290 291 292 293
        (forward-line))
      (put-text-property b-protection (point-max) 'read-only t))))

;; This code is a copy of some dired-get-filename lines.
(defsubst wdired-normalize-filename (file)
  (setq file
294 295
	;; FIXME: shouldn't we check for a `b' argument or somesuch before
	;; doing such unquoting?  --Stef
Stefan Monnier's avatar
Stefan Monnier committed
296
	(read (concat
297 298
	       "\"" (replace-regexp-in-string
		     "\\([^\\]\\|\\`\\)\"" "\\1\\\\\"" file)
Stefan Monnier's avatar
Stefan Monnier committed
299 300 301 302 303 304 305 306 307
	       "\"")))
  (and file buffer-file-coding-system
       (not file-name-coding-system)
       (not default-file-name-coding-system)
       (setq file (encode-coding-string file buffer-file-coding-system)))
  file)

(defun wdired-get-filename (&optional no-dir old)
  "Return the filename at line.
308
Similar to `dired-get-filename' but it doesn't rely on regexps.  It
Stefan Monnier's avatar
Stefan Monnier committed
309
relies on WDired buffer's properties.  Optional arg NO-DIR with value
Stefan Monnier's avatar
Stefan Monnier committed
310 311
non-nil means don't include directory.  Optional arg OLD with value
non-nil means return old filename."
312
  ;; FIXME: Use dired-get-filename's new properties.
Stefan Monnier's avatar
Stefan Monnier committed
313 314 315 316 317
  (let (beg end file)
    (save-excursion
      (setq end (progn (end-of-line) (point)))
      (beginning-of-line)
      (setq beg (next-single-property-change (point) 'old-name nil end))
318 319 320 321 322 323
      (unless (eq beg end)
	(if old
	    (setq file (get-text-property beg 'old-name))
	  (setq end (next-single-property-change (1+ beg) 'end-name))
	  (setq file (buffer-substring-no-properties (+ 2 beg) end)))
	(and file (setq file (wdired-normalize-filename file))))
Stefan Monnier's avatar
Stefan Monnier committed
324 325 326 327 328 329 330 331 332 333 334 335 336
      (if (or no-dir old)
	  file
	(and file (> (length file) 0)
             (concat (dired-current-directory) file))))))


(defun wdired-change-to-dired-mode ()
  "Change the mode back to dired."
  (let ((inhibit-read-only t))
    (remove-text-properties (point-min) (point-max)
			    '(read-only nil local-map nil)))
  (put-text-property 1 2 'front-sticky nil)
  (use-local-map dired-mode-map)
337
  (force-mode-line-update)
Stefan Monnier's avatar
Stefan Monnier committed
338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353
  (setq buffer-read-only t)
  (setq major-mode 'dired-mode)
  (setq mode-name "Dired")
  (dired-advertise)
  (remove-hook 'kill-buffer-hook 'wdired-check-kill-buffer t)
  (setq revert-buffer-function 'dired-revert))


(defun wdired-abort-changes ()
  "Abort changes and return to dired mode."
  (interactive)
  (let ((inhibit-read-only t))
    (erase-buffer)
    (insert wdired-old-content))
  (wdired-change-to-dired-mode)
  (set-buffer-modified-p nil)
354 355
  (setq buffer-undo-list nil)
  (message "Changes aborted"))
Stefan Monnier's avatar
Stefan Monnier committed
356 357 358 359 360

(defun wdired-finish-edit ()
  "Actually rename files based on your editing in the Dired buffer."
  (interactive)
  (wdired-change-to-dired-mode)
Stefan Monnier's avatar
Stefan Monnier committed
361
  (let ((overwrite (or (not wdired-confirm-overwrite) 1))
Stefan Monnier's avatar
Stefan Monnier committed
362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392
	(changes nil)
	(files-deleted nil)
	(errors 0)
	file-ori file-new tmp-value)
    (save-excursion
      (if (and wdired-allow-to-redirect-links
	       (fboundp 'make-symbolic-link))
	  (progn
	    (setq tmp-value (wdired-do-symlink-changes))
	    (setq errors (cdr tmp-value))
	    (setq changes (car tmp-value))))
      (if (and wdired-allow-to-change-permissions
	       (boundp 'wdired-col-perm)) ; could have been changed
	  (progn
	    (setq tmp-value (wdired-do-perm-changes))
	    (setq errors (+ errors (cdr tmp-value)))
	    (setq changes (or changes (car tmp-value)))))
      (goto-char (point-max))
      (while (not (bobp))
	(setq file-ori (wdired-get-filename nil t))
	(if file-ori
	    (setq file-new (wdired-get-filename)))
	(if (and file-ori (not (equal file-new file-ori)))
	    (progn
	      (setq changes t)
	      (if (not file-new) ;empty filename!
		  (setq files-deleted (cons file-ori files-deleted))
		(progn
		  (setq file-new (substitute-in-file-name file-new))
		  (if wdired-use-interactive-rename
		      (wdired-search-and-rename file-ori file-new)
393 394 395 396 397
                    ;; If dired-rename-file autoloads dired-aux while
                    ;; dired-backup-overwrite is locally bound,
                    ;; dired-backup-overwrite won't be initialized.
                    ;; So we must ensure dired-aux is loaded.
                    (require 'dired-aux)
Stefan Monnier's avatar
Stefan Monnier committed
398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459
		    (condition-case err
			(let ((dired-backup-overwrite nil))
			  (dired-rename-file file-ori file-new
					     overwrite))
		      (error
		       (setq errors (1+ errors))
		       (dired-log (concat "Rename `" file-ori "' to `"
					  file-new "' failed:\n%s\n")
				  err))))))))
	(forward-line -1)))
    (if changes
        (revert-buffer) ;The "revert" is necessary to re-sort the buffer
      (let ((buffer-read-only nil))
	(remove-text-properties (point-min) (point-max)
				'(old-name nil end-name nil old-link nil
					   end-link nil end-perm nil
					   old-perm nil perm-changed nil))
	(message "(No changes to be performed)")))
    (if files-deleted
        (wdired-flag-for-deletion files-deleted))
    (if (> errors 0)
        (dired-log-summary (format "%d rename actions failed" errors) nil)))
  (set-buffer-modified-p nil)
  (setq buffer-undo-list nil))

;; Renames a file, searching it in a modified dired buffer, in order
;; to be able to use `dired-do-create-files-regexp' and get its
;; "benefits"
(defun wdired-search-and-rename (filename-ori filename-new)
  (save-excursion
    (goto-char (point-max))
    (forward-line -1)
    (let ((exit-while nil)
	  curr-filename)
      (while (not exit-while)
        (setq curr-filename (wdired-get-filename))
        (if (and curr-filename
                 (equal (substitute-in-file-name curr-filename) filename-new))
            (progn
              (setq exit-while t)
              (let ((inhibit-read-only t))
                (dired-move-to-filename)
                (search-forward (wdired-get-filename t) nil t)
                (replace-match (file-name-nondirectory filename-ori) t t))
              (dired-do-create-files-regexp
               (function dired-rename-file)
               "Move" 1 ".*" filename-new nil t))
          (progn
            (forward-line -1)
            (beginning-of-line)
            (setq exit-while (= 1 (point)))))))))

;; marks a list of files for deletion
(defun wdired-flag-for-deletion (filenames-ori)
  (save-excursion
    (goto-char (point-min))
    (while (not (eobp))
      (if (member (dired-get-filename nil t) filenames-ori)
          (dired-flag-file-deletion 1)
	(forward-line)))))

(defun wdired-customize ()
Stefan Monnier's avatar
Stefan Monnier committed
460
  "Customize WDired options."
Stefan Monnier's avatar
Stefan Monnier committed
461 462 463 464
  (interactive)
  (customize-apropos "wdired" 'groups))

(defun wdired-revert (&optional arg noconfirm)
Stefan Monnier's avatar
Stefan Monnier committed
465 466
  "Discard changes in the buffer and update it based on changes on disk.
Optional arguments are ignored."
Stefan Monnier's avatar
Stefan Monnier committed
467 468 469 470 471
  (wdired-change-to-dired-mode)
  (revert-buffer)
  (wdired-change-to-wdired-mode))

(defun wdired-check-kill-buffer ()
472
  ;; FIXME: Can't we use the normal mechanism for that?  --Stef
Stefan Monnier's avatar
Stefan Monnier committed
473 474 475 476 477 478 479
  (if (and
       (buffer-modified-p)
       (not (y-or-n-p "Buffer changed. Discard changes and kill buffer? ")))
      (error nil)))

(defun wdired-next-line (arg)
  "Move down lines then position at filename or the current column.
Stefan Monnier's avatar
Stefan Monnier committed
480
See `wdired-use-dired-vertical-movement'.  Optional prefix ARG
Stefan Monnier's avatar
Stefan Monnier committed
481 482 483
says how many lines to move; default is one line."
  (interactive "p")
  (next-line arg)
Stefan Monnier's avatar
Stefan Monnier committed
484 485
  (if (or (eq wdired-use-dired-vertical-movement t)
	  (and wdired-use-dired-vertical-movement
Stefan Monnier's avatar
Stefan Monnier committed
486 487 488 489 490 491 492
	       (< (current-column)
		  (save-excursion (dired-move-to-filename)
				  (current-column)))))
      (dired-move-to-filename)))

(defun wdired-previous-line (arg)
  "Move up lines then position at filename or the current column.
Stefan Monnier's avatar
Stefan Monnier committed
493
See `wdired-use-dired-vertical-movement'.  Optional prefix ARG
Stefan Monnier's avatar
Stefan Monnier committed
494 495 496
says how many lines to move; default is one line."
  (interactive "p")
  (previous-line arg)
Stefan Monnier's avatar
Stefan Monnier committed
497 498
  (if (or (eq wdired-use-dired-vertical-movement t)
	  (and wdired-use-dired-vertical-movement
Stefan Monnier's avatar
Stefan Monnier committed
499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579
	       (< (current-column)
		  (save-excursion (dired-move-to-filename)
				  (current-column)))))
      (dired-move-to-filename)))

;; Put the needed properties to allow the user to change links' targets
(defun wdired-preprocess-symlinks ()
  (let ((inhibit-read-only t))
    (save-excursion
      (goto-char (point-min))
      (while (not (eobp))
        (if (looking-at dired-re-sym)
            (progn
              (re-search-forward " -> \\(.*\\)$")
	      (put-text-property (- (match-beginning 1) 2)
				 (1- (match-beginning 1)) 'old-link
				 (match-string-no-properties 1))
              (put-text-property (match-end 1) (1+ (match-end 1)) 'end-link t)
	      (put-text-property (1- (match-beginning 1))
				 (match-end 1) 'read-only nil)))
        (forward-line)
	(beginning-of-line)))))


(defun wdired-get-previous-link (&optional old move)
  "Return the next symlink target.
If OLD, return the old target.  If MOVE, move point before it."
  (let (beg end target)
    (setq beg (previous-single-property-change (point) 'old-link nil))
    (if beg
	(progn
	  (if old
	      (setq target (get-text-property (1- beg) 'old-link))
	    (setq end (next-single-property-change beg 'end-link))
	    (setq target (buffer-substring-no-properties (1+ beg) end)))
	  (if move (goto-char (1- beg)))))
    (and target (wdired-normalize-filename target))))



;; Perform the changes in the target of the changed links.
(defun wdired-do-symlink-changes()
  (let ((changes nil)
	(errors 0)
	link-to-ori link-to-new link-from)
    (goto-char (point-max))
    (while (setq link-to-new (wdired-get-previous-link))
      (setq link-to-ori (wdired-get-previous-link t t))
      (setq link-from (wdired-get-filename nil t))
      (if (not (equal link-to-new link-to-ori))
          (progn
            (setq changes t)
            (if (equal link-to-new "") ;empty filename!
                (setq link-to-new "/dev/null"))
	    (condition-case err
		(progn 
		  (delete-file link-from)
		  (make-symbolic-link
		   (substitute-in-file-name link-to-new) link-from))
		  (error
		   (setq errors (1+ errors))
		   (dired-log (concat "Link `" link-from "' to `"
				      link-to-new "' failed:\n%s\n")
			      err))))))
    (cons changes errors)))

;; Perform a "case command" skipping read-only words.
(defun wdired-xcase-word (command arg)
  (if (< arg 0)
      (funcall command arg)
    (progn
      (while (> arg 0)
	(condition-case err
	    (progn
	      (funcall command 1)
	      (setq arg (1- arg)))
	  (error
	   (if (not (forward-word 1))
	       (setq arg 0))))))))

(defun wdired-downcase-word (arg)
Stefan Monnier's avatar
Stefan Monnier committed
580
  "WDired version of `downcase-word'.
Stefan Monnier's avatar
Stefan Monnier committed
581 582 583 584 585
Like original function but it skips read-only words."
  (interactive "p")
  (wdired-xcase-word 'downcase-word arg))

(defun wdired-upcase-word (arg)
Stefan Monnier's avatar
Stefan Monnier committed
586
  "WDired version of `upcase-word'.
Stefan Monnier's avatar
Stefan Monnier committed
587 588 589 590 591
Like original function but it skips read-only words."
  (interactive "p")
  (wdired-xcase-word 'upcase-word arg))

(defun wdired-capitalize-word (arg)
Stefan Monnier's avatar
Stefan Monnier committed
592
  "WDired version of `capitalize-word'.
Stefan Monnier's avatar
Stefan Monnier committed
593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749
Like original function but it skips read-only words."
  (interactive "p")
  (wdired-xcase-word 'capitalize-word arg))


;; The following code deals with changing the access bits (or
;; permissions) of the files.

(defvar wdired-perm-mode-map nil)
(unless wdired-perm-mode-map
  (setq wdired-perm-mode-map (copy-keymap wdired-mode-map))
  (define-key wdired-perm-mode-map " " 'wdired-toggle-bit)
  (define-key wdired-perm-mode-map "r" 'wdired-set-bit)
  (define-key wdired-perm-mode-map "w" 'wdired-set-bit)
  (define-key wdired-perm-mode-map "x" 'wdired-set-bit)
  (define-key wdired-perm-mode-map "-" 'wdired-set-bit)
  (define-key wdired-perm-mode-map "S" 'wdired-set-bit)
  (define-key wdired-perm-mode-map "s" 'wdired-set-bit)
  (define-key wdired-perm-mode-map "T" 'wdired-set-bit)
  (define-key wdired-perm-mode-map "t" 'wdired-set-bit)
  (define-key wdired-perm-mode-map "s" 'wdired-set-bit)
  (define-key wdired-perm-mode-map "l" 'wdired-set-bit)
  (define-key wdired-perm-mode-map [down-mouse-1] 'wdired-mouse-toggle-bit))

;; Put a local-map to the permission bits of the files, and store the
;; original name and permissions as a property
(defun wdired-preprocess-perms()
  (let ((inhibit-read-only t)
	filename)
    (set (make-local-variable 'wdired-col-perm) nil)
    (save-excursion
      (goto-char (point-min))
      (while (not (eobp))
	(if (and (not (looking-at dired-re-sym))
		 (setq filename (wdired-get-filename)))
	    (progn
	      (re-search-forward dired-re-perms)
	      (or wdired-col-perm
		  (setq wdired-col-perm (- (current-column) 9)))
	      (if (eq wdired-allow-to-change-permissions 'advanced)
		  (put-text-property (match-beginning 0) (match-end 0)
				     'read-only nil)
		(put-text-property (1+ (match-beginning 0)) (match-end 0)
				   'local-map wdired-perm-mode-map))
	      (put-text-property (match-end 0) (1+ (match-end 0)) 'end-perm t)
	      (put-text-property (match-beginning 0) (1+ (match-beginning 0))
				 'old-perm (match-string-no-properties 0))))
        (forward-line)
	(beginning-of-line)))))

(defun wdired-perm-allowed-in-pos (char pos)
  (cond
   ((= char ?-)          t)
   ((= char ?r)          (= (% pos 3) 0))
   ((= char ?w)          (= (% pos 3) 1))
   ((= char ?x)          (= (% pos 3) 2))
   ((memq char '(?s ?S)) (memq pos '(2 5)))
   ((memq char '(?t ?T)) (= pos 8))
   ((= char ?l)          (= pos 5))))

(defun wdired-set-bit ()
  "Set a permission bit character."
  (interactive)
  (if (wdired-perm-allowed-in-pos last-command-char
                                  (- (current-column) wdired-col-perm))
      (let ((new-bit (char-to-string last-command-char))
            (inhibit-read-only t)
	    (pos-prop (- (point) (- (current-column) wdired-col-perm))))
        (put-text-property 0 1 'local-map wdired-perm-mode-map new-bit)
        (put-text-property 0 1 'read-only t new-bit)
        (insert new-bit)
        (delete-char 1)
	(put-text-property pos-prop (1- pos-prop) 'perm-changed t))
    (forward-char 1)))

(defun wdired-toggle-bit()
  "Toggle the permission bit at point."
  (interactive)
  (let ((inhibit-read-only t)
	(new-bit "-")
	(pos-prop (- (point) (- (current-column) wdired-col-perm))))
    (if (eq (char-after (point)) ?-)
	(setq new-bit	
	      (if (= (% (- (current-column) wdired-col-perm) 3) 0) "r"
		(if (= (% (- (current-column) wdired-col-perm) 3) 1) "w"
		  "x"))))
    (put-text-property 0 1 'local-map wdired-perm-mode-map new-bit)
    (put-text-property 0 1 'read-only t new-bit)
    (insert new-bit)
    (delete-char 1)
    (put-text-property pos-prop (1- pos-prop) 'perm-changed t)))

(defun wdired-mouse-toggle-bit (event)
  "Toggle the permission bit that was left clicked."
  (interactive "e")
  (mouse-set-point event)
  (wdired-toggle-bit))

;; Allowed chars for 4000 bit are Ss  in position 3
;; Allowed chars for 2000 bit are Ssl in position 6
;; Allowed chars for 1000 bit are Tt  in position 9
(defun wdired-perms-to-number (perms)
  (let ((nperm 0777))
    (if (= (elt perms 1) ?-) (setq nperm (- nperm 400)))
    (if (= (elt perms 2) ?-) (setq nperm (- nperm 200)))
    (let ((p-bit (elt perms 3)))
      (if (memq p-bit '(?- ?S)) (setq nperm (- nperm 100)))
      (if (memq p-bit '(?s ?S)) (setq nperm (+ nperm 4000))))
    (if (= (elt perms 4) ?-) (setq nperm (- nperm 40)))
    (if (= (elt perms 5) ?-) (setq nperm (- nperm 20)))
    (let ((p-bit (elt perms 6)))
      (if (memq p-bit '(?- ?S ?l)) (setq nperm (- nperm 10)))
      (if (memq p-bit '(?s ?S ?l)) (setq nperm (+ nperm 2000))))
    (if (= (elt perms 7) ?-) (setq nperm (- nperm 4)))
    (if (= (elt perms 8) ?-) (setq nperm (- nperm 2)))
    (let ((p-bit (elt perms 9)))
      (if (memq p-bit '(?- ?T)) (setq nperm (- nperm 1)))
      (if (memq p-bit '(?t ?T)) (setq nperm (+ nperm 1000))))
    nperm))

;; Perform the changes in the permissions of the files that have
;; changed.
(defun wdired-do-perm-changes ()
  (let ((changes nil)
	(errors 0)
	(prop-wanted (if (eq wdired-allow-to-change-permissions 'advanced)
			 'old-perm 'perm-changed))
	filename perms-ori perms-new perm-tmp)
    (goto-char (next-single-property-change (point-min) prop-wanted
					    nil (point-max)))
    (while (not (eobp))
      (setq perms-ori (get-text-property (point) 'old-perm))
      (setq perms-new (buffer-substring-no-properties
		       (point) (next-single-property-change (point) 'end-perm)))
      (if (not (equal perms-ori perms-new))
	  (progn
	    (setq changes t)
	    (setq filename (wdired-get-filename nil t))
	    (if (= (length perms-new) 10)
		(progn
		  (setq perm-tmp
			(int-to-string (wdired-perms-to-number perms-new)))
		  (if (not (equal 0 (dired-call-process dired-chmod-program
				     t perm-tmp filename)))
		      (progn
			(setq errors (1+ errors))
			(dired-log (concat dired-chmod-program " " perm-tmp
					   " `" filename "' failed\n\n")))))
	    (setq errors (1+ errors))
	    (dired-log (concat "Cannot parse permission `" perms-new
			       "' for file `" filename "'\n\n")))))
      (goto-char (next-single-property-change (1+ (point)) prop-wanted
					      nil (point-max))))
    (cons changes errors)))

(provide 'wdired)

750
;; arch-tag: bc00902e-526f-4305-bc7f-8862a559184f
Stefan Monnier's avatar
Stefan Monnier committed
751
;;; wdired.el ends here