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