X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/24444a7a6e0576341d1a48425f83c53ee8c697f6..5a0c3f568d38c4778b5cab6140aa8e46c2523f22:/lisp/wdired.el diff --git a/lisp/wdired.el b/lisp/wdired.el index a82176af5e..1c5ac2f23c 100644 --- a/lisp/wdired.el +++ b/lisp/wdired.el @@ -1,6 +1,7 @@ ;;; wdired.el --- Rename files editing their names in dired buffers -;; Copyright (C) 2001, 2004, 2005 Free Software Foundation, Inc. +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009 +;; Free Software Foundation, Inc. ;; Filename: wdired.el ;; Author: Juan León Lahoz García @@ -9,20 +10,18 @@ ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2, or (at -;; your option) any later version. +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. -;; This program is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -30,10 +29,10 @@ ;; renaming files. ;; ;; Have you ever wished to use C-x r t (string-rectangle), M-% -;; (query-replace), M-c (capitalize-word), etc. to change the name of +;; (query-replace), M-c (capitalize-word), etc... to change the name of ;; the files in a "dired" buffer? Now you can do this. All the power ;; of Emacs commands are available to renaming files! -;; +;; ;; This package provides a function that makes the filenames of a a ;; dired buffer editable, by changing the buffer mode (which inhibits ;; all of the commands of dired mode). Here you can edit the names of @@ -102,20 +101,17 @@ ;;; Code: (defvar dired-backup-overwrite) ; Only in Emacs 20.x this is a custom var -(eval-when-compile - (set (make-local-variable 'byte-compile-dynamic) t)) -(eval-and-compile - (require 'dired) - (autoload 'dired-do-create-files-regexp "dired-aux") - (autoload 'dired-call-process "dired-aux")) +(eval-when-compile (require 'cl)) +(require 'dired) +(autoload 'dired-do-create-files-regexp "dired-aux") (defgroup wdired nil "Mode to rename files by editing their names in dired buffers." :group 'dired) (defcustom wdired-use-interactive-rename nil - "*If non-nil, WDired requires confirmation before actually renaming files. + "If non-nil, WDired requires confirmation before actually renaming files. If nil, WDired doesn't require confirmation to change the file names, and the variable `wdired-confirm-overwrite' controls whether it is ok to overwrite files without asking." @@ -123,18 +119,18 @@ to overwrite files without asking." :group 'wdired) (defcustom wdired-confirm-overwrite t - "*If nil the renames can overwrite files without asking. + "If nil the renames can overwrite files without asking. This variable has no effect at all if `wdired-use-interactive-rename' is not nil." :type 'boolean :group 'wdired) (defcustom wdired-use-dired-vertical-movement nil - "*If t, the \"up\" and \"down\" movement works as in Dired mode. + "If t, the \"up\" and \"down\" movement works as in Dired mode. That is, always move the point to the beginning of the filename at line. -If `sometimes, only move to the beginning of filename if the point is -before it, and `track-eol' is honored. This behavior is very handy +If `sometimes', only move to the beginning of filename if the point is +before it, and `track-eol' is non-nil. This behavior is very handy when editing several filenames. If nil, \"up\" and \"down\" movement is done as in any other buffer." @@ -144,14 +140,14 @@ If nil, \"up\" and \"down\" movement is done as in any other buffer." :group 'wdired) (defcustom wdired-allow-to-redirect-links t - "*If non-nil, the target of the symbolic links are editable. + "If non-nil, the target of the symbolic links are editable. In systems without symbolic links support, this variable has no effect at all." :type 'boolean :group 'wdired) (defcustom wdired-allow-to-change-permissions nil - "*If non-nil, the permissions bits of the files are editable. + "If non-nil, the permissions bits of the files are editable. If t, to change a single bit, put the cursor over it and press the space bar, or left click over it. You can also hit the letter you want @@ -160,7 +156,7 @@ changed. Anyway, the point is advanced one position, so, for example, you can keep the key pressed to give execution permissions to everybody to that file. -If `advanced, the bits are freely editable. You can use +If `advanced', the bits are freely editable. You can use `string-rectangle', `query-replace', etc. You can put any value (even newlines), but if you want your changes to be useful, you better put a intelligible value. @@ -178,6 +174,7 @@ program `dired-chmod-program', which must exist." (define-key map "\C-c\C-c" 'wdired-finish-edit) (define-key map "\C-c\C-k" 'wdired-abort-changes) (define-key map "\C-c\C-[" 'wdired-abort-changes) + (define-key map "\C-x\C-q" 'wdired-exit) (define-key map "\C-m" 'ignore) (define-key map "\C-j" 'ignore) (define-key map "\C-o" 'ignore) @@ -193,16 +190,15 @@ program `dired-chmod-program', which must exist." (define-key map [menu-bar wdired dashes] '("--")) (define-key map [menu-bar wdired wdired-abort-changes] - '("Abort Changes" . wdired-abort-changes)) + '(menu-item "Abort Changes" wdired-abort-changes + :help "Abort changes and return to dired mode")) (define-key map [menu-bar wdired wdired-finish-edit] '("Commit Changes" . wdired-finish-edit)) - ;; FIXME: Use the new remap trick. - (substitute-key-definition 'upcase-word 'wdired-upcase-word - map global-map) - (substitute-key-definition 'capitalize-word 'wdired-capitalize-word - map global-map) - (substitute-key-definition 'downcase-word 'wdired-downcase-word - map global-map) + + (define-key map [remap upcase-word] 'wdired-upcase-word) + (define-key map [remap capitalize-word] 'wdired-capitalize-word) + (define-key map [remap downcase-word] 'wdired-downcase-word) + map)) (defvar wdired-mode-hook nil @@ -211,6 +207,7 @@ program `dired-chmod-program', which must exist." ;; Local variables (put here to avoid compilation gripes) (defvar wdired-col-perm) ;; Column where the permission bits start (defvar wdired-old-content) +(defvar wdired-old-point) (defun wdired-mode () @@ -240,8 +237,11 @@ in disk. See `wdired-mode'." (interactive) + (or (eq major-mode 'dired-mode) + (error "Not a Dired buffer")) (set (make-local-variable 'wdired-old-content) (buffer-substring (point-min) (point-max))) + (set (make-local-variable 'wdired-old-point) (point)) (set (make-local-variable 'query-replace-skip-read-only) t) (use-local-map wdired-mode-map) (force-mode-line-update) @@ -264,14 +264,15 @@ See `wdired-mode'." (set-buffer-modified-p nil) (setq buffer-undo-list nil) (run-mode-hooks 'wdired-mode-hook) - (message (substitute-command-keys "Press \\[wdired-finish-edit] when finished \ + (message "%s" (substitute-command-keys + "Press \\[wdired-finish-edit] when finished \ or \\[wdired-abort-changes] to abort changes"))) ;; Protect the buffer so only the filenames can be changed, and put ;; properties so filenames (old and new) can be easily found. (defun wdired-preprocess-files () - (put-text-property 1 2 'front-sticky t) + (put-text-property (point-min) (1+ (point-min))'front-sticky t) (save-excursion (goto-char (point-min)) (let ((b-protection (point)) @@ -281,10 +282,13 @@ or \\[wdired-abort-changes] to abort changes"))) (when (and filename (not (member (file-name-nondirectory filename) '("." "..")))) (dired-move-to-filename) - (put-text-property (- (point) 2) (1- (point)) 'old-name filename) - (put-text-property b-protection (1- (point)) 'read-only t) - (setq b-protection (dired-move-to-end-of-filename t))) - (put-text-property (point) (1+ (point)) 'end-name t) + ;; The rear-nonsticky property below shall ensure that text preceding + ;; the filename can't be modified. + (add-text-properties + (1- (point)) (point) `(old-name ,filename rear-nonsticky (read-only))) + (put-text-property b-protection (point) 'read-only t) + (setq b-protection (dired-move-to-end-of-filename t)) + (put-text-property (point) (1+ (point)) 'end-name t)) (forward-line)) (put-text-property b-protection (point-max) 'read-only t)))) @@ -312,14 +316,18 @@ non-nil means return old filename." ;; FIXME: Use dired-get-filename's new properties. (let (beg end file) (save-excursion - (setq end (progn (end-of-line) (point))) + (setq end (line-end-position)) (beginning-of-line) (setq beg (next-single-property-change (point) 'old-name nil end)) (unless (eq beg end) (if old (setq file (get-text-property beg 'old-name)) - (setq end (next-single-property-change (1+ beg) 'end-name)) - (setq file (buffer-substring-no-properties (+ 2 beg) end))) + ;; In the following form changed `(1+ beg)' to `beg' so that + ;; the filename end is found even when the filename is empty. + ;; Fixes error and spurious newlines when marking files for + ;; deletion. + (setq end (next-single-property-change beg 'end-name)) + (setq file (buffer-substring-no-properties (1+ beg) end))) (and file (setq file (wdired-normalize-filename file)))) (if (or no-dir old) file @@ -329,10 +337,12 @@ non-nil means return old filename." (defun wdired-change-to-dired-mode () "Change the mode back to dired." + (or (eq major-mode 'wdired-mode) + (error "Not a Wdired buffer")) (let ((inhibit-read-only t)) - (remove-text-properties (point-min) (point-max) - '(read-only nil local-map nil))) - (put-text-property 1 2 'front-sticky nil) + (remove-text-properties + (point-min) (point-max) + '(front-sticky nil rear-nonsticky nil read-only nil keymap nil))) (use-local-map dired-mode-map) (force-mode-line-update) (setq buffer-read-only t) @@ -340,7 +350,7 @@ non-nil means return old filename." (setq mode-name "Dired") (dired-advertise) (remove-hook 'kill-buffer-hook 'wdired-check-kill-buffer t) - (setq revert-buffer-function 'dired-revert)) + (set (make-local-variable 'revert-buffer-function) 'dired-revert)) (defun wdired-abort-changes () @@ -348,7 +358,8 @@ non-nil means return old filename." (interactive) (let ((inhibit-read-only t)) (erase-buffer) - (insert wdired-old-content)) + (insert wdired-old-content) + (goto-char wdired-old-point)) (wdired-change-to-dired-mode) (set-buffer-modified-p nil) (setq buffer-undo-list nil) @@ -358,83 +369,155 @@ non-nil means return old filename." "Actually rename files based on your editing in the Dired buffer." (interactive) (wdired-change-to-dired-mode) - (let ((overwrite (or (not wdired-confirm-overwrite) 1)) - (changes nil) - (files-deleted nil) + (let ((changes nil) (errors 0) - file-ori file-new tmp-value) + files-deleted + files-renamed + some-file-names-unchanged + file-old file-new tmp-value) (save-excursion - (if (and wdired-allow-to-redirect-links - (fboundp 'make-symbolic-link)) - (progn - (setq tmp-value (wdired-do-symlink-changes)) - (setq errors (cdr tmp-value)) - (setq changes (car tmp-value)))) - (if (and wdired-allow-to-change-permissions - (boundp 'wdired-col-perm)) ; could have been changed - (progn - (setq tmp-value (wdired-do-perm-changes)) - (setq errors (+ errors (cdr tmp-value))) - (setq changes (or changes (car tmp-value))))) + (when (and wdired-allow-to-redirect-links + (fboundp 'make-symbolic-link)) + (setq tmp-value (wdired-do-symlink-changes)) + (setq errors (cdr tmp-value)) + (setq changes (car tmp-value))) + (when (and wdired-allow-to-change-permissions + (boundp 'wdired-col-perm)) ; could have been changed + (setq tmp-value (wdired-do-perm-changes)) + (setq errors (+ errors (cdr tmp-value))) + (setq changes (or changes (car tmp-value)))) (goto-char (point-max)) (while (not (bobp)) - (setq file-ori (wdired-get-filename nil t)) - (if file-ori - (setq file-new (wdired-get-filename))) - (if (and file-ori (not (equal file-new file-ori))) - (progn - (setq changes t) - (if (not file-new) ;empty filename! - (setq files-deleted (cons file-ori files-deleted)) - (progn - (setq file-new (substitute-in-file-name file-new)) - (if wdired-use-interactive-rename - (wdired-search-and-rename file-ori file-new) - ;; If dired-rename-file autoloads dired-aux while - ;; dired-backup-overwrite is locally bound, - ;; dired-backup-overwrite won't be initialized. - ;; So we must ensure dired-aux is loaded. - (require 'dired-aux) - (condition-case err - (let ((dired-backup-overwrite nil)) - (dired-rename-file file-ori file-new - overwrite)) - (error - (setq errors (1+ errors)) - (dired-log (concat "Rename `" file-ori "' to `" - file-new "' failed:\n%s\n") - err)))))))) + (setq file-old (wdired-get-filename nil t)) + (when file-old + (setq file-new (wdired-get-filename)) + (if (equal file-new file-old) + (setq some-file-names-unchanged t) + (setq changes t) + (if (not file-new) ;empty filename! + (push file-old files-deleted) + (push (cons file-old (substitute-in-file-name file-new)) + files-renamed)))) (forward-line -1))) + (when files-renamed + (setq errors (+ errors (wdired-do-renames files-renamed)))) (if changes - (revert-buffer) ;The "revert" is necessary to re-sort the buffer - (let ((buffer-read-only nil)) + (progn + ;; If we are displaying a single file (rather than the + ;; contents of a directory), change dired-directory if that + ;; file was renamed. (This ought to be generalized to + ;; handle the multiple files case, but that's less trivial). + (when (and (stringp dired-directory) + (not (file-directory-p dired-directory)) + (null some-file-names-unchanged) + (= (length files-renamed) 1)) + (setq dired-directory (cdr (car files-renamed)))) + ;; Re-sort the buffer. + (revert-buffer)) + (let ((inhibit-read-only t)) (remove-text-properties (point-min) (point-max) '(old-name nil end-name nil old-link nil end-link nil end-perm nil old-perm nil perm-changed nil)) (message "(No changes to be performed)"))) - (if files-deleted - (wdired-flag-for-deletion files-deleted)) - (if (> errors 0) - (dired-log-summary (format "%d rename actions failed" errors) nil))) + (when files-deleted + (wdired-flag-for-deletion files-deleted)) + (when (> errors 0) + (dired-log-summary (format "%d rename actions failed" errors) nil))) (set-buffer-modified-p nil) (setq buffer-undo-list nil)) -;; Renames a file, searching it in a modified dired buffer, in order +(defun wdired-do-renames (renames) + "Perform RENAMES in parallel." + (let ((residue ()) + (progress nil) + (errors 0) + (overwrite (or (not wdired-confirm-overwrite) 1))) + (while (or renames + ;; We've done one round through the renames, we have found + ;; some residue, but we also made some progress, so maybe + ;; some of the residue were resolved: try again. + (prog1 (setq renames residue) + (setq progress nil) + (setq residue nil))) + (let* ((rename (pop renames)) + (file-new (cdr rename))) + (cond + ((rassoc file-new renames) + (error "Trying to rename 2 files to the same name")) + ((assoc file-new renames) + ;; Renaming to a file name that already exists but will itself be + ;; renamed as well. Let's wait until that one gets renamed. + (push rename residue)) + ((and (assoc file-new residue) + ;; Make sure the file really exists: if it doesn't it's + ;; not really a conflict. It might be a temp-file generated + ;; specifically to break a circular renaming. + (file-exists-p file-new)) + ;; Renaming to a file name that already exists, needed to be renamed, + ;; but whose renaming could not be performed right away. + (if (or progress renames) + ;; There's still a chance the conflict will be resolved. + (push rename residue) + ;; We have not made any progress and we've reached the end of + ;; the renames, so we really have a circular conflict, and we + ;; have to forcefully break the cycle. + (message "Circular renaming: using temporary file name") + (let ((tmp (make-temp-name file-new))) + (push (cons (car rename) tmp) renames) + (push (cons tmp file-new) residue)))) + (t + (setq progress t) + (let ((file-ori (car rename))) + (if wdired-use-interactive-rename + (wdired-search-and-rename file-ori file-new) + ;; If dired-rename-file autoloads dired-aux while + ;; dired-backup-overwrite is locally bound, + ;; dired-backup-overwrite won't be initialized. + ;; So we must ensure dired-aux is loaded. + (require 'dired-aux) + (condition-case err + (let ((dired-backup-overwrite nil)) + (dired-rename-file file-ori file-new + overwrite)) + (error + (setq errors (1+ errors)) + (dired-log (concat "Rename `" file-ori "' to `" + file-new "' failed:\n%s\n") + err))))))))) + errors)) + + +(defun wdired-exit () + "Exit wdired and return to dired mode. +Just return to dired mode if there are no changes. Otherwise, +ask a yes-or-no question whether to save or cancel changes, +and proceed depending on the answer." + (interactive) + (if (buffer-modified-p) + (if (y-or-n-p (format "Buffer %s modified; save changes? " + (current-buffer))) + (wdired-finish-edit) + (wdired-abort-changes)) + (wdired-change-to-dired-mode) + (set-buffer-modified-p nil) + (setq buffer-undo-list nil) + (message "(No changes need to be saved)"))) + +;; Rename a file, searching it in a modified dired buffer, in order ;; to be able to use `dired-do-create-files-regexp' and get its -;; "benefits" +;; "benefits". (defun wdired-search-and-rename (filename-ori filename-new) (save-excursion (goto-char (point-max)) (forward-line -1) - (let ((exit-while nil) + (let ((done nil) curr-filename) - (while (not exit-while) - (setq curr-filename (wdired-get-filename)) - (if (and curr-filename - (equal (substitute-in-file-name curr-filename) filename-new)) + (while (and (not done) (not (bobp))) + (setq curr-filename (wdired-get-filename nil t)) + (if (equal curr-filename filename-ori) (progn - (setq exit-while t) + (setq done t) (let ((inhibit-read-only t)) (dired-move-to-filename) (search-forward (wdired-get-filename t) nil t) @@ -442,10 +525,7 @@ non-nil means return old filename." (dired-do-create-files-regexp (function dired-rename-file) "Move" 1 ".*" filename-new nil t)) - (progn - (forward-line -1) - (beginning-of-line) - (setq exit-while (= 1 (point))))))))) + (forward-line -1)))))) ;; marks a list of files for deletion (defun wdired-flag-for-deletion (filenames-ori) @@ -473,14 +553,14 @@ Optional arguments are ignored." (if (and (buffer-modified-p) (not (y-or-n-p "Buffer changed. Discard changes and kill buffer? "))) - (error nil))) + (error "Error"))) (defun wdired-next-line (arg) "Move down lines then position at filename or the current column. See `wdired-use-dired-vertical-movement'. Optional prefix ARG says how many lines to move; default is one line." (interactive "p") - (next-line arg) + (with-no-warnings (next-line arg)) (if (or (eq wdired-use-dired-vertical-movement t) (and wdired-use-dired-vertical-movement (< (current-column) @@ -493,7 +573,7 @@ says how many lines to move; default is one line." See `wdired-use-dired-vertical-movement'. Optional prefix ARG says how many lines to move; default is one line." (interactive "p") - (previous-line arg) + (with-no-warnings (previous-line arg)) (if (or (eq wdired-use-dired-vertical-movement t) (and wdired-use-dired-vertical-movement (< (current-column) @@ -514,7 +594,10 @@ says how many lines to move; default is one line." (1- (match-beginning 1)) 'old-link (match-string-no-properties 1)) (put-text-property (match-end 1) (1+ (match-end 1)) 'end-link t) - (put-text-property (1- (match-beginning 1)) + (put-text-property (1- (match-beginning 1)) + (match-beginning 1) + 'rear-nonsticky '(read-only)) + (put-text-property (match-beginning 1) (match-end 1) 'read-only nil))) (forward-line) (beginning-of-line))))) @@ -534,10 +617,10 @@ If OLD, return the old target. If MOVE, move point before it." (if move (goto-char (1- beg))))) (and target (wdired-normalize-filename target)))) - +(declare-function make-symbolic-link "fileio.c") ;; Perform the changes in the target of the changed links. -(defun wdired-do-symlink-changes() +(defun wdired-do-symlink-changes () (let ((changes nil) (errors 0) link-to-ori link-to-new link-from) @@ -545,36 +628,37 @@ If OLD, return the old target. If MOVE, move point before it." (while (setq link-to-new (wdired-get-previous-link)) (setq link-to-ori (wdired-get-previous-link t t)) (setq link-from (wdired-get-filename nil t)) - (if (not (equal link-to-new link-to-ori)) - (progn - (setq changes t) - (if (equal link-to-new "") ;empty filename! - (setq link-to-new "/dev/null")) - (condition-case err - (progn - (delete-file link-from) - (make-symbolic-link - (substitute-in-file-name link-to-new) link-from)) - (error - (setq errors (1+ errors)) - (dired-log (concat "Link `" link-from "' to `" - link-to-new "' failed:\n%s\n") - err)))))) + (unless (equal link-to-new link-to-ori) + (setq changes t) + (if (equal link-to-new "") ;empty filename! + (setq link-to-new "/dev/null")) + (condition-case err + (progn + (delete-file link-from) + (make-symbolic-link + (substitute-in-file-name link-to-new) link-from)) + (error + (setq errors (1+ errors)) + (dired-log (concat "Link `" link-from "' to `" + link-to-new "' failed:\n%s\n") + err))))) (cons changes errors))) ;; Perform a "case command" skipping read-only words. (defun wdired-xcase-word (command arg) (if (< arg 0) (funcall command arg) - (progn - (while (> arg 0) - (condition-case err - (progn - (funcall command 1) - (setq arg (1- arg))) - (error - (if (not (forward-word 1)) - (setq arg 0)))))))) + (while (> arg 0) + (condition-case err + (progn + (funcall command 1) + (setq arg (1- arg))) + (error + (if (forward-word) + ;; Skip any non-word characters to avoid triggering a read-only + ;; error which would cause skipping the next word characters too. + (skip-syntax-forward "^w") + (setq arg 0))))))) (defun wdired-downcase-word (arg) "WDired version of `downcase-word'. @@ -598,45 +682,50 @@ Like original function but it skips read-only words." ;; The following code deals with changing the access bits (or ;; permissions) of the files. -(defvar wdired-perm-mode-map nil) -(unless wdired-perm-mode-map - (setq wdired-perm-mode-map (copy-keymap wdired-mode-map)) - (define-key wdired-perm-mode-map " " 'wdired-toggle-bit) - (define-key wdired-perm-mode-map "r" 'wdired-set-bit) - (define-key wdired-perm-mode-map "w" 'wdired-set-bit) - (define-key wdired-perm-mode-map "x" 'wdired-set-bit) - (define-key wdired-perm-mode-map "-" 'wdired-set-bit) - (define-key wdired-perm-mode-map "S" 'wdired-set-bit) - (define-key wdired-perm-mode-map "s" 'wdired-set-bit) - (define-key wdired-perm-mode-map "T" 'wdired-set-bit) - (define-key wdired-perm-mode-map "t" 'wdired-set-bit) - (define-key wdired-perm-mode-map "s" 'wdired-set-bit) - (define-key wdired-perm-mode-map "l" 'wdired-set-bit) - (define-key wdired-perm-mode-map [down-mouse-1] 'wdired-mouse-toggle-bit)) - -;; Put a local-map to the permission bits of the files, and store the +(defvar wdired-perm-mode-map + (let ((map (make-sparse-keymap))) + (define-key map " " 'wdired-toggle-bit) + (define-key map "r" 'wdired-set-bit) + (define-key map "w" 'wdired-set-bit) + (define-key map "x" 'wdired-set-bit) + (define-key map "-" 'wdired-set-bit) + (define-key map "S" 'wdired-set-bit) + (define-key map "s" 'wdired-set-bit) + (define-key map "T" 'wdired-set-bit) + (define-key map "t" 'wdired-set-bit) + (define-key map "s" 'wdired-set-bit) + (define-key map "l" 'wdired-set-bit) + (define-key map [down-mouse-1] 'wdired-mouse-toggle-bit) + map)) + +;; Put a keymap property to the permission bits of the files, and store the ;; original name and permissions as a property -(defun wdired-preprocess-perms() - (let ((inhibit-read-only t) - filename) +(defun wdired-preprocess-perms () + (let ((inhibit-read-only t)) (set (make-local-variable 'wdired-col-perm) nil) (save-excursion (goto-char (point-min)) (while (not (eobp)) - (if (and (not (looking-at dired-re-sym)) - (setq filename (wdired-get-filename))) - (progn - (re-search-forward dired-re-perms) - (or wdired-col-perm - (setq wdired-col-perm (- (current-column) 9))) - (if (eq wdired-allow-to-change-permissions 'advanced) - (put-text-property (match-beginning 0) (match-end 0) - 'read-only nil) - (put-text-property (1+ (match-beginning 0)) (match-end 0) - 'local-map wdired-perm-mode-map)) - (put-text-property (match-end 0) (1+ (match-end 0)) 'end-perm t) - (put-text-property (match-beginning 0) (1+ (match-beginning 0)) - 'old-perm (match-string-no-properties 0)))) + (when (and (not (looking-at dired-re-sym)) + (wdired-get-filename) + (re-search-forward dired-re-perms (line-end-position) 'eol)) + (let ((begin (match-beginning 0)) + (end (match-end 0))) + (unless wdired-col-perm + (setq wdired-col-perm (- (current-column) 9))) + (if (eq wdired-allow-to-change-permissions 'advanced) + (progn + (put-text-property begin end 'read-only nil) + ;; make first permission bit writable + (put-text-property + (1- begin) begin 'rear-nonsticky '(read-only))) + ;; avoid that keymap applies to text following permissions + (add-text-properties + (1+ begin) end + `(keymap ,wdired-perm-mode-map rear-nonsticky (keymap)))) + (put-text-property end (1+ end) 'end-perm t) + (put-text-property + begin (1+ begin) 'old-perm (match-string-no-properties 0)))) (forward-line) (beginning-of-line))))) @@ -653,34 +742,36 @@ Like original function but it skips read-only words." (defun wdired-set-bit () "Set a permission bit character." (interactive) - (if (wdired-perm-allowed-in-pos last-command-char + (if (wdired-perm-allowed-in-pos last-command-event (- (current-column) wdired-col-perm)) - (let ((new-bit (char-to-string last-command-char)) + (let ((new-bit (char-to-string last-command-event)) (inhibit-read-only t) (pos-prop (- (point) (- (current-column) wdired-col-perm)))) - (put-text-property 0 1 'local-map wdired-perm-mode-map new-bit) + (put-text-property 0 1 'keymap wdired-perm-mode-map new-bit) (put-text-property 0 1 'read-only t new-bit) (insert new-bit) (delete-char 1) - (put-text-property pos-prop (1- pos-prop) 'perm-changed t)) + (put-text-property (1- pos-prop) pos-prop 'perm-changed t) + (put-text-property (1- (point)) (point) 'rear-nonsticky '(keymap))) (forward-char 1))) -(defun wdired-toggle-bit() +(defun wdired-toggle-bit () "Toggle the permission bit at point." (interactive) (let ((inhibit-read-only t) (new-bit "-") (pos-prop (- (point) (- (current-column) wdired-col-perm)))) (if (eq (char-after (point)) ?-) - (setq new-bit + (setq new-bit (if (= (% (- (current-column) wdired-col-perm) 3) 0) "r" (if (= (% (- (current-column) wdired-col-perm) 3) 1) "w" "x")))) - (put-text-property 0 1 'local-map wdired-perm-mode-map new-bit) + (put-text-property 0 1 'keymap wdired-perm-mode-map new-bit) (put-text-property 0 1 'read-only t new-bit) (insert new-bit) (delete-char 1) - (put-text-property pos-prop (1- pos-prop) 'perm-changed t))) + (put-text-property (1- pos-prop) pos-prop 'perm-changed t) + (put-text-property (1- (point)) (point) 'rear-nonsticky '(keymap)))) (defun wdired-mouse-toggle-bit (event) "Toggle the permission bit that was left clicked." @@ -724,28 +815,31 @@ Like original function but it skips read-only words." (setq perms-ori (get-text-property (point) 'old-perm)) (setq perms-new (buffer-substring-no-properties (point) (next-single-property-change (point) 'end-perm))) - (if (not (equal perms-ori perms-new)) - (progn - (setq changes t) - (setq filename (wdired-get-filename nil t)) - (if (= (length perms-new) 10) - (progn - (setq perm-tmp - (int-to-string (wdired-perms-to-number perms-new))) - (if (not (equal 0 (dired-call-process dired-chmod-program - t perm-tmp filename))) - (progn - (setq errors (1+ errors)) - (dired-log (concat dired-chmod-program " " perm-tmp - " `" filename "' failed\n\n"))))) - (setq errors (1+ errors)) - (dired-log (concat "Cannot parse permission `" perms-new - "' for file `" filename "'\n\n"))))) + (unless (equal perms-ori perms-new) + (setq changes t) + (setq filename (wdired-get-filename nil t)) + (if (= (length perms-new) 10) + (progn + (setq perm-tmp + (int-to-string (wdired-perms-to-number perms-new))) + (unless (equal 0 (process-file dired-chmod-program + nil nil nil perm-tmp filename)) + (setq errors (1+ errors)) + (dired-log (concat dired-chmod-program " " perm-tmp + " `" filename "' failed\n\n")))) + (setq errors (1+ errors)) + (dired-log (concat "Cannot parse permission `" perms-new + "' for file `" filename "'\n\n")))) (goto-char (next-single-property-change (1+ (point)) prop-wanted nil (point-max)))) (cons changes errors))) (provide 'wdired) +;; Local Variables: +;; coding: latin-1 +;; byte-compile-dynamic: t +;; End: + ;; arch-tag: bc00902e-526f-4305-bc7f-8862a559184f ;;; wdired.el ends here