lisp/wdired.el

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