lisp/wdired.el

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