mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-23 07:19:15 +00:00
Code Issues Releases Activity
daaa9da0c4
emacs/lisp/wdired.el
Stephen Berman 288e83ae00 Prevent infinite loop on entering wdired-mode 
* lisp/wdired.el (wdired-preprocess-symlinks): Remove unneeded use
of beginning-of-line, which also triggers an infinite loop in a
find-dired buffer that doesn't end with a newline (see discussion
in bug#35609).
2019-07-16 11:04:56 +02:00

916 lines
36 KiB
EmacsLisp
Raw Blame History

;;; wdired.el --- Rename files editing their names in dired buffers -*- coding: utf-8; -*-
;; Copyright (C) 2004-2019 Free Software Foundation, Inc.
;; Filename: wdired.el
;; Author: Juan León Lahoz García <juanleon1@gmail.com>
;; Version: 2.0
;; Keywords: dired, environment, files, renaming
;; 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 3 of the License, or
;; (at your option) any later version.
;; 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. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; wdired.el (the "w" is for writable) provides an alternative way of
;; 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
;; 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
;; dired buffer editable, by changing the buffer mode (which inhibits
;; all of the commands of dired mode). Here you can edit the names of
;; one or more files and directories, and when you press C-c C-c, the
;; renaming takes effect and you are back to dired mode.
;;
;; Another things you can do with WDired:
;;
;; - To move files to another directory (by typing their path,
;; absolute or relative, as a part of the new filename).
;;
;; - To change the target of symbolic links.
;;
;; - To change the permission bits of the filenames (in systems with a
;; working unix-alike `dired-chmod-program'). See and customize the
;; variable `wdired-allow-to-change-permissions'. To change a single
;; char (toggling between its two more usual values) you can press
;; the space bar over it or left-click the mouse. To set any char to
;; an specific value (this includes the SUID, SGID and STI bits) you
;; can use the key labeled as the letter you want. Please note that
;; permissions of the links cannot be changed in that way, because
;; the change would affect to their targets, and this would not be
;; WYSIWYG :-).
;;
;; - To mark files for deletion, by deleting their whole filename.
;;; Usage:
;; You can edit the names of the files by typing C-x C-q or by
;; executing M-x wdired-change-to-wdired-mode. Use C-c C-c when
;; finished or C-c C-k to abort. While editing filenames, a new
;; submenu "WDired" is available at top level. You can customize the
;; behavior of this package from this menu.
;;; Change Log:
;; Google is your friend (previous versions with complete changelogs
;; were posted to gnu.emacs.sources)
;;; Code:
(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 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."
:type 'boolean
:group 'wdired)
(defcustom wdired-confirm-overwrite t
"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.
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 non-nil. This behavior is very handy
when editing several filenames.
If nil, \"up\" and \"down\" movement is done as in any other buffer."
:type '(choice (const :tag "As in any other mode" nil)
(const :tag "Smart cursor placement" sometimes)
(other :tag "As in dired mode" t))
:group 'wdired)
(defcustom wdired-allow-to-redirect-links t
"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 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
to set: if this value is allowed, the character in the buffer will be
changed. Anyway, the point is advanced one position, so, for example,
you can keep the <x> key pressed to give execution permissions to
everybody to that file.
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.
Anyway, the real change of the permissions is done by the external
program `dired-chmod-program', which must exist."
:type '(choice (const :tag "Not allowed" nil)
(const :tag "Toggle/set bits" t)
(other :tag "Bits freely editable" advanced))
:group 'wdired)
(defcustom wdired-keep-marker-rename t
;; Use t as default so that renamed files "take their markers with them".
"Controls marking of files renamed in WDired.
If t, files keep their previous marks when they are renamed.
If a character, renamed files (whether previously marked or not)
are afterward marked with that character.
This option affects only files renamed by `wdired-finish-edit'.
See `dired-keep-marker-rename' if you want to do the same for files
renamed by `dired-do-rename' and `dired-do-rename-regexp'."
:type '(choice (const :tag "Keep" t)
(character :tag "Mark" :value ?R))
:version "24.3"
:group 'wdired)
(defcustom wdired-create-parent-directories t
"If non-nil, create parent directories of destination files.
If non-nil, when you rename a file to a destination path within a
nonexistent directory, wdired will create any parent directories
necessary. When nil, attempts to rename a file into a
nonexistent directory will fail."
:version "26.1"
:type 'boolean
:group 'wdired)
(defvar wdired-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "\C-x\C-s" 'wdired-finish-edit)
(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)
(define-key map [up] 'wdired-previous-line)
(define-key map "\C-p" 'wdired-previous-line)
(define-key map [down] 'wdired-next-line)
(define-key map "\C-n" 'wdired-next-line)
(define-key map [menu-bar wdired]
(cons "WDired" (make-sparse-keymap "WDired")))
(define-key map [menu-bar wdired wdired-customize]
'("Options" . wdired-customize))
(define-key map [menu-bar wdired dashes]
'("--"))
(define-key map [menu-bar wdired 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))
(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)
"Keymap used in `wdired-mode'.")
(defvar wdired-mode-hook nil
"Hooks run when changing to WDired mode.")
;; 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)
(defvar wdired-old-marks)
(defun wdired-mode ()
"Writable Dired (WDired) mode.
\\<wdired-mode-map>
In WDired mode, you can edit the names of the files in the
buffer, the target of the links, and the permission bits of the
files.
Type \\[wdired-finish-edit] to exit WDired mode, returning to
Dired mode, and make your edits \"take effect\" by modifying the
file and directory names, link targets, and/or file permissions
on disk. If you delete the filename of a file, it is flagged for
deletion in the Dired buffer.
Type \\[wdired-abort-changes] to abort your edits and exit WDired mode.
Type \\[customize-group] RET wdired to customize WDired behavior.
The only editable texts in a WDired buffer are filenames,
symbolic link targets, and filenames permission."
(interactive)
(error "This mode can be enabled only by `wdired-change-to-wdired-mode'"))
(put 'wdired-mode 'mode-class 'special)
;;;###autoload
(defun wdired-change-to-wdired-mode ()
"Put a Dired buffer in Writable Dired (WDired) mode.
\\<wdired-mode-map>
In WDired mode, you can edit the names of the files in the
buffer, the target of the links, and the permission bits of the
files. After typing \\[wdired-finish-edit], Emacs modifies the files and
directories to reflect your edits.
See `wdired-mode'."
(interactive)
(unless (derived-mode-p '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-marks)
(dired-remember-marks (point-min) (point-max)))
(set (make-local-variable 'wdired-old-point) (point))
(set (make-local-variable 'query-replace-skip-read-only) t)
(add-function :after-while (local 'isearch-filter-predicate)
#'wdired-isearch-filter-read-only)
(use-local-map wdired-mode-map)
(force-mode-line-update)
(setq buffer-read-only nil)
(dired-unadvertise default-directory)
(add-hook 'kill-buffer-hook 'wdired-check-kill-buffer nil t)
(add-hook 'after-change-functions 'wdired--restore-dired-filename-prop nil t)
(setq major-mode 'wdired-mode)
(setq mode-name "Editable Dired")
(setq revert-buffer-function 'wdired-revert)
;; I temp disable undo for performance: since I'm going to clear the
;; undo list, it can save more than a 9% of time with big
;; directories because setting properties modify the undo-list.
(buffer-disable-undo)
(wdired-preprocess-files)
(if wdired-allow-to-change-permissions
(wdired-preprocess-perms))
(if (and wdired-allow-to-redirect-links (fboundp 'make-symbolic-link))
(wdired-preprocess-symlinks))
(buffer-enable-undo) ; Performance hack. See above.
(set-buffer-modified-p nil)
(setq buffer-undo-list nil)
(run-mode-hooks 'wdired-mode-hook)
(message "%s" (substitute-command-keys
"Press \\[wdired-finish-edit] when finished \
or \\[wdired-abort-changes] to abort changes")))
(defun wdired-isearch-filter-read-only (beg end)
"Skip matches that have a read-only property."
(not (text-property-not-all (min beg end) (max beg end)
'read-only nil)))
;; 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 (point-min) (1+ (point-min))'front-sticky t)
(save-excursion
(goto-char (point-min))
(let ((b-protection (point))
filename)
(while (not (eobp))
(setq filename (dired-get-filename nil t))
(when (and filename
(not (member (file-name-nondirectory filename) '("." ".."))))
(dired-move-to-filename)
;; 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))))
;; This code is a copy of some dired-get-filename lines.
(defsubst wdired-normalize-filename (file unquotep)
(when unquotep
(setq file
;; FIXME: shouldn't we check for a `b' argument or somesuch before
;; doing such unquoting? --Stef
(read (concat
"\"" (replace-regexp-in-string
"\\([^\\]\\|\\`\\)\"" "\\1\\\\\"" file)
"\""))))
(and file buffer-file-coding-system
(not file-name-coding-system)
(not default-file-name-coding-system)
(setq file (encode-coding-string file buffer-file-coding-system)))
file)
(defun wdired-get-filename (&optional no-dir old)
"Return the filename at line.
Similar to `dired-get-filename' but it doesn't rely on regexps. It
relies on WDired buffer's properties. Optional arg NO-DIR with value
non-nil means don't include directory. Optional arg OLD with value
non-nil means return old filename."
;; FIXME: Use dired-get-filename's new properties.
(let (beg end file)
(save-excursion
(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))
;; 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)))
;; Don't unquote the old name, it wasn't quoted in the first place
(and file (setq file (wdired-normalize-filename file (not old)))))
(if (or no-dir old)
file
(and file (> (length file) 0)
(concat (dired-current-directory) file))))))
(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)
'(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)
(setq major-mode 'dired-mode)
(setq mode-name "Dired")
(dired-advertise)
(remove-hook 'kill-buffer-hook 'wdired-check-kill-buffer t)
(remove-hook 'after-change-functions 'wdired--restore-dired-filename-prop t)
(set (make-local-variable 'revert-buffer-function) 'dired-revert))
(defun wdired-abort-changes ()
"Abort changes and return to dired mode."
(interactive)
(let ((inhibit-read-only t))
(erase-buffer)
(insert wdired-old-content)
(goto-char wdired-old-point))
(wdired-change-to-dired-mode)
(set-buffer-modified-p nil)
(setq buffer-undo-list nil)
(message "Changes aborted"))
(defun wdired-finish-edit ()
"Actually rename files based on your editing in the Dired buffer."
(interactive)
(let ((changes nil)
(errors 0)
files-deleted
files-renamed
some-file-names-unchanged
file-old file-new tmp-value)
(save-excursion
(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-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)
(when wdired-keep-marker-rename
(let ((mark (cond ((integerp wdired-keep-marker-rename)
wdired-keep-marker-rename)
(wdired-keep-marker-rename
(cdr (assoc file-old wdired-old-marks)))
(t nil))))
(when mark
(push (cons (substitute-in-file-name file-new) mark)
wdired-old-marks))))
(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))))
;; We have to be in wdired-mode when wdired-do-renames is executed
;; so that wdired--restore-dired-filename-prop runs, but we have
;; to change back to dired-mode before reverting the buffer to
;; avoid using wdired-revert, which changes back to wdired-mode.
(wdired-change-to-dired-mode)
(if changes
(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))
(dired-mark-remembered wdired-old-marks)))
(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)")))
(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))
(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))
(and wdired-create-parent-directories
(wdired-create-parentdirs file-new))
(dired-rename-file file-ori file-new
overwrite))
(error
(setq errors (1+ errors))
(dired-log "Rename `%s' to `%s' failed:\n%s\n"
file-ori file-new
err)))))))))
errors))
(defun wdired-create-parentdirs (file-new)
"Create parent directories for FILE-NEW if they don't exist."
(and (not (file-exists-p (file-name-directory file-new)))
(message "Creating directory for file %s" file-new)
(make-directory (file-name-directory file-new) t)))
(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".
(defun wdired-search-and-rename (filename-ori filename-new)
(save-excursion
(goto-char (point-max))
(forward-line -1)
(let ((done nil)
(failed t)
curr-filename)
(while (and (not done) (not (bobp)))
(setq curr-filename (wdired-get-filename nil t))
(if (equal curr-filename filename-ori)
(unwind-protect
(progn
(setq done t)
(let ((inhibit-read-only t))
(dired-move-to-filename)
(search-forward (wdired-get-filename t) nil t)
(replace-match (file-name-nondirectory filename-ori) t t))
(dired-do-create-files-regexp
(function dired-rename-file)
"Move" 1 ".*" filename-new nil t)
(setq failed nil))
;; If user types C-g when prompted to change the file
;; name, make sure we return to dired-mode.
(when failed (wdired-change-to-dired-mode)))
(forward-line -1))))))
;; marks a list of files for deletion
(defun wdired-flag-for-deletion (filenames-ori)
(save-excursion
(goto-char (point-min))
(while (not (eobp))
(if (member (dired-get-filename nil t) filenames-ori)
(dired-flag-file-deletion 1)
(forward-line)))))
(defun wdired-customize ()
"Customize WDired options."
(interactive)
(customize-apropos "wdired" 'groups))
(defun wdired-revert (&optional _arg _noconfirm)
"Discard changes in the buffer and update it based on changes on disk.
Optional arguments are ignored."
(wdired-change-to-dired-mode)
(revert-buffer)
(wdired-change-to-wdired-mode))
(defun wdired-check-kill-buffer ()
;; FIXME: Can't we use the normal mechanism for that? --Stef
(if (and
(buffer-modified-p)
(not (y-or-n-p "Buffer changed. Discard changes and kill buffer? ")))
(error "Error")))
;; Added to after-change-functions in wdired-change-to-wdired-mode to
;; ensure that, on editing a file name, new characters get the
;; dired-filename text property, which allows functions that look for
;; this property (e.g. dired-isearch-filenames) to work in wdired-mode
;; and also avoids an error with non-nil wdired-use-interactive-rename
;; (bug#32173).
(defun wdired--restore-dired-filename-prop (beg end _len)
(save-match-data
(save-excursion
(let ((lep (line-end-position)))
(beginning-of-line)
(when (re-search-forward
directory-listing-before-filename-regexp lep t)
(setq beg (point)
end (if (or
;; If the file is a symlink, put the
;; dired-filename property only on the link
;; name. (Using (file-symlink-p
;; (dired-get-filename)) fails in
;; wdired-mode, bug#32673.)
(and (re-search-backward
dired-permission-flags-regexp nil t)
(looking-at "l")
(search-forward " -> " lep t))
;; When dired-listing-switches includes "F"
;; or "classify", don't treat appended
;; indicator characters as part of the file
;; name (bug#34915).
(and (dired-check-switches dired-actual-switches
"F" "classify")
(re-search-forward "[*/@|=>]$" lep t)))
(goto-char (match-beginning 0))
lep))
(put-text-property beg end 'dired-filename t))))))
(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")
(with-no-warnings (next-line arg))
(if (or (eq wdired-use-dired-vertical-movement t)
(and wdired-use-dired-vertical-movement
(< (current-column)
(save-excursion (dired-move-to-filename)
(current-column)))))
(dired-move-to-filename)))
(defun wdired-previous-line (arg)
"Move up 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")
(with-no-warnings (previous-line arg))
(if (or (eq wdired-use-dired-vertical-movement t)
(and wdired-use-dired-vertical-movement
(< (current-column)
(save-excursion (dired-move-to-filename)
(current-column)))))
(dired-move-to-filename)))
;; Put the needed properties to allow the user to change links' targets
(defun wdired-preprocess-symlinks ()
(let ((inhibit-read-only t))
(save-excursion
(goto-char (point-min))
(while (not (eobp))
(if (looking-at dired-re-sym)
(progn
(re-search-forward " -> \\(.*\\)$")
(put-text-property (- (match-beginning 1) 2)
(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))
(match-beginning 1)
'rear-nonsticky '(read-only))
(put-text-property (match-beginning 1)
(match-end 1) 'read-only nil)))
(forward-line)))))
(defun wdired-get-previous-link (&optional old move)
"Return the next symlink target.
If OLD, return the old target. If MOVE, move point before it."
(let (beg end target)
(setq beg (previous-single-property-change (point) 'old-link nil))
(if beg
(progn
(if old
(setq target (get-text-property (1- beg) 'old-link))
(setq end (next-single-property-change beg 'end-link))
(setq target (buffer-substring-no-properties (1+ beg) end)))
(if move (goto-char (1- beg)))))
(and target (wdired-normalize-filename target t))))
(declare-function make-symbolic-link "fileio.c")
;; Perform the changes in the target of the changed links.
(defun wdired-do-symlink-changes ()
(let ((changes nil)
(errors 0)
link-to-ori link-to-new link-from)
(goto-char (point-max))
(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))
(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 "Link `%s' to `%s' failed:\n%s\n"
link-from link-to-new
err)))))
(cons changes errors)))
;; Perform a "case command" skipping read-only words.
(defun wdired-xcase-word (command arg)
(if (< arg 0)
(funcall command arg)
(while (> arg 0)
(condition-case nil
(progn
(funcall command 1)
(setq arg (1- arg)))
(error
(if (forward-word-strictly)
;; 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'.
Like original function but it skips read-only words."
(interactive "p")
(wdired-xcase-word 'downcase-word arg))
(defun wdired-upcase-word (arg)
"WDired version of `upcase-word'.
Like original function but it skips read-only words."
(interactive "p")
(wdired-xcase-word 'upcase-word arg))
(defun wdired-capitalize-word (arg)
"WDired version of `capitalize-word'.
Like original function but it skips read-only words."
(interactive "p")
(wdired-xcase-word 'capitalize-word arg))
;; The following code deals with changing the access bits (or
;; permissions) of the files.
(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))
(set (make-local-variable 'wdired-col-perm) nil)
(save-excursion
(goto-char (point-min))
(while (not (eobp))
(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)))))
(defun wdired-perm-allowed-in-pos (char pos)
(cond
((= char ?-) t)
((= char ?r) (= (% pos 3) 0))
((= char ?w) (= (% pos 3) 1))
((= char ?x) (= (% pos 3) 2))
((memq char '(?s ?S)) (memq pos '(2 5)))
((memq char '(?t ?T)) (= pos 8))
((= char ?l) (= pos 5))))
(defun wdired-set-bit ()
"Set a permission bit character."
(interactive)
(if (wdired-perm-allowed-in-pos last-command-event
(- (current-column) wdired-col-perm))
(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 '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 (1- pos-prop) pos-prop 'perm-changed t)
(put-text-property (1- (point)) (point) 'rear-nonsticky '(keymap)))
(forward-char 1)))
(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
(if (= (% (- (current-column) wdired-col-perm) 3) 0) "r"
(if (= (% (- (current-column) wdired-col-perm) 3) 1) "w"
"x"))))
(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 (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."
(interactive "e")
(mouse-set-point event)
(wdired-toggle-bit))
;; Allowed chars for 4000 bit are Ss in position 3
;; Allowed chars for 2000 bit are Ssl in position 6
;; Allowed chars for 1000 bit are Tt in position 9
(defun wdired-perms-to-number (perms)
(let ((nperm 0777))
(if (= (elt perms 1) ?-) (setq nperm (- nperm 400)))
(if (= (elt perms 2) ?-) (setq nperm (- nperm 200)))
(let ((p-bit (elt perms 3)))
(if (memq p-bit '(?- ?S)) (setq nperm (- nperm 100)))
(if (memq p-bit '(?s ?S)) (setq nperm (+ nperm 4000))))
(if (= (elt perms 4) ?-) (setq nperm (- nperm 40)))
(if (= (elt perms 5) ?-) (setq nperm (- nperm 20)))
(let ((p-bit (elt perms 6)))
(if (memq p-bit '(?- ?S ?l)) (setq nperm (- nperm 10)))
(if (memq p-bit '(?s ?S ?l)) (setq nperm (+ nperm 2000))))
(if (= (elt perms 7) ?-) (setq nperm (- nperm 4)))
(if (= (elt perms 8) ?-) (setq nperm (- nperm 2)))
(let ((p-bit (elt perms 9)))
(if (memq p-bit '(?- ?T)) (setq nperm (- nperm 1)))
(if (memq p-bit '(?t ?T)) (setq nperm (+ nperm 1000))))
nperm))
;; Perform the changes in the permissions of the files that have
;; changed.
(defun wdired-do-perm-changes ()
(let ((changes nil)
(errors 0)
(prop-wanted (if (eq wdired-allow-to-change-permissions 'advanced)
'old-perm 'perm-changed))
filename perms-ori perms-new perm-tmp)
(goto-char (next-single-property-change (point-min) prop-wanted
nil (point-max)))
(while (not (eobp))
(setq perms-ori (get-text-property (point) 'old-perm))
(setq perms-new (buffer-substring-no-properties
(point) (next-single-property-change (point) 'end-perm)))
(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 "%s %s `%s' failed\n\n"
dired-chmod-program perm-tmp filename)))
(setq errors (1+ errors))
(dired-log "Cannot parse permission `%s' for file `%s'\n\n"
perms-new filename)))
(goto-char (next-single-property-change (1+ (point)) prop-wanted
nil (point-max))))
(cons changes errors)))
(provide 'wdired)
;;; wdired.el ends here
Reference in New Issue View Git Blame Copy Permalink