lisp/wdired.el

   1 ;;; wdired.el --- Rename files editing their names in dired buffers -*- coding: utf-8; -*-
   2
   3 ;; Copyright (C) 2004-2018 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 <https://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 (require 'dired)
  77 (autoload 'dired-do-create-files-regexp "dired-aux")
  78
  79 (defgroup wdired nil
  80   "Mode to rename files by editing their names in dired buffers."
  81   :group 'dired)
  82
  83 (defcustom wdired-use-interactive-rename nil
  84   "If non-nil, WDired requires confirmation before actually renaming files.
  85 If nil, WDired doesn't require confirmation to change the file names,
  86 and the variable `wdired-confirm-overwrite' controls whether it is ok
  87 to overwrite files without asking."
  88   :type 'boolean
  89   :group 'wdired)
  90
  91 (defcustom wdired-confirm-overwrite t
  92   "If nil the renames can overwrite files without asking.
  93 This variable has no effect at all if `wdired-use-interactive-rename'
  94 is not nil."
  95   :type 'boolean
  96   :group 'wdired)
  97
  98 (defcustom wdired-use-dired-vertical-movement nil
  99   "If t, the \"up\" and \"down\" movement works as in Dired mode.
 100 That is, always move the point to the beginning of the filename at line.
 101
 102 If `sometimes', only move to the beginning of filename if the point is
 103 before it, and `track-eol' is non-nil.  This behavior is very handy
 104 when editing several filenames.
 105
 106 If nil, \"up\" and \"down\" movement is done as in any other buffer."
 107   :type '(choice (const :tag "As in any other mode" nil)
 108                  (const :tag "Smart cursor placement" sometimes)
 109                  (other :tag "As in dired mode" t))
 110   :group 'wdired)
 111
 112 (defcustom wdired-allow-to-redirect-links t
 113   "If non-nil, the target of the symbolic links are editable.
 114 In systems without symbolic links support, this variable has no effect
 115 at all."
 116   :type 'boolean
 117   :group 'wdired)
 118
 119 (defcustom wdired-allow-to-change-permissions nil
 120   "If non-nil, the permissions bits of the files are editable.
 121
 122 If t, to change a single bit, put the cursor over it and press the
 123 space bar, or left click over it.  You can also hit the letter you want
 124 to set: if this value is allowed, the character in the buffer will be
 125 changed.  Anyway, the point is advanced one position, so, for example,
 126 you can keep the <x> key pressed to give execution permissions to
 127 everybody to that file.
 128
 129 If `advanced', the bits are freely editable.  You can use
 130 `string-rectangle', `query-replace', etc.  You can put any value (even
 131 newlines), but if you want your changes to be useful, you better put a
 132 intelligible value.
 133
 134 Anyway, the real change of the permissions is done by the external
 135 program `dired-chmod-program', which must exist."
 136   :type '(choice (const :tag "Not allowed" nil)
 137                  (const :tag "Toggle/set bits" t)
 138                  (other :tag "Bits freely editable" advanced))
 139   :group 'wdired)
 140
 141 (defcustom wdired-keep-marker-rename t
 142   ;; Use t as default so that renamed files "take their markers with them".
 143   "Controls marking of files renamed in WDired.
 144 If t, files keep their previous marks when they are renamed.
 145 If a character, renamed files (whether previously marked or not)
 146 are afterward marked with that character.
 147 This option affects only files renamed by `wdired-finish-edit'.
 148 See `dired-keep-marker-rename' if you want to do the same for files
 149 renamed by `dired-do-rename' and `dired-do-rename-regexp'."
 150   :type '(choice (const :tag "Keep" t)
 151                  (character :tag "Mark" :value ?R))
 152   :version "24.3"
 153   :group 'wdired)
 154
 155 (defcustom wdired-create-parent-directories t
 156   "If non-nil, create parent directories of destination files.
 157 If non-nil, when you rename a file to a destination path within a
 158 nonexistent directory, wdired will create any parent directories
 159 necessary.  When nil, attempts to rename a file into a
 160 nonexistent directory will fail."
 161   :version "26.1"
 162   :type 'boolean
 163   :group 'wdired)
 164
 165 (defvar wdired-mode-map
 166   (let ((map (make-sparse-keymap)))
 167     (define-key map "\C-x\C-s" 'wdired-finish-edit)
 168     (define-key map "\C-c\C-c" 'wdired-finish-edit)
 169     (define-key map "\C-c\C-k" 'wdired-abort-changes)
 170     (define-key map "\C-c\C-[" 'wdired-abort-changes)
 171     (define-key map "\C-x\C-q" 'wdired-exit)
 172     (define-key map "\C-m"     'ignore)
 173     (define-key map "\C-j"     'ignore)
 174     (define-key map "\C-o"     'ignore)
 175     (define-key map [up]       'wdired-previous-line)
 176     (define-key map "\C-p"     'wdired-previous-line)
 177     (define-key map [down]     'wdired-next-line)
 178     (define-key map "\C-n"     'wdired-next-line)
 179
 180     (define-key map [menu-bar wdired]
 181       (cons "WDired" (make-sparse-keymap "WDired")))
 182     (define-key map [menu-bar wdired wdired-customize]
 183       '("Options" . wdired-customize))
 184     (define-key map [menu-bar wdired dashes]
 185       '("--"))
 186     (define-key map [menu-bar wdired wdired-abort-changes]
 187       '(menu-item "Abort Changes" wdired-abort-changes
 188                   :help "Abort changes and return to dired mode"))
 189     (define-key map [menu-bar wdired wdired-finish-edit]
 190       '("Commit Changes" . wdired-finish-edit))
 191
 192     (define-key map [remap upcase-word] 'wdired-upcase-word)
 193     (define-key map [remap capitalize-word] 'wdired-capitalize-word)
 194     (define-key map [remap downcase-word] 'wdired-downcase-word)
 195
 196     map)
 197   "Keymap used in `wdired-mode'.")
 198
 199 (defvar wdired-mode-hook nil
 200   "Hooks run when changing to WDired mode.")
 201
 202 ;; Local variables (put here to avoid compilation gripes)
 203 (defvar wdired-col-perm) ;; Column where the permission bits start
 204 (defvar wdired-old-content)
 205 (defvar wdired-old-point)
 206 (defvar wdired-old-marks)
 207
 208 (defun wdired-mode ()
 209   "Writable Dired (WDired) mode.
 210 \\<wdired-mode-map>
 211 In WDired mode, you can edit the names of the files in the
 212 buffer, the target of the links, and the permission bits of the
 213 files.
 214
 215 Type \\[wdired-finish-edit] to exit WDired mode, returning to
 216 Dired mode, and make your edits \"take effect\" by modifying the
 217 file and directory names, link targets, and/or file permissions
 218 on disk.  If you delete the filename of a file, it is flagged for
 219 deletion in the Dired buffer.
 220
 221 Type \\[wdired-abort-changes] to abort your edits and exit WDired mode.
 222
 223 Type \\[customize-group] RET wdired to customize WDired behavior.
 224
 225 The only editable texts in a WDired buffer are filenames,
 226 symbolic link targets, and filenames permission."
 227   (interactive)
 228   (error "This mode can be enabled only by `wdired-change-to-wdired-mode'"))
 229 (put 'wdired-mode 'mode-class 'special)
 230
 231
 232 ;;;###autoload
 233 (defun wdired-change-to-wdired-mode ()
 234   "Put a Dired buffer in Writable Dired (WDired) mode.
 235 \\<wdired-mode-map>
 236 In WDired mode, you can edit the names of the files in the
 237 buffer, the target of the links, and the permission bits of the
 238 files.  After typing \\[wdired-finish-edit], Emacs modifies the files and
 239 directories to reflect your edits.
 240
 241 See `wdired-mode'."
 242   (interactive)
 243   (unless (eq major-mode 'dired-mode)
 244     (error "Not a Dired buffer"))
 245   (set (make-local-variable 'wdired-old-content)
 246        (buffer-substring (point-min) (point-max)))
 247   (set (make-local-variable 'wdired-old-marks)
 248        (dired-remember-marks (point-min) (point-max)))
 249   (set (make-local-variable 'wdired-old-point) (point))
 250   (set (make-local-variable 'query-replace-skip-read-only) t)
 251   (add-function :after-while (local 'isearch-filter-predicate)
 252                 #'wdired-isearch-filter-read-only)
 253   (use-local-map wdired-mode-map)
 254   (force-mode-line-update)
 255   (setq buffer-read-only nil)
 256   (dired-unadvertise default-directory)
 257   (add-hook 'kill-buffer-hook 'wdired-check-kill-buffer nil t)
 258   (add-hook 'after-change-functions 'wdired--restore-dired-filename-prop nil t)
 259   (setq major-mode 'wdired-mode)
 260   (setq mode-name "Editable Dired")
 261   (setq revert-buffer-function 'wdired-revert)
 262   ;; I temp disable undo for performance: since I'm going to clear the
 263   ;; undo list, it can save more than a 9% of time with big
 264   ;; directories because setting properties modify the undo-list.
 265   (buffer-disable-undo)
 266   (wdired-preprocess-files)
 267   (if wdired-allow-to-change-permissions
 268       (wdired-preprocess-perms))
 269   (if (and wdired-allow-to-redirect-links (fboundp 'make-symbolic-link))
 270       (wdired-preprocess-symlinks))
 271   (buffer-enable-undo) ; Performance hack. See above.
 272   (set-buffer-modified-p nil)
 273   (setq buffer-undo-list nil)
 274   (run-mode-hooks 'wdired-mode-hook)
 275   (message "%s" (substitute-command-keys
 276                  "Press \\[wdired-finish-edit] when finished \
 277 or \\[wdired-abort-changes] to abort changes")))
 278
 279 (defun wdired-isearch-filter-read-only (beg end)
 280   "Skip matches that have a read-only property."
 281   (not (text-property-not-all (min beg end) (max beg end)
 282                               'read-only nil)))
 283
 284 ;; Protect the buffer so only the filenames can be changed, and put
 285 ;; properties so filenames (old and new) can be easily found.
 286 (defun wdired-preprocess-files ()
 287   (put-text-property (point-min) (1+ (point-min))'front-sticky t)
 288   (save-excursion
 289     (goto-char (point-min))
 290     (let ((b-protection (point))
 291           filename)
 292       (while (not (eobp))
 293         (setq filename (dired-get-filename nil t))
 294         (when (and filename
 295                    (not (member (file-name-nondirectory filename) '("." ".."))))
 296           (dired-move-to-filename)
 297           ;; The rear-nonsticky property below shall ensure that text preceding
 298           ;; the filename can't be modified.
 299           (add-text-properties
 300            (1- (point)) (point) `(old-name ,filename rear-nonsticky (read-only)))
 301           (put-text-property b-protection (point) 'read-only t)
 302           (setq b-protection (dired-move-to-end-of-filename t))
 303           (put-text-property (point) (1+ (point)) 'end-name t))
 304         (forward-line))
 305       (put-text-property b-protection (point-max) 'read-only t))))
 306
 307 ;; This code is a copy of some dired-get-filename lines.
 308 (defsubst wdired-normalize-filename (file unquotep)
 309   (when unquotep
 310     (setq file
 311           ;; FIXME: shouldn't we check for a `b' argument or somesuch before
 312           ;; doing such unquoting?  --Stef
 313           (read (concat
 314                  "\"" (replace-regexp-in-string
 315                        "\\([^\\]\\|\\`\\)\"" "\\1\\\\\"" file)
 316                  "\""))))
 317   (and file buffer-file-coding-system
 318        (not file-name-coding-system)
 319        (not default-file-name-coding-system)
 320        (setq file (encode-coding-string file buffer-file-coding-system)))
 321   file)
 322
 323 (defun wdired-get-filename (&optional no-dir old)
 324   "Return the filename at line.
 325 Similar to `dired-get-filename' but it doesn't rely on regexps.  It
 326 relies on WDired buffer's properties.  Optional arg NO-DIR with value
 327 non-nil means don't include directory.  Optional arg OLD with value
 328 non-nil means return old filename."
 329   ;; FIXME: Use dired-get-filename's new properties.
 330   (let (beg end file)
 331     (save-excursion
 332       (setq end (line-end-position))
 333       (beginning-of-line)
 334       (setq beg (next-single-property-change (point) 'old-name nil end))
 335       (unless (eq beg end)
 336         (if old
 337             (setq file (get-text-property beg 'old-name))
 338           ;; In the following form changed `(1+ beg)' to `beg' so that
 339           ;; the filename end is found even when the filename is empty.
 340           ;; Fixes error and spurious newlines when marking files for
 341           ;; deletion.
 342           (setq end (next-single-property-change beg 'end-name))
 343           (setq file (buffer-substring-no-properties (1+ beg) end)))
 344         ;; Don't unquote the old name, it wasn't quoted in the first place
 345         (and file (setq file (wdired-normalize-filename file (not old)))))
 346       (if (or no-dir old)
 347           file
 348         (and file (> (length file) 0)
 349              (concat (dired-current-directory) file))))))
 350
 351
 352 (defun wdired-change-to-dired-mode ()
 353   "Change the mode back to dired."
 354   (or (eq major-mode 'wdired-mode)
 355       (error "Not a Wdired buffer"))
 356   (let ((inhibit-read-only t))
 357     (remove-text-properties
 358      (point-min) (point-max)
 359      '(front-sticky nil rear-nonsticky nil read-only nil keymap nil)))
 360   (use-local-map dired-mode-map)
 361   (force-mode-line-update)
 362   (setq buffer-read-only t)
 363   (setq major-mode 'dired-mode)
 364   (setq mode-name "Dired")
 365   (dired-advertise)
 366   (remove-hook 'kill-buffer-hook 'wdired-check-kill-buffer t)
 367   (remove-hook 'after-change-functions 'wdired--restore-dired-filename-prop t)
 368   (set (make-local-variable 'revert-buffer-function) 'dired-revert))
 369
 370
 371 (defun wdired-abort-changes ()
 372   "Abort changes and return to dired mode."
 373   (interactive)
 374   (let ((inhibit-read-only t))
 375     (erase-buffer)
 376     (insert wdired-old-content)
 377     (goto-char wdired-old-point))
 378   (wdired-change-to-dired-mode)
 379   (set-buffer-modified-p nil)
 380   (setq buffer-undo-list nil)
 381   (message "Changes aborted"))
 382
 383 (defun wdired-finish-edit ()
 384   "Actually rename files based on your editing in the Dired buffer."
 385   (interactive)
 386   (let ((changes nil)
 387         (errors 0)
 388         files-deleted
 389         files-renamed
 390         some-file-names-unchanged
 391         file-old file-new tmp-value)
 392     (save-excursion
 393       (when (and wdired-allow-to-redirect-links
 394                  (fboundp 'make-symbolic-link))
 395         (setq tmp-value (wdired-do-symlink-changes))
 396         (setq errors (cdr tmp-value))
 397         (setq changes (car tmp-value)))
 398       (when (and wdired-allow-to-change-permissions
 399                  (boundp 'wdired-col-perm)) ; could have been changed
 400         (setq tmp-value (wdired-do-perm-changes))
 401         (setq errors (+ errors (cdr tmp-value)))
 402         (setq changes (or changes (car tmp-value))))
 403       (goto-char (point-max))
 404       (while (not (bobp))
 405         (setq file-old (wdired-get-filename nil t))
 406         (when file-old
 407           (setq file-new (wdired-get-filename))
 408           (if (equal file-new file-old)
 409               (setq some-file-names-unchanged t)
 410             (setq changes t)
 411             (if (not file-new)          ;empty filename!
 412                 (push file-old files-deleted)
 413               (when wdired-keep-marker-rename
 414                 (let ((mark (cond ((integerp wdired-keep-marker-rename)
 415                                    wdired-keep-marker-rename)
 416                                   (wdired-keep-marker-rename
 417                                    (cdr (assoc file-old wdired-old-marks)))
 418                                   (t nil))))
 419                   (when mark
 420                     (push (cons (substitute-in-file-name file-new) mark)
 421                           wdired-old-marks))))
 422               (push (cons file-old (substitute-in-file-name file-new))
 423                     files-renamed))))
 424         (forward-line -1)))
 425     (when files-renamed
 426       (setq errors (+ errors (wdired-do-renames files-renamed))))
 427     ;; We have to be in wdired-mode when wdired-do-renames is executed
 428     ;; so that wdired--restore-dired-filename-prop runs, but we have
 429     ;; to change back to dired-mode before reverting the buffer to
 430     ;; avoid using wdired-revert, which changes back to wdired-mode.
 431     (wdired-change-to-dired-mode)
 432     (if changes
 433         (progn
 434           ;; If we are displaying a single file (rather than the
 435           ;; contents of a directory), change dired-directory if that
 436           ;; file was renamed.  (This ought to be generalized to
 437           ;; handle the multiple files case, but that's less trivial).
 438           (when (and (stringp dired-directory)
 439                      (not (file-directory-p dired-directory))
 440                      (null some-file-names-unchanged)
 441                      (= (length files-renamed) 1))
 442             (setq dired-directory (cdr (car files-renamed))))
 443           ;; Re-sort the buffer.
 444           (revert-buffer)
 445           (let ((inhibit-read-only t))
 446             (dired-mark-remembered wdired-old-marks)))
 447       (let ((inhibit-read-only t))
 448         (remove-text-properties (point-min) (point-max)
 449                                 '(old-name nil end-name nil old-link nil
 450                                            end-link nil end-perm nil
 451                                            old-perm nil perm-changed nil))
 452         (message "(No changes to be performed)")))
 453     (when files-deleted
 454       (wdired-flag-for-deletion files-deleted))
 455     (when (> errors 0)
 456       (dired-log-summary (format "%d rename actions failed" errors) nil)))
 457   (set-buffer-modified-p nil)
 458   (setq buffer-undo-list nil))
 459
 460 (defun wdired-do-renames (renames)
 461   "Perform RENAMES in parallel."
 462   (let ((residue ())
 463         (progress nil)
 464         (errors 0)
 465         (overwrite (or (not wdired-confirm-overwrite) 1)))
 466     (while (or renames
 467                ;; We've done one round through the renames, we have found
 468                ;; some residue, but we also made some progress, so maybe
 469                ;; some of the residue were resolved: try again.
 470                (prog1 (setq renames residue)
 471                  (setq progress nil)
 472                  (setq residue nil)))
 473       (let* ((rename (pop renames))
 474              (file-new (cdr rename)))
 475         (cond
 476          ((rassoc file-new renames)
 477           (error "Trying to rename 2 files to the same name"))
 478          ((assoc file-new renames)
 479           ;; Renaming to a file name that already exists but will itself be
 480           ;; renamed as well.  Let's wait until that one gets renamed.
 481           (push rename residue))
 482          ((and (assoc file-new residue)
 483                ;; Make sure the file really exists: if it doesn't it's
 484                ;; not really a conflict.  It might be a temp-file generated
 485                ;; specifically to break a circular renaming.
 486                (file-exists-p file-new))
 487           ;; Renaming to a file name that already exists, needed to be renamed,
 488           ;; but whose renaming could not be performed right away.
 489           (if (or progress renames)
 490               ;; There's still a chance the conflict will be resolved.
 491               (push rename residue)
 492             ;; We have not made any progress and we've reached the end of
 493             ;; the renames, so we really have a circular conflict, and we
 494             ;; have to forcefully break the cycle.
 495             (message "Circular renaming: using temporary file name")
 496             (let ((tmp (make-temp-name file-new)))
 497               (push (cons (car rename) tmp) renames)
 498               (push (cons tmp file-new) residue))))
 499          (t
 500           (setq progress t)
 501           (let ((file-ori (car rename)))
 502             (if wdired-use-interactive-rename
 503                 (wdired-search-and-rename file-ori file-new)
 504               ;; If dired-rename-file autoloads dired-aux while
 505               ;; dired-backup-overwrite is locally bound,
 506               ;; dired-backup-overwrite won't be initialized.
 507               ;; So we must ensure dired-aux is loaded.
 508               (require 'dired-aux)
 509               (condition-case err
 510                   (let ((dired-backup-overwrite nil))
 511                     (and wdired-create-parent-directories
 512                          (wdired-create-parentdirs file-new))
 513                     (dired-rename-file file-ori file-new
 514                                        overwrite))
 515                 (error
 516                  (setq errors (1+ errors))
 517                  (dired-log "Rename `%s' to `%s' failed:\n%s\n"
 518                             file-ori file-new
 519                             err)))))))))
 520     errors))
 521
 522 (defun wdired-create-parentdirs (file-new)
 523   "Create parent directories for FILE-NEW if they don't exist."
 524   (and (not (file-exists-p (file-name-directory file-new)))
 525        (message "Creating directory for file %s" file-new)
 526        (make-directory (file-name-directory file-new) t)))
 527
 528 (defun wdired-exit ()
 529   "Exit wdired and return to dired mode.
 530 Just return to dired mode if there are no changes.  Otherwise,
 531 ask a yes-or-no question whether to save or cancel changes,
 532 and proceed depending on the answer."
 533   (interactive)
 534   (if (buffer-modified-p)
 535       (if (y-or-n-p (format "Buffer %s modified; save changes? "
 536                             (current-buffer)))
 537           (wdired-finish-edit)
 538         (wdired-abort-changes))
 539     (wdired-change-to-dired-mode)
 540     (set-buffer-modified-p nil)
 541     (setq buffer-undo-list nil)
 542     (message "(No changes need to be saved)")))
 543
 544 ;; Rename a file, searching it in a modified dired buffer, in order
 545 ;; to be able to use `dired-do-create-files-regexp' and get its
 546 ;; "benefits".
 547 (defun wdired-search-and-rename (filename-ori filename-new)
 548   (save-excursion
 549     (goto-char (point-max))
 550     (forward-line -1)
 551     (let ((done nil)
 552           (failed t)
 553           curr-filename)
 554       (while (and (not done) (not (bobp)))
 555         (setq curr-filename (wdired-get-filename nil t))
 556         (if (equal curr-filename filename-ori)
 557             (unwind-protect
 558                 (progn
 559                   (setq done t)
 560                   (let ((inhibit-read-only t))
 561                     (dired-move-to-filename)
 562                     (search-forward (wdired-get-filename t) nil t)
 563                     (replace-match (file-name-nondirectory filename-ori) t t))
 564                   (dired-do-create-files-regexp
 565                    (function dired-rename-file)
 566                    "Move" 1 ".*" filename-new nil t)
 567                   (setq failed nil))
 568               ;; If user types C-g when prompted to change the file
 569               ;; name, make sure we return to dired-mode.
 570               (when failed (wdired-change-to-dired-mode)))
 571           (forward-line -1))))))
 572
 573 ;; marks a list of files for deletion
 574 (defun wdired-flag-for-deletion (filenames-ori)
 575   (save-excursion
 576     (goto-char (point-min))
 577     (while (not (eobp))
 578       (if (member (dired-get-filename nil t) filenames-ori)
 579           (dired-flag-file-deletion 1)
 580         (forward-line)))))
 581
 582 (defun wdired-customize ()
 583   "Customize WDired options."
 584   (interactive)
 585   (customize-apropos "wdired" 'groups))
 586
 587 (defun wdired-revert (&optional _arg _noconfirm)
 588   "Discard changes in the buffer and update it based on changes on disk.
 589 Optional arguments are ignored."
 590   (wdired-change-to-dired-mode)
 591   (revert-buffer)
 592   (wdired-change-to-wdired-mode))
 593
 594 (defun wdired-check-kill-buffer ()
 595   ;; FIXME: Can't we use the normal mechanism for that?  --Stef
 596   (if (and
 597        (buffer-modified-p)
 598        (not (y-or-n-p "Buffer changed. Discard changes and kill buffer? ")))
 599       (error "Error")))
 600
 601 ;; Added to after-change-functions in wdired-change-to-wdired-mode to
 602 ;; ensure that, on editing a file name, new characters get the
 603 ;; dired-filename text property, which allows functions that look for
 604 ;; this property (e.g. dired-isearch-filenames) to work in wdired-mode
 605 ;; and also avoids an error with non-nil wdired-use-interactive-rename
 606 ;; (bug#32173).
 607 (defun wdired--restore-dired-filename-prop (beg end _len)
 608   (save-match-data
 609     (save-excursion
 610       (let ((lep (line-end-position)))
 611         (beginning-of-line)
 612         (when (re-search-forward
 613                directory-listing-before-filename-regexp lep t)
 614           (setq beg (point)
 615                 ;; If the file is a symlink, put the dired-filename
 616                 ;; property only on the link name.  (Using
 617                 ;; (file-symlink-p (dired-get-filename)) fails in
 618                 ;; wdired-mode, bug#32673.)
 619                 end (if (and (re-search-backward
 620                               dired-permission-flags-regexp nil t)
 621                              (looking-at "l")
 622                              (search-forward " -> " lep t))
 623                         (goto-char (match-beginning 0))
 624                       lep))
 625           (put-text-property beg end 'dired-filename t))))))
 626
 627 (defun wdired-next-line (arg)
 628   "Move down lines then position at filename or the current column.
 629 See `wdired-use-dired-vertical-movement'.  Optional prefix ARG
 630 says how many lines to move; default is one line."
 631   (interactive "^p")
 632   (with-no-warnings (next-line arg))
 633   (if (or (eq wdired-use-dired-vertical-movement t)
 634           (and wdired-use-dired-vertical-movement
 635                (< (current-column)
 636                   (save-excursion (dired-move-to-filename)
 637                                   (current-column)))))
 638       (dired-move-to-filename)))
 639
 640 (defun wdired-previous-line (arg)
 641   "Move up lines then position at filename or the current column.
 642 See `wdired-use-dired-vertical-movement'.  Optional prefix ARG
 643 says how many lines to move; default is one line."
 644   (interactive "^p")
 645   (with-no-warnings (previous-line arg))
 646   (if (or (eq wdired-use-dired-vertical-movement t)
 647           (and wdired-use-dired-vertical-movement
 648                (< (current-column)
 649                   (save-excursion (dired-move-to-filename)
 650                                   (current-column)))))
 651       (dired-move-to-filename)))
 652
 653 ;; Put the needed properties to allow the user to change links' targets
 654 (defun wdired-preprocess-symlinks ()
 655   (let ((inhibit-read-only t))
 656     (save-excursion
 657       (goto-char (point-min))
 658       (while (not (eobp))
 659         (if (looking-at dired-re-sym)
 660             (progn
 661               (re-search-forward " -> \\(.*\\)$")
 662               (put-text-property (- (match-beginning 1) 2)
 663                                  (1- (match-beginning 1)) 'old-link
 664                                  (match-string-no-properties 1))
 665               (put-text-property (match-end 1) (1+ (match-end 1)) 'end-link t)
 666               (put-text-property (1- (match-beginning 1))
 667                                  (match-beginning 1)
 668                                  'rear-nonsticky '(read-only))
 669               (put-text-property (match-beginning 1)
 670                                  (match-end 1) 'read-only nil)))
 671         (forward-line)
 672         (beginning-of-line)))))
 673
 674
 675 (defun wdired-get-previous-link (&optional old move)
 676   "Return the next symlink target.
 677 If OLD, return the old target.  If MOVE, move point before it."
 678   (let (beg end target)
 679     (setq beg (previous-single-property-change (point) 'old-link nil))
 680     (if beg
 681         (progn
 682           (if old
 683               (setq target (get-text-property (1- beg) 'old-link))
 684             (setq end (next-single-property-change beg 'end-link))
 685             (setq target (buffer-substring-no-properties (1+ beg) end)))
 686           (if move (goto-char (1- beg)))))
 687     (and target (wdired-normalize-filename target t))))
 688
 689 (declare-function make-symbolic-link "fileio.c")
 690
 691 ;; Perform the changes in the target of the changed links.
 692 (defun wdired-do-symlink-changes ()
 693   (let ((changes nil)
 694         (errors 0)
 695         link-to-ori link-to-new link-from)
 696     (goto-char (point-max))
 697     (while (setq link-to-new (wdired-get-previous-link))
 698       (setq link-to-ori (wdired-get-previous-link t t))
 699       (setq link-from (wdired-get-filename nil t))
 700       (unless (equal link-to-new link-to-ori)
 701         (setq changes t)
 702         (if (equal link-to-new "") ;empty filename!
 703             (setq link-to-new "/dev/null"))
 704         (condition-case err
 705             (progn
 706               (delete-file link-from)
 707               (make-symbolic-link
 708                (substitute-in-file-name link-to-new) link-from))
 709           (error
 710            (setq errors (1+ errors))
 711            (dired-log "Link `%s' to `%s' failed:\n%s\n"
 712                       link-from link-to-new
 713                       err)))))
 714     (cons changes errors)))
 715
 716 ;; Perform a "case command" skipping read-only words.
 717 (defun wdired-xcase-word (command arg)
 718   (if (< arg 0)
 719       (funcall command arg)
 720     (while (> arg 0)
 721       (condition-case nil
 722           (progn
 723             (funcall command 1)
 724             (setq arg (1- arg)))
 725         (error
 726          (if (forward-word-strictly)
 727              ;; Skip any non-word characters to avoid triggering a read-only
 728              ;; error which would cause skipping the next word characters too.
 729              (skip-syntax-forward "^w")
 730            (setq arg 0)))))))
 731
 732 (defun wdired-downcase-word (arg)
 733   "WDired version of `downcase-word'.
 734 Like original function but it skips read-only words."
 735   (interactive "p")
 736   (wdired-xcase-word 'downcase-word arg))
 737
 738 (defun wdired-upcase-word (arg)
 739   "WDired version of `upcase-word'.
 740 Like original function but it skips read-only words."
 741   (interactive "p")
 742   (wdired-xcase-word 'upcase-word arg))
 743
 744 (defun wdired-capitalize-word (arg)
 745   "WDired version of `capitalize-word'.
 746 Like original function but it skips read-only words."
 747   (interactive "p")
 748   (wdired-xcase-word 'capitalize-word arg))
 749
 750
 751 ;; The following code deals with changing the access bits (or
 752 ;; permissions) of the files.
 753
 754 (defvar wdired-perm-mode-map
 755   (let ((map (make-sparse-keymap)))
 756     (define-key map " " 'wdired-toggle-bit)
 757     (define-key map "r" 'wdired-set-bit)
 758     (define-key map "w" 'wdired-set-bit)
 759     (define-key map "x" 'wdired-set-bit)
 760     (define-key map "-" 'wdired-set-bit)
 761     (define-key map "S" 'wdired-set-bit)
 762     (define-key map "s" 'wdired-set-bit)
 763     (define-key map "T" 'wdired-set-bit)
 764     (define-key map "t" 'wdired-set-bit)
 765     (define-key map "s" 'wdired-set-bit)
 766     (define-key map "l" 'wdired-set-bit)
 767     (define-key map [down-mouse-1] 'wdired-mouse-toggle-bit)
 768     map))
 769
 770 ;; Put a keymap property to the permission bits of the files, and store the
 771 ;; original name and permissions as a property
 772 (defun wdired-preprocess-perms ()
 773   (let ((inhibit-read-only t))
 774     (set (make-local-variable 'wdired-col-perm) nil)
 775     (save-excursion
 776       (goto-char (point-min))
 777       (while (not (eobp))
 778         (when (and (not (looking-at dired-re-sym))
 779                    (wdired-get-filename)
 780                    (re-search-forward dired-re-perms (line-end-position) 'eol))
 781           (let ((begin (match-beginning 0))
 782                 (end (match-end 0)))
 783             (unless wdired-col-perm
 784               (setq wdired-col-perm (- (current-column) 9)))
 785             (if (eq wdired-allow-to-change-permissions 'advanced)
 786                 (progn
 787                   (put-text-property begin end 'read-only nil)
 788                   ;; make first permission bit writable
 789                   (put-text-property
 790                    (1- begin) begin 'rear-nonsticky '(read-only)))
 791               ;; avoid that keymap applies to text following permissions
 792               (add-text-properties
 793                (1+ begin) end
 794                `(keymap ,wdired-perm-mode-map rear-nonsticky (keymap))))
 795             (put-text-property end (1+ end) 'end-perm t)
 796             (put-text-property
 797              begin (1+ begin) 'old-perm (match-string-no-properties 0))))
 798         (forward-line)
 799         (beginning-of-line)))))
 800
 801 (defun wdired-perm-allowed-in-pos (char pos)
 802   (cond
 803    ((= char ?-)          t)
 804    ((= char ?r)          (= (% pos 3) 0))
 805    ((= char ?w)          (= (% pos 3) 1))
 806    ((= char ?x)          (= (% pos 3) 2))
 807    ((memq char '(?s ?S)) (memq pos '(2 5)))
 808    ((memq char '(?t ?T)) (= pos 8))
 809    ((= char ?l)          (= pos 5))))
 810
 811 (defun wdired-set-bit ()
 812   "Set a permission bit character."
 813   (interactive)
 814   (if (wdired-perm-allowed-in-pos last-command-event
 815                                   (- (current-column) wdired-col-perm))
 816       (let ((new-bit (char-to-string last-command-event))
 817             (inhibit-read-only t)
 818             (pos-prop (- (point) (- (current-column) wdired-col-perm))))
 819         (put-text-property 0 1 'keymap wdired-perm-mode-map new-bit)
 820         (put-text-property 0 1 'read-only t new-bit)
 821         (insert new-bit)
 822         (delete-char 1)
 823         (put-text-property (1- pos-prop) pos-prop 'perm-changed t)
 824         (put-text-property (1- (point)) (point) 'rear-nonsticky '(keymap)))
 825     (forward-char 1)))
 826
 827 (defun wdired-toggle-bit ()
 828   "Toggle the permission bit at point."
 829   (interactive)
 830   (let ((inhibit-read-only t)
 831         (new-bit "-")
 832         (pos-prop (- (point) (- (current-column) wdired-col-perm))))
 833     (if (eq (char-after (point)) ?-)
 834         (setq new-bit
 835               (if (= (% (- (current-column) wdired-col-perm) 3) 0) "r"
 836                 (if (= (% (- (current-column) wdired-col-perm) 3) 1) "w"
 837                   "x"))))
 838     (put-text-property 0 1 'keymap wdired-perm-mode-map new-bit)
 839     (put-text-property 0 1 'read-only t new-bit)
 840     (insert new-bit)
 841     (delete-char 1)
 842     (put-text-property (1- pos-prop) pos-prop 'perm-changed t)
 843     (put-text-property (1- (point)) (point) 'rear-nonsticky '(keymap))))
 844
 845 (defun wdired-mouse-toggle-bit (event)
 846   "Toggle the permission bit that was left clicked."
 847   (interactive "e")
 848   (mouse-set-point event)
 849   (wdired-toggle-bit))
 850
 851 ;; Allowed chars for 4000 bit are Ss  in position 3
 852 ;; Allowed chars for 2000 bit are Ssl in position 6
 853 ;; Allowed chars for 1000 bit are Tt  in position 9
 854 (defun wdired-perms-to-number (perms)
 855   (let ((nperm 0777))
 856     (if (= (elt perms 1) ?-) (setq nperm (- nperm 400)))
 857     (if (= (elt perms 2) ?-) (setq nperm (- nperm 200)))
 858     (let ((p-bit (elt perms 3)))
 859       (if (memq p-bit '(?- ?S)) (setq nperm (- nperm 100)))
 860       (if (memq p-bit '(?s ?S)) (setq nperm (+ nperm 4000))))
 861     (if (= (elt perms 4) ?-) (setq nperm (- nperm 40)))
 862     (if (= (elt perms 5) ?-) (setq nperm (- nperm 20)))
 863     (let ((p-bit (elt perms 6)))
 864       (if (memq p-bit '(?- ?S ?l)) (setq nperm (- nperm 10)))
 865       (if (memq p-bit '(?s ?S ?l)) (setq nperm (+ nperm 2000))))
 866     (if (= (elt perms 7) ?-) (setq nperm (- nperm 4)))
 867     (if (= (elt perms 8) ?-) (setq nperm (- nperm 2)))
 868     (let ((p-bit (elt perms 9)))
 869       (if (memq p-bit '(?- ?T)) (setq nperm (- nperm 1)))
 870       (if (memq p-bit '(?t ?T)) (setq nperm (+ nperm 1000))))
 871     nperm))
 872
 873 ;; Perform the changes in the permissions of the files that have
 874 ;; changed.
 875 (defun wdired-do-perm-changes ()
 876   (let ((changes nil)
 877         (errors 0)
 878         (prop-wanted (if (eq wdired-allow-to-change-permissions 'advanced)
 879                          'old-perm 'perm-changed))
 880         filename perms-ori perms-new perm-tmp)
 881     (goto-char (next-single-property-change (point-min) prop-wanted
 882                                             nil (point-max)))
 883     (while (not (eobp))
 884       (setq perms-ori (get-text-property (point) 'old-perm))
 885       (setq perms-new (buffer-substring-no-properties
 886                        (point) (next-single-property-change (point) 'end-perm)))
 887       (unless (equal perms-ori perms-new)
 888         (setq changes t)
 889         (setq filename (wdired-get-filename nil t))
 890         (if (= (length perms-new) 10)
 891             (progn
 892               (setq perm-tmp
 893                     (int-to-string (wdired-perms-to-number perms-new)))
 894               (unless (equal 0 (process-file dired-chmod-program
 895                                              nil nil nil perm-tmp filename))
 896                 (setq errors (1+ errors))
 897                 (dired-log "%s %s `%s' failed\n\n"
 898                            dired-chmod-program perm-tmp filename)))
 899           (setq errors (1+ errors))
 900           (dired-log "Cannot parse permission `%s' for file `%s'\n\n"
 901                      perms-new filename)))
 902       (goto-char (next-single-property-change (1+ (point)) prop-wanted
 903                                               nil (point-max))))
 904     (cons changes errors)))
 905
 906 (provide 'wdired)
 907
 908 ;; Local Variables:
 909 ;; byte-compile-dynamic: t
 910 ;; End:
 911
 912 ;;; wdired.el ends here