lisp/wdired.el

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