code.delx.au - gnu-emacs/blob - lisp/wdired.el

   1 ;;; wdired.el --- Rename files editing their names in dired buffers
   2
   3 ;; Copyright (C) 2004, 2005 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 (eval-when-compile
 106   (set (make-local-variable 'byte-compile-dynamic) t))
 107
 108 (eval-and-compile
 109   (require 'dired)
 110   (autoload 'dired-do-create-files-regexp "dired-aux")
 111   (autoload 'dired-call-process "dired-aux"))
 112
 113 (defgroup wdired nil
 114   "Mode to rename files by editing their names in dired buffers."
 115   :group 'dired)
 116
 117 (defcustom wdired-use-interactive-rename nil
 118   "*If non-nil, WDired requires confirmation before actually renaming files.
 119 If nil, WDired doesn't require confirmation to change the file names,
 120 and the variable `wdired-confirm-overwrite' controls whether it is ok
 121 to overwrite files without asking."
 122   :type 'boolean
 123   :group 'wdired)
 124
 125 (defcustom wdired-confirm-overwrite t
 126   "*If nil the renames can overwrite files without asking.
 127 This variable has no effect at all if `wdired-use-interactive-rename'
 128 is not nil."
 129   :type 'boolean
 130   :group 'wdired)
 131
 132 (defcustom wdired-use-dired-vertical-movement nil
 133   "*If t, the \"up\" and \"down\" movement works as in Dired mode.
 134 That is, always move the point to the beginning of the filename at line.
 135
 136 If `sometimes, only move to the beginning of filename if the point is
 137 before it, and `track-eol' is honored.  This behavior is very handy
 138 when editing several filenames.
 139
 140 If nil, \"up\" and \"down\" movement is done as in any other buffer."
 141   :type '(choice (const :tag "As in any other mode" nil)
 142                  (const :tag "Smart cursor placement" sometimes)
 143                  (other :tag "As in dired mode" t))
 144   :group 'wdired)
 145
 146 (defcustom wdired-allow-to-redirect-links t
 147   "*If non-nil, the target of the symbolic links are editable.
 148 In systems without symbolic links support, this variable has no effect
 149 at all."
 150   :type 'boolean
 151   :group 'wdired)
 152
 153 (defcustom wdired-allow-to-change-permissions nil
 154   "*If non-nil, the permissions bits of the files are editable.
 155
 156 If t, to change a single bit, put the cursor over it and press the
 157 space bar, or left click over it.  You can also hit the letter you want
 158 to set: if this value is allowed, the character in the buffer will be
 159 changed.  Anyway, the point is advanced one position, so, for example,
 160 you can keep the <x> key pressed to give execution permissions to
 161 everybody to that file.
 162
 163 If `advanced, the bits are freely editable.  You can use
 164 `string-rectangle', `query-replace', etc.  You can put any value (even
 165 newlines), but if you want your changes to be useful, you better put a
 166 intelligible value.
 167
 168 Anyway, the real change of the permissions is done by the external
 169 program `dired-chmod-program', which must exist."
 170   :type '(choice (const :tag "Not allowed" nil)
 171                  (const :tag "Toggle/set bits" t)
 172                  (other :tag "Bits freely editable" advanced))
 173   :group 'wdired)
 174
 175 (defvar wdired-mode-map
 176   (let ((map (make-sparse-keymap)))
 177     (define-key map "\C-x\C-s" 'wdired-finish-edit)
 178     (define-key map "\C-c\C-c" 'wdired-finish-edit)
 179     (define-key map "\C-c\C-k" 'wdired-abort-changes)
 180     (define-key map "\C-c\C-[" 'wdired-abort-changes)
 181     (define-key map "\C-m"     'ignore)
 182     (define-key map "\C-j"     'ignore)
 183     (define-key map "\C-o"     'ignore)
 184     (define-key map [up]       'wdired-previous-line)
 185     (define-key map "\C-p"     'wdired-previous-line)
 186     (define-key map [down]     'wdired-next-line)
 187     (define-key map "\C-n"     'wdired-next-line)
 188
 189     (define-key map [menu-bar wdired]
 190       (cons "WDired" (make-sparse-keymap "WDired")))
 191     (define-key map [menu-bar wdired wdired-customize]
 192       '("Options" . wdired-customize))
 193     (define-key map [menu-bar wdired dashes]
 194       '("--"))
 195     (define-key map [menu-bar wdired wdired-abort-changes]
 196       '("Abort Changes" . wdired-abort-changes))
 197     (define-key map [menu-bar wdired wdired-finish-edit]
 198       '("Commit Changes" . wdired-finish-edit))
 199     ;; FIXME: Use the new remap trick.
 200     (substitute-key-definition 'upcase-word 'wdired-upcase-word
 201                                map global-map)
 202     (substitute-key-definition 'capitalize-word 'wdired-capitalize-word
 203                                map global-map)
 204     (substitute-key-definition 'downcase-word 'wdired-downcase-word
 205                                map global-map)
 206     map))
 207
 208 (defvar wdired-mode-hook nil
 209   "Hooks run when changing to WDired mode.")
 210
 211 ;; Local variables (put here to avoid compilation gripes)
 212 (defvar wdired-col-perm) ;; Column where the permission bits start
 213 (defvar wdired-old-content)
 214
 215
 216 (defun wdired-mode ()
 217   "\\<wdired-mode-map>File Names Editing mode.
 218
 219 Press \\[wdired-finish-edit] to make the changes to take effect
 220 and exit.  To abort the edit, use \\[wdired-abort-changes].
 221
 222 In this mode you can edit the names of the files, the target of
 223 the links and the permission bits of the files.  You can use
 224 \\[customize-group] RET wdired to customize WDired behavior.
 225
 226 The only editable texts in a WDired buffer are filenames,
 227 symbolic link targets, and filenames permission."
 228   (interactive)
 229   (error "This mode can be enabled only by `wdired-change-to-wdired-mode'"))
 230 (put 'wdired-mode 'mode-class 'special)
 231
 232
 233 ;;;###autoload
 234 (defun wdired-change-to-wdired-mode ()
 235   "Put a dired buffer in a mode in which filenames are editable.
 236 \\<wdired-mode-map>
 237 This mode allows the user to change the names of the files, and after
 238 typing \\[wdired-finish-edit] Emacs renames the files and directories
 239 in disk.
 240
 241 See `wdired-mode'."
 242   (interactive)
 243   (set (make-local-variable 'wdired-old-content)
 244        (buffer-substring (point-min) (point-max)))
 245   (set (make-local-variable 'query-replace-skip-read-only) t)
 246   (use-local-map wdired-mode-map)
 247   (force-mode-line-update)
 248   (setq buffer-read-only nil)
 249   (dired-unadvertise default-directory)
 250   (add-hook 'kill-buffer-hook 'wdired-check-kill-buffer nil t)
 251   (setq major-mode 'wdired-mode)
 252   (setq mode-name "Editable Dired")
 253   (setq revert-buffer-function 'wdired-revert)
 254   ;; I temp disable undo for performance: since I'm going to clear the
 255   ;; undo list, it can save more than a 9% of time with big
 256   ;; directories because setting properties modify the undo-list.
 257   (buffer-disable-undo)
 258   (wdired-preprocess-files)
 259   (if wdired-allow-to-change-permissions
 260       (wdired-preprocess-perms))
 261   (if (and wdired-allow-to-redirect-links (fboundp 'make-symbolic-link))
 262       (wdired-preprocess-symlinks))
 263   (buffer-enable-undo) ; Performance hack. See above.
 264   (set-buffer-modified-p nil)
 265   (setq buffer-undo-list nil)
 266   (run-mode-hooks 'wdired-mode-hook)
 267   (message (substitute-command-keys "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 1 2 '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           (put-text-property (- (point) 2) (1- (point)) 'old-name filename)
 285           (put-text-property b-protection (1- (point)) 'read-only t)
 286           (setq b-protection (dired-move-to-end-of-filename t)))
 287         (put-text-property (point) (1+ (point)) 'end-name t)
 288         (forward-line))
 289       (put-text-property b-protection (point-max) 'read-only t))))
 290
 291 ;; This code is a copy of some dired-get-filename lines.
 292 (defsubst wdired-normalize-filename (file)
 293   (setq file
 294         ;; FIXME: shouldn't we check for a `b' argument or somesuch before
 295         ;; doing such unquoting?  --Stef
 296         (read (concat
 297                "\"" (replace-regexp-in-string
 298                      "\\([^\\]\\|\\`\\)\"" "\\1\\\\\"" file)
 299                "\"")))
 300   (and file buffer-file-coding-system
 301        (not file-name-coding-system)
 302        (not default-file-name-coding-system)
 303        (setq file (encode-coding-string file buffer-file-coding-system)))
 304   file)
 305
 306 (defun wdired-get-filename (&optional no-dir old)
 307   "Return the filename at line.
 308 Similar to `dired-get-filename' but it doesn't rely on regexps.  It
 309 relies on WDired buffer's properties.  Optional arg NO-DIR with value
 310 non-nil means don't include directory.  Optional arg OLD with value
 311 non-nil means return old filename."
 312   ;; FIXME: Use dired-get-filename's new properties.
 313   (let (beg end file)
 314     (save-excursion
 315       (setq end (progn (end-of-line) (point)))
 316       (beginning-of-line)
 317       (setq beg (next-single-property-change (point) 'old-name nil end))
 318       (unless (eq beg end)
 319         (if old
 320             (setq file (get-text-property beg 'old-name))
 321           (setq end (next-single-property-change (1+ beg) 'end-name))
 322           (setq file (buffer-substring-no-properties (+ 2 beg) end)))
 323         (and file (setq file (wdired-normalize-filename file))))
 324       (if (or no-dir old)
 325           file
 326         (and file (> (length file) 0)
 327              (concat (dired-current-directory) file))))))
 328
 329
 330 (defun wdired-change-to-dired-mode ()
 331   "Change the mode back to dired."
 332   (let ((inhibit-read-only t))
 333     (remove-text-properties (point-min) (point-max)
 334                             '(read-only nil local-map nil)))
 335   (put-text-property 1 2 'front-sticky nil)
 336   (use-local-map dired-mode-map)
 337   (force-mode-line-update)
 338   (setq buffer-read-only t)
 339   (setq major-mode 'dired-mode)
 340   (setq mode-name "Dired")
 341   (dired-advertise)
 342   (remove-hook 'kill-buffer-hook 'wdired-check-kill-buffer t)
 343   (setq revert-buffer-function 'dired-revert))
 344
 345
 346 (defun wdired-abort-changes ()
 347   "Abort changes and return to dired mode."
 348   (interactive)
 349   (let ((inhibit-read-only t))
 350     (erase-buffer)
 351     (insert wdired-old-content))
 352   (wdired-change-to-dired-mode)
 353   (set-buffer-modified-p nil)
 354   (setq buffer-undo-list nil)
 355   (message "Changes aborted"))
 356
 357 (defun wdired-finish-edit ()
 358   "Actually rename files based on your editing in the Dired buffer."
 359   (interactive)
 360   (wdired-change-to-dired-mode)
 361   (let ((overwrite (or (not wdired-confirm-overwrite) 1))
 362         (changes nil)
 363         (files-deleted nil)
 364         (errors 0)
 365         file-ori file-new tmp-value)
 366     (save-excursion
 367       (if (and wdired-allow-to-redirect-links
 368                (fboundp 'make-symbolic-link))
 369           (progn
 370             (setq tmp-value (wdired-do-symlink-changes))
 371             (setq errors (cdr tmp-value))
 372             (setq changes (car tmp-value))))
 373       (if (and wdired-allow-to-change-permissions
 374                (boundp 'wdired-col-perm)) ; could have been changed
 375           (progn
 376             (setq tmp-value (wdired-do-perm-changes))
 377             (setq errors (+ errors (cdr tmp-value)))
 378             (setq changes (or changes (car tmp-value)))))
 379       (goto-char (point-max))
 380       (while (not (bobp))
 381         (setq file-ori (wdired-get-filename nil t))
 382         (if file-ori
 383             (setq file-new (wdired-get-filename)))
 384         (if (and file-ori (not (equal file-new file-ori)))
 385             (progn
 386               (setq changes t)
 387               (if (not file-new) ;empty filename!
 388                   (setq files-deleted (cons file-ori files-deleted))
 389                 (progn
 390                   (setq file-new (substitute-in-file-name file-new))
 391                   (if wdired-use-interactive-rename
 392                       (wdired-search-and-rename file-ori file-new)
 393                     ;; If dired-rename-file autoloads dired-aux while
 394                     ;; dired-backup-overwrite is locally bound,
 395                     ;; dired-backup-overwrite won't be initialized.
 396                     ;; So we must ensure dired-aux is loaded.
 397                     (require 'dired-aux)
 398                     (condition-case err
 399                         (let ((dired-backup-overwrite nil))
 400                           (dired-rename-file file-ori file-new
 401                                              overwrite))
 402                       (error
 403                        (setq errors (1+ errors))
 404                        (dired-log (concat "Rename `" file-ori "' to `"
 405                                           file-new "' failed:\n%s\n")
 406                                   err))))))))
 407         (forward-line -1)))
 408     (if changes
 409         (revert-buffer) ;The "revert" is necessary to re-sort the buffer
 410       (let ((buffer-read-only nil))
 411         (remove-text-properties (point-min) (point-max)
 412                                 '(old-name nil end-name nil old-link nil
 413                                            end-link nil end-perm nil
 414                                            old-perm nil perm-changed nil))
 415         (message "(No changes to be performed)")))
 416     (if files-deleted
 417         (wdired-flag-for-deletion files-deleted))
 418     (if (> errors 0)
 419         (dired-log-summary (format "%d rename actions failed" errors) nil)))
 420   (set-buffer-modified-p nil)
 421   (setq buffer-undo-list nil))
 422
 423 ;; Renames a file, searching it in a modified dired buffer, in order
 424 ;; to be able to use `dired-do-create-files-regexp' and get its
 425 ;; "benefits"
 426 (defun wdired-search-and-rename (filename-ori filename-new)
 427   (save-excursion
 428     (goto-char (point-max))
 429     (forward-line -1)
 430     (let ((exit-while nil)
 431           curr-filename)
 432       (while (not exit-while)
 433         (setq curr-filename (wdired-get-filename))
 434         (if (and curr-filename
 435                  (equal (substitute-in-file-name curr-filename) filename-new))
 436             (progn
 437               (setq exit-while t)
 438               (let ((inhibit-read-only t))
 439                 (dired-move-to-filename)
 440                 (search-forward (wdired-get-filename t) nil t)
 441                 (replace-match (file-name-nondirectory filename-ori) t t))
 442               (dired-do-create-files-regexp
 443                (function dired-rename-file)
 444                "Move" 1 ".*" filename-new nil t))
 445           (progn
 446             (forward-line -1)
 447             (beginning-of-line)
 448             (setq exit-while (= 1 (point)))))))))
 449
 450 ;; marks a list of files for deletion
 451 (defun wdired-flag-for-deletion (filenames-ori)
 452   (save-excursion
 453     (goto-char (point-min))
 454     (while (not (eobp))
 455       (if (member (dired-get-filename nil t) filenames-ori)
 456           (dired-flag-file-deletion 1)
 457         (forward-line)))))
 458
 459 (defun wdired-customize ()
 460   "Customize WDired options."
 461   (interactive)
 462   (customize-apropos "wdired" 'groups))
 463
 464 (defun wdired-revert (&optional arg noconfirm)
 465   "Discard changes in the buffer and update it based on changes on disk.
 466 Optional arguments are ignored."
 467   (wdired-change-to-dired-mode)
 468   (revert-buffer)
 469   (wdired-change-to-wdired-mode))
 470
 471 (defun wdired-check-kill-buffer ()
 472   ;; FIXME: Can't we use the normal mechanism for that?  --Stef
 473   (if (and
 474        (buffer-modified-p)
 475        (not (y-or-n-p "Buffer changed. Discard changes and kill buffer? ")))
 476       (error nil)))
 477
 478 (defun wdired-next-line (arg)
 479   "Move down lines then position at filename or the current column.
 480 See `wdired-use-dired-vertical-movement'.  Optional prefix ARG
 481 says how many lines to move; default is one line."
 482   (interactive "p")
 483   (next-line arg)
 484   (if (or (eq wdired-use-dired-vertical-movement t)
 485           (and wdired-use-dired-vertical-movement
 486                (< (current-column)
 487                   (save-excursion (dired-move-to-filename)
 488                                   (current-column)))))
 489       (dired-move-to-filename)))
 490
 491 (defun wdired-previous-line (arg)
 492   "Move up lines then position at filename or the current column.
 493 See `wdired-use-dired-vertical-movement'.  Optional prefix ARG
 494 says how many lines to move; default is one line."
 495   (interactive "p")
 496   (previous-line arg)
 497   (if (or (eq wdired-use-dired-vertical-movement t)
 498           (and wdired-use-dired-vertical-movement
 499                (< (current-column)
 500                   (save-excursion (dired-move-to-filename)
 501                                   (current-column)))))
 502       (dired-move-to-filename)))
 503
 504 ;; Put the needed properties to allow the user to change links' targets
 505 (defun wdired-preprocess-symlinks ()
 506   (let ((inhibit-read-only t))
 507     (save-excursion
 508       (goto-char (point-min))
 509       (while (not (eobp))
 510         (if (looking-at dired-re-sym)
 511             (progn
 512               (re-search-forward " -> \\(.*\\)$")
 513               (put-text-property (- (match-beginning 1) 2)
 514                                  (1- (match-beginning 1)) 'old-link
 515                                  (match-string-no-properties 1))
 516               (put-text-property (match-end 1) (1+ (match-end 1)) 'end-link t)
 517               (put-text-property (1- (match-beginning 1))
 518                                  (match-end 1) 'read-only nil)))
 519         (forward-line)
 520         (beginning-of-line)))))
 521
 522
 523 (defun wdired-get-previous-link (&optional old move)
 524   "Return the next symlink target.
 525 If OLD, return the old target.  If MOVE, move point before it."
 526   (let (beg end target)
 527     (setq beg (previous-single-property-change (point) 'old-link nil))
 528     (if beg
 529         (progn
 530           (if old
 531               (setq target (get-text-property (1- beg) 'old-link))
 532             (setq end (next-single-property-change beg 'end-link))
 533             (setq target (buffer-substring-no-properties (1+ beg) end)))
 534           (if move (goto-char (1- beg)))))
 535     (and target (wdired-normalize-filename target))))
 536
 537
 538
 539 ;; Perform the changes in the target of the changed links.
 540 (defun wdired-do-symlink-changes()
 541   (let ((changes nil)
 542         (errors 0)
 543         link-to-ori link-to-new link-from)
 544     (goto-char (point-max))
 545     (while (setq link-to-new (wdired-get-previous-link))
 546       (setq link-to-ori (wdired-get-previous-link t t))
 547       (setq link-from (wdired-get-filename nil t))
 548       (if (not (equal link-to-new link-to-ori))
 549           (progn
 550             (setq changes t)
 551             (if (equal link-to-new "") ;empty filename!
 552                 (setq link-to-new "/dev/null"))
 553             (condition-case err
 554                 (progn
 555                   (delete-file link-from)
 556                   (make-symbolic-link
 557                    (substitute-in-file-name link-to-new) link-from))
 558                   (error
 559                    (setq errors (1+ errors))
 560                    (dired-log (concat "Link `" link-from "' to `"
 561                                       link-to-new "' failed:\n%s\n")
 562                               err))))))
 563     (cons changes errors)))
 564
 565 ;; Perform a "case command" skipping read-only words.
 566 (defun wdired-xcase-word (command arg)
 567   (if (< arg 0)
 568       (funcall command arg)
 569     (progn
 570       (while (> arg 0)
 571         (condition-case err
 572             (progn
 573               (funcall command 1)
 574               (setq arg (1- arg)))
 575           (error
 576            (if (not (forward-word 1))
 577                (setq arg 0))))))))
 578
 579 (defun wdired-downcase-word (arg)
 580   "WDired version of `downcase-word'.
 581 Like original function but it skips read-only words."
 582   (interactive "p")
 583   (wdired-xcase-word 'downcase-word arg))
 584
 585 (defun wdired-upcase-word (arg)
 586   "WDired version of `upcase-word'.
 587 Like original function but it skips read-only words."
 588   (interactive "p")
 589   (wdired-xcase-word 'upcase-word arg))
 590
 591 (defun wdired-capitalize-word (arg)
 592   "WDired version of `capitalize-word'.
 593 Like original function but it skips read-only words."
 594   (interactive "p")
 595   (wdired-xcase-word 'capitalize-word arg))
 596
 597
 598 ;; The following code deals with changing the access bits (or
 599 ;; permissions) of the files.
 600
 601 (defvar wdired-perm-mode-map nil)
 602 (unless wdired-perm-mode-map
 603   (setq wdired-perm-mode-map (copy-keymap wdired-mode-map))
 604   (define-key wdired-perm-mode-map " " 'wdired-toggle-bit)
 605   (define-key wdired-perm-mode-map "r" 'wdired-set-bit)
 606   (define-key wdired-perm-mode-map "w" 'wdired-set-bit)
 607   (define-key wdired-perm-mode-map "x" 'wdired-set-bit)
 608   (define-key wdired-perm-mode-map "-" 'wdired-set-bit)
 609   (define-key wdired-perm-mode-map "S" 'wdired-set-bit)
 610   (define-key wdired-perm-mode-map "s" 'wdired-set-bit)
 611   (define-key wdired-perm-mode-map "T" 'wdired-set-bit)
 612   (define-key wdired-perm-mode-map "t" 'wdired-set-bit)
 613   (define-key wdired-perm-mode-map "s" 'wdired-set-bit)
 614   (define-key wdired-perm-mode-map "l" 'wdired-set-bit)
 615   (define-key wdired-perm-mode-map [down-mouse-1] 'wdired-mouse-toggle-bit))
 616
 617 ;; Put a local-map to the permission bits of the files, and store the
 618 ;; original name and permissions as a property
 619 (defun wdired-preprocess-perms()
 620   (let ((inhibit-read-only t)
 621         filename)
 622     (set (make-local-variable 'wdired-col-perm) nil)
 623     (save-excursion
 624       (goto-char (point-min))
 625       (while (not (eobp))
 626         (if (and (not (looking-at dired-re-sym))
 627                  (setq filename (wdired-get-filename)))
 628             (progn
 629               (re-search-forward dired-re-perms)
 630               (or wdired-col-perm
 631                   (setq wdired-col-perm (- (current-column) 9)))
 632               (if (eq wdired-allow-to-change-permissions 'advanced)
 633                   (put-text-property (match-beginning 0) (match-end 0)
 634                                      'read-only nil)
 635                 (put-text-property (1+ (match-beginning 0)) (match-end 0)
 636                                    'local-map wdired-perm-mode-map))
 637               (put-text-property (match-end 0) (1+ (match-end 0)) 'end-perm t)
 638               (put-text-property (match-beginning 0) (1+ (match-beginning 0))
 639                                  'old-perm (match-string-no-properties 0))))
 640         (forward-line)
 641         (beginning-of-line)))))
 642
 643 (defun wdired-perm-allowed-in-pos (char pos)
 644   (cond
 645    ((= char ?-)          t)
 646    ((= char ?r)          (= (% pos 3) 0))
 647    ((= char ?w)          (= (% pos 3) 1))
 648    ((= char ?x)          (= (% pos 3) 2))
 649    ((memq char '(?s ?S)) (memq pos '(2 5)))
 650    ((memq char '(?t ?T)) (= pos 8))
 651    ((= char ?l)          (= pos 5))))
 652
 653 (defun wdired-set-bit ()
 654   "Set a permission bit character."
 655   (interactive)
 656   (if (wdired-perm-allowed-in-pos last-command-char
 657                                   (- (current-column) wdired-col-perm))
 658       (let ((new-bit (char-to-string last-command-char))
 659             (inhibit-read-only t)
 660             (pos-prop (- (point) (- (current-column) wdired-col-perm))))
 661         (put-text-property 0 1 'local-map wdired-perm-mode-map new-bit)
 662         (put-text-property 0 1 'read-only t new-bit)
 663         (insert new-bit)
 664         (delete-char 1)
 665         (put-text-property pos-prop (1- pos-prop) 'perm-changed t))
 666     (forward-char 1)))
 667
 668 (defun wdired-toggle-bit()
 669   "Toggle the permission bit at point."
 670   (interactive)
 671   (let ((inhibit-read-only t)
 672         (new-bit "-")
 673         (pos-prop (- (point) (- (current-column) wdired-col-perm))))
 674     (if (eq (char-after (point)) ?-)
 675         (setq new-bit
 676               (if (= (% (- (current-column) wdired-col-perm) 3) 0) "r"
 677                 (if (= (% (- (current-column) wdired-col-perm) 3) 1) "w"
 678                   "x"))))
 679     (put-text-property 0 1 'local-map wdired-perm-mode-map new-bit)
 680     (put-text-property 0 1 'read-only t new-bit)
 681     (insert new-bit)
 682     (delete-char 1)
 683     (put-text-property pos-prop (1- pos-prop) 'perm-changed t)))
 684
 685 (defun wdired-mouse-toggle-bit (event)
 686   "Toggle the permission bit that was left clicked."
 687   (interactive "e")
 688   (mouse-set-point event)
 689   (wdired-toggle-bit))
 690
 691 ;; Allowed chars for 4000 bit are Ss  in position 3
 692 ;; Allowed chars for 2000 bit are Ssl in position 6
 693 ;; Allowed chars for 1000 bit are Tt  in position 9
 694 (defun wdired-perms-to-number (perms)
 695   (let ((nperm 0777))
 696     (if (= (elt perms 1) ?-) (setq nperm (- nperm 400)))
 697     (if (= (elt perms 2) ?-) (setq nperm (- nperm 200)))
 698     (let ((p-bit (elt perms 3)))
 699       (if (memq p-bit '(?- ?S)) (setq nperm (- nperm 100)))
 700       (if (memq p-bit '(?s ?S)) (setq nperm (+ nperm 4000))))
 701     (if (= (elt perms 4) ?-) (setq nperm (- nperm 40)))
 702     (if (= (elt perms 5) ?-) (setq nperm (- nperm 20)))
 703     (let ((p-bit (elt perms 6)))
 704       (if (memq p-bit '(?- ?S ?l)) (setq nperm (- nperm 10)))
 705       (if (memq p-bit '(?s ?S ?l)) (setq nperm (+ nperm 2000))))
 706     (if (= (elt perms 7) ?-) (setq nperm (- nperm 4)))
 707     (if (= (elt perms 8) ?-) (setq nperm (- nperm 2)))
 708     (let ((p-bit (elt perms 9)))
 709       (if (memq p-bit '(?- ?T)) (setq nperm (- nperm 1)))
 710       (if (memq p-bit '(?t ?T)) (setq nperm (+ nperm 1000))))
 711     nperm))
 712
 713 ;; Perform the changes in the permissions of the files that have
 714 ;; changed.
 715 (defun wdired-do-perm-changes ()
 716   (let ((changes nil)
 717         (errors 0)
 718         (prop-wanted (if (eq wdired-allow-to-change-permissions 'advanced)
 719                          'old-perm 'perm-changed))
 720         filename perms-ori perms-new perm-tmp)
 721     (goto-char (next-single-property-change (point-min) prop-wanted
 722                                             nil (point-max)))
 723     (while (not (eobp))
 724       (setq perms-ori (get-text-property (point) 'old-perm))
 725       (setq perms-new (buffer-substring-no-properties
 726                        (point) (next-single-property-change (point) 'end-perm)))
 727       (if (not (equal perms-ori perms-new))
 728           (progn
 729             (setq changes t)
 730             (setq filename (wdired-get-filename nil t))
 731             (if (= (length perms-new) 10)
 732                 (progn
 733                   (setq perm-tmp
 734                         (int-to-string (wdired-perms-to-number perms-new)))
 735                   (if (not (equal 0 (dired-call-process dired-chmod-program
 736                                      t perm-tmp filename)))
 737                       (progn
 738                         (setq errors (1+ errors))
 739                         (dired-log (concat dired-chmod-program " " perm-tmp
 740                                            " `" filename "' failed\n\n")))))
 741             (setq errors (1+ errors))
 742             (dired-log (concat "Cannot parse permission `" perms-new
 743                                "' for file `" filename "'\n\n")))))
 744       (goto-char (next-single-property-change (1+ (point)) prop-wanted
 745                                               nil (point-max))))
 746     (cons changes errors)))
 747
 748 (provide 'wdired)
 749
 750 ;; arch-tag: bc00902e-526f-4305-bc7f-8862a559184f
 751 ;;; wdired.el ends here