lisp/wdired.el

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