Mercurial > emacs
view lisp/wdired.el @ 73331:f21883dcffa9
Merge from upstream, upto version 5.22.
After 5.0:
`cperl-add-tags-recurse-noxs-fullpath': new function (for -batch mode)
After 5.1:
;; Major edit. Summary of most visible changes:
;; a) Multiple <<HERE per line allowed.
;; b) Handles multiline subroutine declaration headers (with comments).
;; (The exception is `cperl-etags' - but it is not used in the rest
;; of the mode.)
;; c) Fontifies multiline my/our declarations (even with comments,
;; and with legacy `font-lock').
;; d) Major speedup of syntaxification, both immediate and postponed
;; (3.5x to 15x [for different CPUs and versions of Emacs] on the
;; huge real-life document I tested).
;; e) New bindings, edits to imenu.
;; f) "_" is made into word-char during fontification/syntaxification;
;; some attempts to recognize non-word "_" during other operations too.
;; g) Detect bug in Emacs with `looking-at' inside `narrow' and bulk out.
;; h) autoload some more perldoc-related stuff
;; i) Some new convenience features: ISpell POD/HEREDOCs, narrow-to-HEREDOC
;; j) Attempt to incorporate XEmacs edits which reached me
Fine-grained changelog:
`cperl-hook-after-change': New configuration variable
`cperl-vc-sccs-header': Likewise.
`cperl-vc-sccs-header': Likewise.
`cperl-vc-header-alist': Default via two preceding variables
`cperl-invalid-face': Remove double quoting under XEmacs
(still needed under 21.2)
`cperl-tips': Update URLs for resources
`cperl-problems': Likewise.
`cperl-praise': Mention new features
New C-c key bindings: for `cperl-find-bad-style',
`cperl-pod-spell', `cperl-here-doc-spell', `cperl-narrow-to-here-doc',
`cperl-perdoc', `cperl-perldoc-at-point'
CPerl Mode menu changes: "Fix style by spaces", "Imenu on Perl Info"
moved, new submenu of Tools with Ispell entries and narrowing.
`cperl-after-sub-regexp': New defsubst
`cperl-imenu--function-name-regexp-perl': Use `cperl-after-sub-regexp',
Allows heads up to head4
Allow "package;"
`defun-prompt-regexp': Use `cperl-after-sub-regexp',
`paren-backwards-message': ??? Something for XEmacs???
`cperl-mode': Never auto-switch abbrev-mode off
Try to allow '_' be non-word char
Do not use `font-lock-unfontify-region-function' on XEmacs
Reset syntax cache on mode start
Support multiline facification (even
on legacy `font-lock')
`cperl-facemenu-add-face-function': ??? Some contributed code ???
`cperl-after-change-function': Since `font-lock' and `lazy-lock'
refuse to inform us whether the fontification is due to lazy
calling or due to edit to a buffer, install our own hook
(controlled by `cperl-hook-after-change')
`cperl-electric-pod': =cut may have been recognized as start
`cperl-block-p': Moved, updated for attributes
`cperl-calculate-indent': Try to allow '_' be non-word char
Support subs with attributes
`cperl-where-am-i': Queit (?) a warning
`cperl-cached-syntax-table' New function
`cperl-forward-re': Use `cperl-cached-syntax-table'
`cperl-unwind-to-safe': Recognize `syntax-type' property
changing in a middle of line
`cperl-find-sub-attrs': New function
`cperl-find-pods-heres': Allow many <<EOP per line
Allow subs with attributes
Major speedups (3.5x..15x on a real-life
test file nph-proxy.pl)
Recognize "extproc " (OS/2)
case-folded and only at start
/x on s///x with empty replacement was
not recognized
Better comments
`cperl-after-block-p': Remarks on diff with `cperl-block-p'
Allow subs with attributes, labels
Do not confuse "else::foo" with "else"
Minor optimizations...
`cperl-after-expr-p': Try to allow '_' be non-word char
`cperl-fill-paragraph': Try to detect a major bug in Emacs
with `looking-at' inside `narrow' and bulk out if found
`cperl-imenu--create-perl-index': Updates for new
`cperl-imenu--function-name-regexp-perl'
`cperl-outline-level': Likewise.
`cperl-init-faces': Allow multiline subroutine headers
and my/our declarations, and ones with comments
Allow subroutine attributes
`cperl-imenu-on-info': Better docstring.
`cperl-etags' Rudimentary support for attributes
Support for packages and "package;"
`cperl-add-tags-recurse-noxs': Better (?) docstring
`cperl-add-tags-recurse-noxs-fullpath': Likewise.
`cperl-tags-hier-init': Misprint for `fboundp' fixed
`cperl-not-bad-style-regexp': Try to allow '_' be non-word char
`cperl-perldoc': Add autoload
`cperl-perldoc-at-point': Likewise.
`cperl-here-doc-spell': New function
`cperl-pod-spell': Likewise.
`cperl-map-pods-heres': Likewise.
`cperl-get-here-doc-region': Likewise.
`cperl-font-lock-fontify-region-function': Likewise (backward compatibility
for legacy `font-lock')
`cperl-font-lock-unfontify-region-function': Fix style
`cperl-fontify-syntaxically': Recognize and optimize away
deferred calls with no-change. Governed by `cperl-hook-after-change'
`cperl-fontify-update': Recognize that syntaxification region
can be larger than fontification one.
XXXX we leave `cperl-postpone' property, so this is quadratic...
`cperl-fontify-update-bad': Temporary placeholder until
it is clear how to implement `cperl-fontify-update'.
`cperl-time-fontification': New function
`attrib-group': New text attribute
`multiline': New value: `syntax-type' text attribute
After 5.2:
`cperl-emulate-lazy-lock': New function
`cperl-fontify-syntaxically': Would skip large regions
Add `cperl-time-fontification', `cperl-emulate-lazy-lock' to menu
Some globals were declared, but uninitialized
After 5.3, 5.4:
`cperl-facemenu-add-face-function': Add docs, fix U<>
Copyright message updated.
`cperl-init-faces': Work around a bug in `font-lock'. May slow
facification down a bit.
Misprint for my|our|local for old `font-lock'
"our" was not fontified same as "my|local"
Highlight variables after "my" etc even in
a middle of an expression
Do not facify multiple variables after my etc
unless parentheses are present
After 5.5, 5.6
`cperl-fontify-syntaxically': after-change hook could reset
`cperl-syntax-done-to' to a middle of line; unwind to BOL.
After 5.7:
`cperl-init-faces': Allow highlighting of local ($/)
`cperl-problems-old-emaxen': New variable (for the purpose of DOCSTRING).
`cperl-problems': Remove fixed problems.
`cperl-find-pods-heres': Recognize #-comments in m##x too
Recognize charclasses (unless delimiter is \).
`cperl-fontify-syntaxically': Unwinding to safe was done in wrong order
`cperl-regexp-scan': Update docs
`cperl-beautify-regexp-piece': use information got from regexp scan
After 5.8:
Major user visible changes:
Recognition and fontification of character classes in RExen.
Variable indentation of RExen according to groups
`cperl-find-pods-heres': Recognize POSIX classes in REx charclasses
Fontify REx charclasses in variable-name face
Fontify POSIX charclasses in "type" face
Fontify unmatched "]" in function-name face
Mark first-char of HERE-doc as `front-sticky'
Reset `front-sticky' property when needed
`cperl-calculate-indent': Indents //x -RExen accordning to parens level
`cperl-to-comment-or-eol': Recognize ends of `syntax-type' constructs
`cperl-backward-to-noncomment': Recognize stringy `syntax-type' constructs
Support `narrow'ed buffers.
`cperl-praise': Remove a reservation
`cperl-make-indent': New function
`cperl-indent-for-comment': Use `cperl-make-indent'
`cperl-indent-line': Likewise.
`cperl-lineup': Likewise.
`cperl-beautify-regexp-piece': Likewise.
`cperl-contract-level': Likewise.
`cperl-toggle-set-debug-unwind': New function
New menu entry for this
`fill-paragraph-function': Use when `boundp'
`cperl-calculate-indent': Take into account groups when indenting RExen
`cperl-to-comment-or-eol': Recognize # which end a string
`cperl-modify-syntax-type': Make only syntax-table property non-sticky
`cperl-fill-paragraph': Return t: needed for `fill-paragraph-function'
`cperl-fontify-syntaxically': More clear debugging message
`cperl-pod2man-build-command': XEmacs portability: check `Man-filter-list'
`cperl-init-faces': More complicated highlight even on XEmacs (new)
Merge cosmetic changes from XEmacs
After 5.9:
`cperl-1+': Moved to before the first use
`cperl-1-': Likewise.
After 5.10:
This code may lock Emacs hard!!! Use on your own risk!
`cperl-font-locking': New internal variable
`cperl-beginning-of-property': New function
`cperl-calculate-indent': Use `cperl-beginning-of-property'
instead of `previous-single-property-change'
`cperl-unwind-to-safe': Likewise.
`cperl-after-expr-p': Likewise.
`cperl-get-here-doc-region': Likewise.
`cperl-font-lock-fontify-region-function': Likewise.
`cperl-to-comment-or-eol': Do not call `cperl-update-syntaxification'
recursively
Bound `next-single-property-change'
via `point-max'
`cperl-unwind-to-safe': Bound likewise
`cperl-font-lock-fontify-region-function': Likewise.
`cperl-find-pods-heres': Mark as recursive for `cperl-to-comment-or-eol'
Initialization of
`cperl-font-lock-multiline-start' could be missed if the "main"
fontification did not run due to the keyword being already fontified.
`cperl-pod-spell': Return t from do-one-chunk function
`cperl-map-pods-heres': Stop when the worker returns nil
Call `cperl-update-syntaxification'
`cperl-get-here-doc-region': Call `cperl-update-syntaxification'
`cperl-get-here-doc-delim': Remove unused function
After 5.11:
The possible lockup of Emacs (introduced in 5.10) fixed
`cperl-unwind-to-safe': `cperl-beginning-of-property' won't return nil
`cperl-syntaxify-for-menu': New customization variable
`cperl-select-this-pod-or-here-doc': New function
`cperl-get-here-doc-region': Extra argument
Do not adjust pos by 1
New menu entries (Perl/Tools): Selection of current POD or HERE-DOC section
(Debugging CPerl:) backtrace on fontification
After 5.12:
`cperl-cached-syntax-table': use `car-safe'
`cperl-forward-re': Remove spurious argument SET-ST
Add documentation
`cperl-forward-group-in-re': New function
`cperl-find-pods-heres': Find and highlight (?{}) blocks in RExen
(XXXX Temporary (?) hack is to syntax-mark them as comment)
After 5.13:
`cperl-string-syntax-table': Make { and } not-grouping
(Sometimes they ARE grouping in RExen, but matching them would only
confuse in many situations when they are not)
`beginning-of-buffer': Replaced two occurences with goto-char...
`cperl-calculate-indent': `char-after' could be nil...
`cperl-find-pods-heres': REx can start after "[" too
Hightlight (??{}) in RExen too
`cperl-maybe-white-and-comment-rex': New constant
`cperl-white-and-comment-rex': Likewise.
XXXX Not very efficient, but hard to make
better while keeping 1 group
After 5.13:
`cperl-find-pods-heres': $foo << identifier() is not a HERE-DOC
Likewise for 1 << identifier
After 5.14:
`cperl-find-pods-heres': Different logic for $foo .= <<EOF etc
Error-less condition-case could fail
`cperl-font-lock-fontify-region-function': Likewise.
`cperl-init-faces': Likewise.
After 5.15:
`cperl-find-pods-heres': Support property REx-part2
`cperl-calculate-indent': Likewise.
Don't special-case REx with non-empty 1st line
`cperl-find-pods-heres': In RExen, highlight non-literal backslashes
Invert highlighting of charclasses:
now the envelop is highlighted
Highlight many others 0-length builtins
`cperl-praise': Mention indenting and highlight in RExen
After 5.15:
`cperl-find-pods-heres': Highlight capturing parens in REx
After 5.16:
`cperl-find-pods-heres': Highlight '|' for alternation
Initialize `font-lock-warning-face' if not present
`cperl-find-pods-heres': Use `font-lock-warning-face' instead of
`font-lock-function-name-face'
`cperl-look-at-leading-count': Likewise.
`cperl-find-pods-heres': localize `font-lock-variable-name-face'
`font-lock-keyword-face' (needed for
batch processing) etc
Use `font-lock-builtin-face' for builtin in REx
Now `font-lock-variable-name-face'
is used for interpolated variables
Use "talking aliases" for faces inside REx
Highlight parts of REx (except in charclasses)
according to the syntax and/or semantic
Syntax-mark a {}-part of (?{}) as "comment"
(it was the ()-part)
Better logic to distinguish what is what in REx
`cperl-tips-faces': Document REx highlighting
`cperl-praise': Mention REx syntax highlight etc.
After 5.17:
`cperl-find-sub-attrs': Would not always manage to print error message
`cperl-find-pods-heres': localize `font-lock-constant-face'
After 5.18:
`cperl-find-pods-heres': Misprint in REx for parsing REx
Very minor optimization
`my-cperl-REx-modifiers-face' got quoted
Recognize "print $foo <<END" as HERE-doc
Put `REx-interpolated' text attribute if needed
`cperl-invert-if-unless-modifiers': New function
`cperl-backward-to-start-of-expr': Likewise.
`cperl-forward-to-end-of-expr': Likewise.
`cperl-invert-if-unless': Works in "the opposite way" too
Cursor position on return is on the switch-word
Indents comments better
`REx-interpolated': New text attribute
`cperl-next-interpolated-REx': New function
`cperl-next-interpolated-REx-0': Likewise.
`cperl-next-interpolated-REx-1': Likewise.
"\C-c\C-x", "\C-c\C-y", "\C-c\C-v": New keybinding for these functions
Perl/Regexp menu: 3 new entries for `cperl-next-interpolated-REx'
`cperl-praise': Mention finded interpolated RExen
After 5.19:
`cperl-init-faces': Highlight %$foo, @$foo too
`cperl-short-docs': Better docs for system, exec
`cperl-find-pods-heres': Better detect << after print {FH} <<EOF etc.
Would not find HERE-doc ended by EOF without NL
`cperl-short-docs': Correct not-doubled \-escapes
start block: Put some `defvar' for stuff gone from XEmacs
After 5.20:
initial comment: Extend copyright, fix email address
`cperl-indent-comment-at-column-0': New customization variable
`cperl-comment-indent': Indentation after $#a would increasy by 1
`cperl-mode': Make `defun-prompt-regexp' grok BEGIN/END etc
`cperl-find-pods-heres': Mark CODE of s///e as `syntax-type' `multiline'
`cperl-at-end-of-expr': Would fail if @BAR=12 follows after ";"
`cperl-init-faces': If `cperl-highlight-variables-indiscriminately'
highlight $ in $foo too (UNTESTED)
`cperl-set-style': Docstring missed some available styles
toplevel: Menubar/Perl/Indent-Styles had FSF, now K&R
Change "Current" to "Memorize Current"
`cperl-indent-wrt-brace': New customization variable; the default is
as for pre-5.2 version
`cperl-styles-entries': Keep `cperl-extra-newline-before-brace-multiline'
`cperl-style-alist': Likewise.
`cperl-fix-line-spacing': Support `cperl-merge-trailing-else' being nil,
and `cperl-extra-newline-before-brace' etc
being t
`cperl-indent-exp': Plans B and C to find continuation blocks even
if `cperl-extra-newline-before-brace' is t
After 5.21:
Improve some docstrings concerning indentation.
`cperl-indent-rules-alist': New variable
`cperl-sniff-for-indent': New function name
(separated from `cperl-calculate-indent')
`cperl-calculate-indent': Separated the sniffer and the indenter;
uses `cperl-sniff-for-indent' now
`cperl-comment-indent': Test for `cperl-indent-comment-at-column-0'
was inverted;
Support `comment-column' = 0
author | Stefan Monnier <monnier@iro.umontreal.ca> |
---|---|
date | Wed, 11 Oct 2006 06:47:35 +0000 |
parents | 183934d15fbb |
children | 1a43c99020cb |
line wrap: on
line source
;;; wdired.el --- Rename files editing their names in dired buffers ;; Copyright (C) 2004, 2005, 2006 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 2, 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. ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; 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 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. ;;; Installation: ;; Add this file (byte-compiling it is recommended) to your load-path. ;; Then add one of these set of lines (or similar ones) to your config: ;; ;; This is the easy way: ;; ;; (require 'wdired) ;; (define-key dired-mode-map "r" 'wdired-change-to-wdired-mode) ;; ;; This is the recommended way for faster Emacs startup time and lower ;; memory consumption: ;; ;; (autoload 'wdired-change-to-wdired-mode "wdired") ;; (eval-after-load "dired" ;; '(lambda () ;; (define-key dired-mode-map "r" 'wdired-change-to-wdired-mode) ;; (define-key dired-mode-map ;; [menu-bar immediate wdired-change-to-wdired-mode] ;; '("Edit File Names" . wdired-change-to-wdired-mode)))) ;; ;; Type "M-x customize-group RET wdired" if you want to make changes ;; to the default behavior. ;;; Usage: ;; Then, you can start editing the names of the files by typing "r" ;; (or whatever key you choose, or M-x wdired-change-to-wdired-mode). ;; Use C-c C-c when finished or C-c C-k to abort. You can use also the ;; menu options: in dired mode, "Edit File Names" under "Immediate". ;; While editing the names, 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: (defvar dired-backup-overwrite) ; Only in Emacs 20.x this is a custom var (eval-when-compile (require 'cl)) (require 'dired) (autoload 'dired-do-create-files-regexp "dired-aux") (autoload 'dired-call-process "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 honored. 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) (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-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)) (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) (defun wdired-mode () "\\<wdired-mode-map>File Names Editing mode. Press \\[wdired-finish-edit] to make the changes to take effect and exit. To abort the edit, use \\[wdired-abort-changes]. In this mode you can edit the names of the files, the target of the links and the permission bits of the files. You can use \\[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 a mode in which filenames are editable. \\<wdired-mode-map> This mode allows the user to change the names of the files, and after typing \\[wdired-finish-edit] Emacs renames the files and directories 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) (setq buffer-read-only nil) (dired-unadvertise default-directory) (add-hook 'kill-buffer-hook 'wdired-check-kill-buffer 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"))) ;; 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) (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) (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) (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) (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* ((end (line-end-position)) (beg (next-single-property-change (line-beginning-position) 'old-name nil end))) (unless (eq beg end) (let ((file (if old (get-text-property beg 'old-name) (wdired-normalize-filename (buffer-substring-no-properties (+ 2 beg) (next-single-property-change (1+ beg) 'end-name)))))) (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) '(read-only nil local-map nil))) (put-text-property 1 2 'front-sticky 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) (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) (wdired-change-to-dired-mode) (let ((overwrite (or (not wdired-confirm-overwrite) 1)) (changes nil) (files-deleted nil) (errors 0) file-ori 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))))) (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)))))))) (forward-line -1))) (if changes (revert-buffer) ;The "revert" is necessary to re-sort the 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))) (set-buffer-modified-p nil) (setq buffer-undo-list nil)) ;; 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 ((exit-while 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)) (progn (setq exit-while 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)) (progn (forward-line -1) (beginning-of-line) (setq exit-while (= 1 (point))))))))) ;; 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 nil))) (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) (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") (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-end 1) 'read-only nil))) (forward-line) (beginning-of-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 (previous-single-property-change (point) 'old-link nil))) (when beg (let ((target (if old (get-text-property (1- beg) 'old-link) (buffer-substring-no-properties (1+ beg) (next-single-property-change beg 'end-link))))) (if move (goto-char (1- beg))) (and target (wdired-normalize-filename target)))))) ;; 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 (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) (while (> arg 0) (condition-case err (progn (funcall command 1) (setq arg (1- arg))) (error (if (not (forward-word 1)) (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 local-map 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) (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) 'keymap 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)))) (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-char (- (current-column) wdired-col-perm)) (let ((new-bit (char-to-string last-command-char)) (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 pos-prop (1- pos-prop) 'perm-changed t)) (forward-char 1))) (defun wdired-toggle-bit () "Toggle the permission bit at point." (interactive) (let ((inhibit-read-only t) (new-bit (cond ((not (eq (char-after (point)) ?-)) "-") ((= (% (- (current-column) wdired-col-perm) 3) 0) "r") ((= (% (- (current-column) wdired-col-perm) 3) 1) "w") (t "x"))) (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 pos-prop (1- pos-prop) 'perm-changed t))) (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) (+ (if (= (elt perms 1) ?-) 0 400) (if (= (elt perms 2) ?-) 0 200) (case (elt perms 3) (?- 0) (?S 4000) (?s 4100) (t 100)) (if (= (elt perms 4) ?-) 0 40) (if (= (elt perms 5) ?-) 0 20) (case (elt perms 6) (?- 0) (?S 2000) (?s 2010) (t 10)) (if (= (elt perms 7) ?-) 0 4) (if (= (elt perms 8) ?-) 0 2) (case (elt perms 9) (?- 0) (?T 1000) (?t 1001) (t 1)))) ;; 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 (dired-call-process dired-chmod-program t 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