lisp/wdired.el

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