diff options
| author | Stefan Monnier | 2006-02-07 17:30:10 +0000 |
|---|---|---|
| committer | Stefan Monnier | 2006-02-07 17:30:10 +0000 |
| commit | d4f2cc777b8868ada9dfc325166840b1f81c1caa (patch) | |
| tree | 796c6efad2464bfe843ef61598c71691d0da3917 | |
| parent | 464540ed828c1fa14a5a88125820b16de68302a6 (diff) | |
| download | emacs-d4f2cc777b8868ada9dfc325166840b1f81c1caa.tar.gz emacs-d4f2cc777b8868ada9dfc325166840b1f81c1caa.zip | |
(wdired-mode-map): Use remap.
(wdired-get-filename): Massage.
(wdired-perm-mode-map): Don't copy bindings from wdired-mode-map.
(wdired-preprocess-perms, wdired-set-bit, wdired-toggle-bit): Use the
`keymap' property rather than `local-map'.
| -rw-r--r-- | lisp/ChangeLog | 8 | ||||
| -rw-r--r-- | lisp/wdired.el | 268 |
2 files changed, 140 insertions, 136 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 33325719ba9..b21f4333db8 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,11 @@ | |||
| 1 | 2006-02-07 +00 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | * wdired.el (wdired-mode-map): Use remap. | ||
| 4 | (wdired-get-filename): Massage. | ||
| 5 | (wdired-perm-mode-map): Don't copy bindings from wdired-mode-map. | ||
| 6 | (wdired-preprocess-perms, wdired-set-bit, wdired-toggle-bit): Use the | ||
| 7 | `keymap' property rather than `local-map'. | ||
| 8 | |||
| 1 | 2006-02-07 Mathias Dahl <brakjoller@hotmail.com> | 9 | 2006-02-07 Mathias Dahl <brakjoller@hotmail.com> |
| 2 | 10 | ||
| 3 | * tumme.el (tumme-get-thumbnail-image): New utility function. | 11 | * tumme.el (tumme-get-thumbnail-image): New utility function. |
diff --git a/lisp/wdired.el b/lisp/wdired.el index 062706ec7dc..2471ab909c6 100644 --- a/lisp/wdired.el +++ b/lisp/wdired.el | |||
| @@ -30,10 +30,10 @@ | |||
| 30 | ;; renaming files. | 30 | ;; renaming files. |
| 31 | ;; | 31 | ;; |
| 32 | ;; Have you ever wished to use C-x r t (string-rectangle), M-% | 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 | 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 | 34 | ;; the files in a "dired" buffer? Now you can do this. All the power |
| 35 | ;; of Emacs commands are available to renaming files! | 35 | ;; of Emacs commands are available to renaming files! |
| 36 | ;; | 36 | ;; |
| 37 | ;; This package provides a function that makes the filenames of a a | 37 | ;; This package provides a function that makes the filenames of a a |
| 38 | ;; dired buffer editable, by changing the buffer mode (which inhibits | 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 | 39 | ;; all of the commands of dired mode). Here you can edit the names of |
| @@ -102,20 +102,17 @@ | |||
| 102 | ;;; Code: | 102 | ;;; Code: |
| 103 | 103 | ||
| 104 | (defvar dired-backup-overwrite) ; Only in Emacs 20.x this is a custom var | 104 | (defvar dired-backup-overwrite) ; Only in Emacs 20.x this is a custom var |
| 105 | (eval-when-compile | ||
| 106 | (set (make-local-variable 'byte-compile-dynamic) t)) | ||
| 107 | 105 | ||
| 108 | (eval-and-compile | 106 | (require 'dired) |
| 109 | (require 'dired) | 107 | (autoload 'dired-do-create-files-regexp "dired-aux") |
| 110 | (autoload 'dired-do-create-files-regexp "dired-aux") | 108 | (autoload 'dired-call-process "dired-aux") |
| 111 | (autoload 'dired-call-process "dired-aux")) | ||
| 112 | 109 | ||
| 113 | (defgroup wdired nil | 110 | (defgroup wdired nil |
| 114 | "Mode to rename files by editing their names in dired buffers." | 111 | "Mode to rename files by editing their names in dired buffers." |
| 115 | :group 'dired) | 112 | :group 'dired) |
| 116 | 113 | ||
| 117 | (defcustom wdired-use-interactive-rename nil | 114 | (defcustom wdired-use-interactive-rename nil |
| 118 | "*If non-nil, WDired requires confirmation before actually renaming files. | 115 | "If non-nil, WDired requires confirmation before actually renaming files. |
| 119 | If nil, WDired doesn't require confirmation to change the file names, | 116 | If nil, WDired doesn't require confirmation to change the file names, |
| 120 | and the variable `wdired-confirm-overwrite' controls whether it is ok | 117 | and the variable `wdired-confirm-overwrite' controls whether it is ok |
| 121 | to overwrite files without asking." | 118 | to overwrite files without asking." |
| @@ -123,14 +120,14 @@ to overwrite files without asking." | |||
| 123 | :group 'wdired) | 120 | :group 'wdired) |
| 124 | 121 | ||
| 125 | (defcustom wdired-confirm-overwrite t | 122 | (defcustom wdired-confirm-overwrite t |
| 126 | "*If nil the renames can overwrite files without asking. | 123 | "If nil the renames can overwrite files without asking. |
| 127 | This variable has no effect at all if `wdired-use-interactive-rename' | 124 | This variable has no effect at all if `wdired-use-interactive-rename' |
| 128 | is not nil." | 125 | is not nil." |
| 129 | :type 'boolean | 126 | :type 'boolean |
| 130 | :group 'wdired) | 127 | :group 'wdired) |
| 131 | 128 | ||
| 132 | (defcustom wdired-use-dired-vertical-movement nil | 129 | (defcustom wdired-use-dired-vertical-movement nil |
| 133 | "*If t, the \"up\" and \"down\" movement works as in Dired mode. | 130 | "If t, the \"up\" and \"down\" movement works as in Dired mode. |
| 134 | That is, always move the point to the beginning of the filename at line. | 131 | That is, always move the point to the beginning of the filename at line. |
| 135 | 132 | ||
| 136 | If `sometimes, only move to the beginning of filename if the point is | 133 | If `sometimes, only move to the beginning of filename if the point is |
| @@ -144,14 +141,14 @@ If nil, \"up\" and \"down\" movement is done as in any other buffer." | |||
| 144 | :group 'wdired) | 141 | :group 'wdired) |
| 145 | 142 | ||
| 146 | (defcustom wdired-allow-to-redirect-links t | 143 | (defcustom wdired-allow-to-redirect-links t |
| 147 | "*If non-nil, the target of the symbolic links are editable. | 144 | "If non-nil, the target of the symbolic links are editable. |
| 148 | In systems without symbolic links support, this variable has no effect | 145 | In systems without symbolic links support, this variable has no effect |
| 149 | at all." | 146 | at all." |
| 150 | :type 'boolean | 147 | :type 'boolean |
| 151 | :group 'wdired) | 148 | :group 'wdired) |
| 152 | 149 | ||
| 153 | (defcustom wdired-allow-to-change-permissions nil | 150 | (defcustom wdired-allow-to-change-permissions nil |
| 154 | "*If non-nil, the permissions bits of the files are editable. | 151 | "If non-nil, the permissions bits of the files are editable. |
| 155 | 152 | ||
| 156 | If t, to change a single bit, put the cursor over it and press the | 153 | If t, to change a single bit, put the cursor over it and press the |
| 157 | space bar, or left click over it. You can also hit the letter you want | 154 | space bar, or left click over it. You can also hit the letter you want |
| @@ -197,13 +194,11 @@ program `dired-chmod-program', which must exist." | |||
| 197 | :help "Abort changes and return to dired mode")) | 194 | :help "Abort changes and return to dired mode")) |
| 198 | (define-key map [menu-bar wdired wdired-finish-edit] | 195 | (define-key map [menu-bar wdired wdired-finish-edit] |
| 199 | '("Commit Changes" . wdired-finish-edit)) | 196 | '("Commit Changes" . wdired-finish-edit)) |
| 200 | ;; FIXME: Use the new remap trick. | 197 | |
| 201 | (substitute-key-definition 'upcase-word 'wdired-upcase-word | 198 | (define-key map [remap upcase-word] 'wdired-upcase-word) |
| 202 | map global-map) | 199 | (define-key map [remap capitalize-word] 'wdired-capitalize-word) |
| 203 | (substitute-key-definition 'capitalize-word 'wdired-capitalize-word | 200 | (define-key map [remap downcase-word] 'wdired-downcase-word) |
| 204 | map global-map) | 201 | |
| 205 | (substitute-key-definition 'downcase-word 'wdired-downcase-word | ||
| 206 | map global-map) | ||
| 207 | map)) | 202 | map)) |
| 208 | 203 | ||
| 209 | (defvar wdired-mode-hook nil | 204 | (defvar wdired-mode-hook nil |
| @@ -314,21 +309,20 @@ relies on WDired buffer's properties. Optional arg NO-DIR with value | |||
| 314 | non-nil means don't include directory. Optional arg OLD with value | 309 | non-nil means don't include directory. Optional arg OLD with value |
| 315 | non-nil means return old filename." | 310 | non-nil means return old filename." |
| 316 | ;; FIXME: Use dired-get-filename's new properties. | 311 | ;; FIXME: Use dired-get-filename's new properties. |
| 317 | (let (beg end file) | 312 | (let* ((end (line-end-position)) |
| 318 | (save-excursion | 313 | (beg (next-single-property-change |
| 319 | (setq end (progn (end-of-line) (point))) | 314 | (line-beginning-position) 'old-name nil end))) |
| 320 | (beginning-of-line) | 315 | (unless (eq beg end) |
| 321 | (setq beg (next-single-property-change (point) 'old-name nil end)) | 316 | (let ((file |
| 322 | (unless (eq beg end) | 317 | (if old |
| 323 | (if old | 318 | (get-text-property beg 'old-name) |
| 324 | (setq file (get-text-property beg 'old-name)) | 319 | (wdired-normalize-filename |
| 325 | (setq end (next-single-property-change (1+ beg) 'end-name)) | 320 | (buffer-substring-no-properties |
| 326 | (setq file (buffer-substring-no-properties (+ 2 beg) end)) | 321 | (+ 2 beg) (next-single-property-change (1+ beg) 'end-name)))))) |
| 327 | (and file (setq file (wdired-normalize-filename file))))) | 322 | (if (or no-dir old) |
| 328 | (if (or no-dir old) | 323 | file |
| 329 | file | 324 | (and file (> (length file) 0) |
| 330 | (and file (> (length file) 0) | 325 | (concat (dired-current-directory) file))))))) |
| 331 | (concat (dired-current-directory) file)))))) | ||
| 332 | 326 | ||
| 333 | 327 | ||
| 334 | (defun wdired-change-to-dired-mode () | 328 | (defun wdired-change-to-dired-mode () |
| @@ -344,7 +338,7 @@ non-nil means return old filename." | |||
| 344 | (setq mode-name "Dired") | 338 | (setq mode-name "Dired") |
| 345 | (dired-advertise) | 339 | (dired-advertise) |
| 346 | (remove-hook 'kill-buffer-hook 'wdired-check-kill-buffer t) | 340 | (remove-hook 'kill-buffer-hook 'wdired-check-kill-buffer t) |
| 347 | (setq revert-buffer-function 'dired-revert)) | 341 | (set (make-local-variable 'revert-buffer-function) 'dired-revert)) |
| 348 | 342 | ||
| 349 | 343 | ||
| 350 | (defun wdired-abort-changes () | 344 | (defun wdired-abort-changes () |
| @@ -412,7 +406,7 @@ non-nil means return old filename." | |||
| 412 | (forward-line -1))) | 406 | (forward-line -1))) |
| 413 | (if changes | 407 | (if changes |
| 414 | (revert-buffer) ;The "revert" is necessary to re-sort the buffer | 408 | (revert-buffer) ;The "revert" is necessary to re-sort the buffer |
| 415 | (let ((buffer-read-only nil)) | 409 | (let ((inhibit-read-only t)) |
| 416 | (remove-text-properties (point-min) (point-max) | 410 | (remove-text-properties (point-min) (point-max) |
| 417 | '(old-name nil end-name nil old-link nil | 411 | '(old-name nil end-name nil old-link nil |
| 418 | end-link nil end-perm nil | 412 | end-link nil end-perm nil |
| @@ -425,9 +419,9 @@ non-nil means return old filename." | |||
| 425 | (set-buffer-modified-p nil) | 419 | (set-buffer-modified-p nil) |
| 426 | (setq buffer-undo-list nil)) | 420 | (setq buffer-undo-list nil)) |
| 427 | 421 | ||
| 428 | ;; Renames a file, searching it in a modified dired buffer, in order | 422 | ;; Rename a file, searching it in a modified dired buffer, in order |
| 429 | ;; to be able to use `dired-do-create-files-regexp' and get its | 423 | ;; to be able to use `dired-do-create-files-regexp' and get its |
| 430 | ;; "benefits" | 424 | ;; "benefits". |
| 431 | (defun wdired-search-and-rename (filename-ori filename-new) | 425 | (defun wdired-search-and-rename (filename-ori filename-new) |
| 432 | (save-excursion | 426 | (save-excursion |
| 433 | (goto-char (point-max)) | 427 | (goto-char (point-max)) |
| @@ -528,21 +522,18 @@ says how many lines to move; default is one line." | |||
| 528 | (defun wdired-get-previous-link (&optional old move) | 522 | (defun wdired-get-previous-link (&optional old move) |
| 529 | "Return the next symlink target. | 523 | "Return the next symlink target. |
| 530 | If OLD, return the old target. If MOVE, move point before it." | 524 | If OLD, return the old target. If MOVE, move point before it." |
| 531 | (let (beg end target) | 525 | (let ((beg (previous-single-property-change (point) 'old-link nil))) |
| 532 | (setq beg (previous-single-property-change (point) 'old-link nil)) | 526 | (when beg |
| 533 | (if beg | 527 | (let ((target |
| 534 | (progn | 528 | (if old |
| 535 | (if old | 529 | (get-text-property (1- beg) 'old-link) |
| 536 | (setq target (get-text-property (1- beg) 'old-link)) | 530 | (buffer-substring-no-properties |
| 537 | (setq end (next-single-property-change beg 'end-link)) | 531 | (1+ beg) (next-single-property-change beg 'end-link))))) |
| 538 | (setq target (buffer-substring-no-properties (1+ beg) end))) | 532 | (if move (goto-char (1- beg))) |
| 539 | (if move (goto-char (1- beg))))) | 533 | (and target (wdired-normalize-filename target)))))) |
| 540 | (and target (wdired-normalize-filename target)))) | ||
| 541 | |||
| 542 | |||
| 543 | 534 | ||
| 544 | ;; Perform the changes in the target of the changed links. | 535 | ;; Perform the changes in the target of the changed links. |
| 545 | (defun wdired-do-symlink-changes() | 536 | (defun wdired-do-symlink-changes () |
| 546 | (let ((changes nil) | 537 | (let ((changes nil) |
| 547 | (errors 0) | 538 | (errors 0) |
| 548 | link-to-ori link-to-new link-from) | 539 | link-to-ori link-to-new link-from) |
| @@ -550,36 +541,34 @@ If OLD, return the old target. If MOVE, move point before it." | |||
| 550 | (while (setq link-to-new (wdired-get-previous-link)) | 541 | (while (setq link-to-new (wdired-get-previous-link)) |
| 551 | (setq link-to-ori (wdired-get-previous-link t t)) | 542 | (setq link-to-ori (wdired-get-previous-link t t)) |
| 552 | (setq link-from (wdired-get-filename nil t)) | 543 | (setq link-from (wdired-get-filename nil t)) |
| 553 | (if (not (equal link-to-new link-to-ori)) | 544 | (unless (equal link-to-new link-to-ori) |
| 554 | (progn | 545 | (setq changes t) |
| 555 | (setq changes t) | 546 | (if (equal link-to-new "") ;empty filename! |
| 556 | (if (equal link-to-new "") ;empty filename! | 547 | (setq link-to-new "/dev/null")) |
| 557 | (setq link-to-new "/dev/null")) | 548 | (condition-case err |
| 558 | (condition-case err | 549 | (progn |
| 559 | (progn | 550 | (delete-file link-from) |
| 560 | (delete-file link-from) | 551 | (make-symbolic-link |
| 561 | (make-symbolic-link | 552 | (substitute-in-file-name link-to-new) link-from)) |
| 562 | (substitute-in-file-name link-to-new) link-from)) | 553 | (error |
| 563 | (error | 554 | (setq errors (1+ errors)) |
| 564 | (setq errors (1+ errors)) | 555 | (dired-log (concat "Link `" link-from "' to `" |
| 565 | (dired-log (concat "Link `" link-from "' to `" | 556 | link-to-new "' failed:\n%s\n") |
| 566 | link-to-new "' failed:\n%s\n") | 557 | err))))) |
| 567 | err)))))) | ||
| 568 | (cons changes errors))) | 558 | (cons changes errors))) |
| 569 | 559 | ||
| 570 | ;; Perform a "case command" skipping read-only words. | 560 | ;; Perform a "case command" skipping read-only words. |
| 571 | (defun wdired-xcase-word (command arg) | 561 | (defun wdired-xcase-word (command arg) |
| 572 | (if (< arg 0) | 562 | (if (< arg 0) |
| 573 | (funcall command arg) | 563 | (funcall command arg) |
| 574 | (progn | 564 | (while (> arg 0) |
| 575 | (while (> arg 0) | 565 | (condition-case err |
| 576 | (condition-case err | 566 | (progn |
| 577 | (progn | 567 | (funcall command 1) |
| 578 | (funcall command 1) | 568 | (setq arg (1- arg))) |
| 579 | (setq arg (1- arg))) | 569 | (error |
| 580 | (error | 570 | (if (not (forward-word 1)) |
| 581 | (if (not (forward-word 1)) | 571 | (setq arg 0))))))) |
| 582 | (setq arg 0)))))))) | ||
| 583 | 572 | ||
| 584 | (defun wdired-downcase-word (arg) | 573 | (defun wdired-downcase-word (arg) |
| 585 | "WDired version of `downcase-word'. | 574 | "WDired version of `downcase-word'. |
| @@ -603,25 +592,25 @@ Like original function but it skips read-only words." | |||
| 603 | ;; The following code deals with changing the access bits (or | 592 | ;; The following code deals with changing the access bits (or |
| 604 | ;; permissions) of the files. | 593 | ;; permissions) of the files. |
| 605 | 594 | ||
| 606 | (defvar wdired-perm-mode-map nil) | 595 | (defvar wdired-perm-mode-map |
| 607 | (unless wdired-perm-mode-map | 596 | (let ((map (make-sparse-keymap))) |
| 608 | (setq wdired-perm-mode-map (copy-keymap wdired-mode-map)) | 597 | (define-key map " " 'wdired-toggle-bit) |
| 609 | (define-key wdired-perm-mode-map " " 'wdired-toggle-bit) | 598 | (define-key map "r" 'wdired-set-bit) |
| 610 | (define-key wdired-perm-mode-map "r" 'wdired-set-bit) | 599 | (define-key map "w" 'wdired-set-bit) |
| 611 | (define-key wdired-perm-mode-map "w" 'wdired-set-bit) | 600 | (define-key map "x" 'wdired-set-bit) |
| 612 | (define-key wdired-perm-mode-map "x" 'wdired-set-bit) | 601 | (define-key map "-" 'wdired-set-bit) |
| 613 | (define-key wdired-perm-mode-map "-" 'wdired-set-bit) | 602 | (define-key map "S" 'wdired-set-bit) |
| 614 | (define-key wdired-perm-mode-map "S" 'wdired-set-bit) | 603 | (define-key map "s" 'wdired-set-bit) |
| 615 | (define-key wdired-perm-mode-map "s" 'wdired-set-bit) | 604 | (define-key map "T" 'wdired-set-bit) |
| 616 | (define-key wdired-perm-mode-map "T" 'wdired-set-bit) | 605 | (define-key map "t" 'wdired-set-bit) |
| 617 | (define-key wdired-perm-mode-map "t" 'wdired-set-bit) | 606 | (define-key map "s" 'wdired-set-bit) |
| 618 | (define-key wdired-perm-mode-map "s" 'wdired-set-bit) | 607 | (define-key map "l" 'wdired-set-bit) |
| 619 | (define-key wdired-perm-mode-map "l" 'wdired-set-bit) | 608 | (define-key map [down-mouse-1] 'wdired-mouse-toggle-bit) |
| 620 | (define-key wdired-perm-mode-map [down-mouse-1] 'wdired-mouse-toggle-bit)) | 609 | map)) |
| 621 | 610 | ||
| 622 | ;; Put a local-map to the permission bits of the files, and store the | 611 | ;; Put a local-map to the permission bits of the files, and store the |
| 623 | ;; original name and permissions as a property | 612 | ;; original name and permissions as a property |
| 624 | (defun wdired-preprocess-perms() | 613 | (defun wdired-preprocess-perms () |
| 625 | (let ((inhibit-read-only t) | 614 | (let ((inhibit-read-only t) |
| 626 | filename) | 615 | filename) |
| 627 | (set (make-local-variable 'wdired-col-perm) nil) | 616 | (set (make-local-variable 'wdired-col-perm) nil) |
| @@ -638,7 +627,7 @@ Like original function but it skips read-only words." | |||
| 638 | (put-text-property (match-beginning 0) (match-end 0) | 627 | (put-text-property (match-beginning 0) (match-end 0) |
| 639 | 'read-only nil) | 628 | 'read-only nil) |
| 640 | (put-text-property (1+ (match-beginning 0)) (match-end 0) | 629 | (put-text-property (1+ (match-beginning 0)) (match-end 0) |
| 641 | 'local-map wdired-perm-mode-map)) | 630 | 'keymap wdired-perm-mode-map)) |
| 642 | (put-text-property (match-end 0) (1+ (match-end 0)) 'end-perm t) | 631 | (put-text-property (match-end 0) (1+ (match-end 0)) 'end-perm t) |
| 643 | (put-text-property (match-beginning 0) (1+ (match-beginning 0)) | 632 | (put-text-property (match-beginning 0) (1+ (match-beginning 0)) |
| 644 | 'old-perm (match-string-no-properties 0)))) | 633 | 'old-perm (match-string-no-properties 0)))) |
| @@ -663,25 +652,24 @@ Like original function but it skips read-only words." | |||
| 663 | (let ((new-bit (char-to-string last-command-char)) | 652 | (let ((new-bit (char-to-string last-command-char)) |
| 664 | (inhibit-read-only t) | 653 | (inhibit-read-only t) |
| 665 | (pos-prop (- (point) (- (current-column) wdired-col-perm)))) | 654 | (pos-prop (- (point) (- (current-column) wdired-col-perm)))) |
| 666 | (put-text-property 0 1 'local-map wdired-perm-mode-map new-bit) | 655 | (put-text-property 0 1 'keymap wdired-perm-mode-map new-bit) |
| 667 | (put-text-property 0 1 'read-only t new-bit) | 656 | (put-text-property 0 1 'read-only t new-bit) |
| 668 | (insert new-bit) | 657 | (insert new-bit) |
| 669 | (delete-char 1) | 658 | (delete-char 1) |
| 670 | (put-text-property pos-prop (1- pos-prop) 'perm-changed t)) | 659 | (put-text-property pos-prop (1- pos-prop) 'perm-changed t)) |
| 671 | (forward-char 1))) | 660 | (forward-char 1))) |
| 672 | 661 | ||
| 673 | (defun wdired-toggle-bit() | 662 | (defun wdired-toggle-bit () |
| 674 | "Toggle the permission bit at point." | 663 | "Toggle the permission bit at point." |
| 675 | (interactive) | 664 | (interactive) |
| 676 | (let ((inhibit-read-only t) | 665 | (let ((inhibit-read-only t) |
| 677 | (new-bit "-") | 666 | (new-bit (cond |
| 667 | ((not (eq (char-after (point)) ?-)) "-") | ||
| 668 | ((= (% (- (current-column) wdired-col-perm) 3) 0) "r") | ||
| 669 | ((= (% (- (current-column) wdired-col-perm) 3) 1) "w") | ||
| 670 | (t "x"))) | ||
| 678 | (pos-prop (- (point) (- (current-column) wdired-col-perm)))) | 671 | (pos-prop (- (point) (- (current-column) wdired-col-perm)))) |
| 679 | (if (eq (char-after (point)) ?-) | 672 | (put-text-property 0 1 'keymap wdired-perm-mode-map new-bit) |
| 680 | (setq new-bit | ||
| 681 | (if (= (% (- (current-column) wdired-col-perm) 3) 0) "r" | ||
| 682 | (if (= (% (- (current-column) wdired-col-perm) 3) 1) "w" | ||
| 683 | "x")))) | ||
| 684 | (put-text-property 0 1 'local-map wdired-perm-mode-map new-bit) | ||
| 685 | (put-text-property 0 1 'read-only t new-bit) | 673 | (put-text-property 0 1 'read-only t new-bit) |
| 686 | (insert new-bit) | 674 | (insert new-bit) |
| 687 | (delete-char 1) | 675 | (delete-char 1) |
| @@ -697,23 +685,28 @@ Like original function but it skips read-only words." | |||
| 697 | ;; Allowed chars for 2000 bit are Ssl in position 6 | 685 | ;; Allowed chars for 2000 bit are Ssl in position 6 |
| 698 | ;; Allowed chars for 1000 bit are Tt in position 9 | 686 | ;; Allowed chars for 1000 bit are Tt in position 9 |
| 699 | (defun wdired-perms-to-number (perms) | 687 | (defun wdired-perms-to-number (perms) |
| 700 | (let ((nperm 0777)) | 688 | (+ |
| 701 | (if (= (elt perms 1) ?-) (setq nperm (- nperm 400))) | 689 | (if (= (elt perms 1) ?-) 0 400) |
| 702 | (if (= (elt perms 2) ?-) (setq nperm (- nperm 200))) | 690 | (if (= (elt perms 2) ?-) 0 200) |
| 703 | (let ((p-bit (elt perms 3))) | 691 | (case (elt perms 3) |
| 704 | (if (memq p-bit '(?- ?S)) (setq nperm (- nperm 100))) | 692 | (?- 0) |
| 705 | (if (memq p-bit '(?s ?S)) (setq nperm (+ nperm 4000)))) | 693 | (?S 4000) |
| 706 | (if (= (elt perms 4) ?-) (setq nperm (- nperm 40))) | 694 | (?s 4100) |
| 707 | (if (= (elt perms 5) ?-) (setq nperm (- nperm 20))) | 695 | (t 100)) |
| 708 | (let ((p-bit (elt perms 6))) | 696 | (if (= (elt perms 4) ?-) 0 40) |
| 709 | (if (memq p-bit '(?- ?S ?l)) (setq nperm (- nperm 10))) | 697 | (if (= (elt perms 5) ?-) 0 20) |
| 710 | (if (memq p-bit '(?s ?S ?l)) (setq nperm (+ nperm 2000)))) | 698 | (case (elt perms 6) |
| 711 | (if (= (elt perms 7) ?-) (setq nperm (- nperm 4))) | 699 | (?- 0) |
| 712 | (if (= (elt perms 8) ?-) (setq nperm (- nperm 2))) | 700 | (?S 2000) |
| 713 | (let ((p-bit (elt perms 9))) | 701 | (?s 2010) |
| 714 | (if (memq p-bit '(?- ?T)) (setq nperm (- nperm 1))) | 702 | (t 10)) |
| 715 | (if (memq p-bit '(?t ?T)) (setq nperm (+ nperm 1000)))) | 703 | (if (= (elt perms 7) ?-) 0 4) |
| 716 | nperm)) | 704 | (if (= (elt perms 8) ?-) 0 2) |
| 705 | (case (elt perms 9) | ||
| 706 | (?- 0) | ||
| 707 | (?T 1000) | ||
| 708 | (?t 1001) | ||
| 709 | (t 1)))) | ||
| 717 | 710 | ||
| 718 | ;; Perform the changes in the permissions of the files that have | 711 | ;; Perform the changes in the permissions of the files that have |
| 719 | ;; changed. | 712 | ;; changed. |
| @@ -729,28 +722,31 @@ Like original function but it skips read-only words." | |||
| 729 | (setq perms-ori (get-text-property (point) 'old-perm)) | 722 | (setq perms-ori (get-text-property (point) 'old-perm)) |
| 730 | (setq perms-new (buffer-substring-no-properties | 723 | (setq perms-new (buffer-substring-no-properties |
| 731 | (point) (next-single-property-change (point) 'end-perm))) | 724 | (point) (next-single-property-change (point) 'end-perm))) |
| 732 | (if (not (equal perms-ori perms-new)) | 725 | (unless (equal perms-ori perms-new) |
| 733 | (progn | 726 | (setq changes t) |
| 734 | (setq changes t) | 727 | (setq filename (wdired-get-filename nil t)) |
| 735 | (setq filename (wdired-get-filename nil t)) | 728 | (if (= (length perms-new) 10) |
| 736 | (if (= (length perms-new) 10) | 729 | (progn |
| 737 | (progn | 730 | (setq perm-tmp |
| 738 | (setq perm-tmp | 731 | (int-to-string (wdired-perms-to-number perms-new))) |
| 739 | (int-to-string (wdired-perms-to-number perms-new))) | 732 | (unless (equal 0 (dired-call-process dired-chmod-program |
| 740 | (if (not (equal 0 (dired-call-process dired-chmod-program | 733 | t perm-tmp filename)) |
| 741 | t perm-tmp filename))) | 734 | (setq errors (1+ errors)) |
| 742 | (progn | 735 | (dired-log (concat dired-chmod-program " " perm-tmp |
| 743 | (setq errors (1+ errors)) | 736 | " `" filename "' failed\n\n")))) |
| 744 | (dired-log (concat dired-chmod-program " " perm-tmp | 737 | (setq errors (1+ errors)) |
| 745 | " `" filename "' failed\n\n"))))) | 738 | (dired-log (concat "Cannot parse permission `" perms-new |
| 746 | (setq errors (1+ errors)) | 739 | "' for file `" filename "'\n\n")))) |
| 747 | (dired-log (concat "Cannot parse permission `" perms-new | ||
| 748 | "' for file `" filename "'\n\n"))))) | ||
| 749 | (goto-char (next-single-property-change (1+ (point)) prop-wanted | 740 | (goto-char (next-single-property-change (1+ (point)) prop-wanted |
| 750 | nil (point-max)))) | 741 | nil (point-max)))) |
| 751 | (cons changes errors))) | 742 | (cons changes errors))) |
| 752 | 743 | ||
| 753 | (provide 'wdired) | 744 | (provide 'wdired) |
| 754 | 745 | ||
| 746 | ;; Local Variables: | ||
| 747 | ;; coding: latin-1 | ||
| 748 | ;; byte-compile-dynamic: t | ||
| 749 | ;; End: | ||
| 750 | |||
| 755 | ;; arch-tag: bc00902e-526f-4305-bc7f-8862a559184f | 751 | ;; arch-tag: bc00902e-526f-4305-bc7f-8862a559184f |
| 756 | ;;; wdired.el ends here | 752 | ;;; wdired.el ends here |