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