;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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, or (at your option)
-;; any later version.
+;; 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
;; 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.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
MSG is a noun phrase for the type of files being marked.
It should end with a noun that can be pluralized by adding `s'.
Return value is the number of files marked, or nil if none were marked."
- `(let (buffer-read-only count)
+ `(let ((inhibit-read-only t) count)
(save-excursion
(setq count 0)
(if ,msg (message "Marking %ss..." ,msg))
distinguish-one-marked)
"Eval BODY with point on each marked line. Return a list of BODY's results.
If no marked file could be found, execute BODY on the current line.
- If ARG is an integer, use the next ARG (or previous -ARG, if ARG<0)
- files instead of the marked files.
- In that case point is dragged along. This is so that commands on
- the next ARG (instead of the marked) files can be chained easily.
- If ARG is otherwise non-nil, use current file instead.
+ARG, if non-nil, specifies the files to use instead of the marked files.
+ If ARG is an integer, use the next ARG (or previous -ARG, if
+ ARG<0) files. In that case, point is dragged along. This is
+ so that commands on the next ARG (instead of the marked) files
+ can be chained easily.
+ For any other non-nil value of ARG, use the current file.
If optional third arg SHOW-PROGRESS evaluates to non-nil,
redisplay the dired buffer after each file is processed.
No guarantee is made about the position on the marked line.
;;endless loop.
;;This warning should not apply any longer, sk 2-Sep-1991 14:10.
`(prog1
- (let (buffer-read-only case-fold-search found results)
+ (let ((inhibit-read-only t) case-fold-search found results)
(if ,arg
(if (integerp ,arg)
(progn ;; no save-excursion, want to move point.
first marked file.
Values returned are normally absolute file names.
Optional arg LOCALP as in `dired-get-filename'.
-Optional second argument ARG specifies files near point
- instead of marked files. If ARG is an integer, use the next ARG files.
- If ARG is otherwise non-nil, use file. Usually ARG comes from
- the command's prefix arg.
+Optional second argument ARG, if non-nil, specifies files near
+ point instead of marked files. It usually comes from the prefix
+ argument.
+ If ARG is an integer, use the next ARG files.
+ Any other non-nil value means to use the current file instead.
Optional third argument FILTER, if non-nil, is a function to select
some of the files--those for which (funcall FILTER FILENAME) is non-nil.
(defun dired-read-dir-and-switches (str)
;; For use in interactive.
- (reverse (list
- (if current-prefix-arg
- (read-string "Dired listing switches: "
- dired-listing-switches))
- ;; If a dialog is about to be used, call read-directory-name so
- ;; the dialog code knows we want directories. Some dialogs can
- ;; only select directories or files when popped up, not both.
- (if (next-read-file-uses-dialog-p)
- (read-directory-name (format "Dired %s(directory): " str)
- nil default-directory nil)
- (lexical-let ((default (and buffer-file-name
- (abbreviate-file-name buffer-file-name)))
- (defdir default-directory))
- (minibuffer-with-setup-hook
- (lambda ()
- (setq minibuffer-default default)
- (setq default-directory defdir))
- (completing-read
- (format "Dired %s(directory): " str)
- ;; We need a mix of read-file-name and read-directory-name
- ;; so that completion to directories is preferred, but if
- ;; the user wants to enter a global pattern, he can still
- ;; use completion on filenames to help him write the pattern.
- ;; Essentially, we want to use
- ;; (completion-table-with-predicate
- ;; 'read-file-name-internal 'file-directory-p nil)
- ;; but that doesn't work because read-file-name-internal
- ;; does not obey its `predicate' argument.
- (completion-table-in-turn
- (lambda (str pred action)
- (let ((read-file-name-predicate 'file-directory-p))
- (complete-with-action
- action 'read-file-name-internal str nil)))
- 'read-file-name-internal)
- nil nil (abbreviate-file-name defdir) 'file-name-history)))))))
+ (reverse
+ (list
+ (if current-prefix-arg
+ (read-string "Dired listing switches: "
+ dired-listing-switches))
+ ;; If a dialog is about to be used, call read-directory-name so
+ ;; the dialog code knows we want directories. Some dialogs can
+ ;; only select directories or files when popped up, not both.
+ (if (next-read-file-uses-dialog-p)
+ (read-directory-name (format "Dired %s(directory): " str)
+ nil default-directory nil)
+ (let ((cie ()))
+ (dolist (ext completion-ignored-extensions)
+ (if (eq ?/ (aref ext (1- (length ext)))) (push ext cie)))
+ (setq cie (concat (regexp-opt cie "\\(?:") "\\'"))
+ (lexical-let* ((default (and buffer-file-name
+ (abbreviate-file-name buffer-file-name)))
+ (cie cie)
+ (completion-table
+ ;; We need a mix of read-file-name and
+ ;; read-directory-name so that completion to directories
+ ;; is preferred, but if the user wants to enter a global
+ ;; pattern, he can still use completion on filenames to
+ ;; help him write the pattern.
+ ;; Essentially, we want to use
+ ;; (completion-table-with-predicate
+ ;; 'read-file-name-internal 'file-directory-p nil)
+ ;; but that doesn't work because read-file-name-internal
+ ;; does not obey its `predicate' argument.
+ (completion-table-in-turn
+ (lambda (str pred action)
+ (let ((read-file-name-predicate
+ (lambda (f)
+ (and (not (member f '("./" "../")))
+ ;; Hack! Faster than file-directory-p!
+ (eq (aref f (1- (length f))) ?/)
+ (not (string-match cie f))))))
+ (complete-with-action
+ action 'read-file-name-internal str nil)))
+ 'read-file-name-internal)))
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (setq minibuffer-default default)
+ (setq minibuffer-completion-table completion-table))
+ (read-file-name (format "Dired %s(directory): " str)
+ nil default-directory nil))))))))
;;;###autoload (define-key ctl-x-map "d" 'dired)
;;;###autoload
(and (stringp dirname)
(not (when noconfirm (file-remote-p dirname)))
(file-readable-p dirname)
+ ;; Do not auto-revert when the dired buffer can be currently
+ ;; written by the user as in `wdired-mode'.
+ buffer-read-only
(dired-directory-changed-p dirname))))
-;; Separate function from dired-noselect for the sake of dired-vms.el.
(defun dired-internal-noselect (dir-or-list &optional switches mode)
;; If there is an existing dired buffer for DIRNAME, just leave
;; buffer as it is (don't even call dired-revert).
(make-local-variable 'file-name-coding-system)
(setq file-name-coding-system
(or coding-system-for-read file-name-coding-system))
- (let (buffer-read-only
+ (let ((inhibit-read-only t)
;; Don't make undo entries for readin.
(buffer-undo-list t))
(widen)
;; Insert text at the beginning to standardize things.
(save-excursion
(goto-char opoint)
- (if (and (or hdr wildcard) (not (looking-at "^ /.*:$")))
+ (if (and (or hdr wildcard)
+ (not (and (looking-at "^ \\(.*\\):$")
+ (file-name-absolute-p (match-string 1)))))
;; Note that dired-build-subdir-alist will replace the name
;; by its expansion, so it does not matter whether what we insert
;; here is fully expanded, but it should be absolute.
(dired-move-to-end-of-filename)
(point))
'(mouse-face highlight
+ dired-filename t
help-echo "mouse-2: visit this file in other window")))
(error nil))
(forward-line 1))))
(hidden-subdirs (dired-remember-hidden))
(old-subdir-alist (cdr (reverse dired-subdir-alist))) ; except pwd
(case-fold-search nil) ; we check for upper case ls flags
- buffer-read-only)
+ (inhibit-read-only t))
(goto-char (point-min))
(setq mark-alist;; only after dired-remember-hidden since this unhides:
(dired-remember-marks (point-min) (point-max)))
(defun dired-remember-marks (beg end)
"Return alist of files and their marks, from BEG to END."
(if selective-display ; must unhide to make this work.
- (let (buffer-read-only)
+ (let ((inhibit-read-only t))
(subst-char-in-region beg end ?\r ?\n)))
(let (fil chr alist)
(save-excursion
(define-key map "#" 'dired-flag-auto-save-files)
(define-key map "." 'dired-clean-directory)
(define-key map "~" 'dired-flag-backup-files)
- (define-key map "&" 'dired-flag-garbage-files)
;; Upper case keys (except !) for operating on the marked files
(define-key map "A" 'dired-do-search)
(define-key map "C" 'dired-do-copy)
(define-key map "X" 'dired-do-shell-command)
(define-key map "Z" 'dired-do-compress)
(define-key map "!" 'dired-do-shell-command)
+ (define-key map "&" 'dired-do-async-shell-command)
;; Comparison commands
(define-key map "=" 'dired-diff)
(define-key map "\M-=" 'dired-backup-diff)
(define-key map "%H" 'dired-do-hardlink-regexp)
(define-key map "%R" 'dired-do-rename-regexp)
(define-key map "%S" 'dired-do-symlink-regexp)
+ (define-key map "%&" 'dired-flag-garbage-files)
;; Commands for marking and unmarking.
(define-key map "*" nil)
(define-key map "**" 'dired-mark-executables)
;; hiding
(define-key map "$" 'dired-hide-subdir)
(define-key map "\M-$" 'dired-hide-all)
+ ;; isearch
+ (define-key map (kbd "M-s a C-s") 'dired-do-isearch)
+ (define-key map (kbd "M-s a M-C-s") 'dired-do-isearch-regexp)
+ (define-key map (kbd "M-s f C-s") 'dired-isearch-filenames)
+ (define-key map (kbd "M-s f M-C-s") 'dired-isearch-filenames-regexp)
;; misc
(define-key map "\C-x\C-q" 'dired-toggle-read-only)
(define-key map "?" 'dired-summary)
(define-key map [menu-bar immediate dashes]
'("--"))
+ (define-key map [menu-bar immediate isearch-filenames-regexp]
+ '(menu-item "Isearch Regexp in File Names..." dired-isearch-filenames-regexp
+ :help "Incrementally search for regexp in file names only"))
+ (define-key map [menu-bar immediate isearch-filenames]
+ '(menu-item "Isearch in File Names..." dired-isearch-filenames
+ :help "Incrementally search for string in file names only."))
(define-key map [menu-bar immediate compare-directories]
'(menu-item "Compare Directories..." dired-compare-directories
:help "Mark files with different attributes in two dired buffers"))
(define-key map [menu-bar immediate wdired-mode]
'(menu-item "Edit File Names" wdired-change-to-wdired-mode
:help "Put a dired buffer in a mode in which filenames are editable"
+ :keys "C-x C-q"
:filter (lambda (x) (if (eq major-mode 'dired-mode) x))))
(define-key map [menu-bar regexp]
:help "Add image comment to current or marked files"))
(define-key map
[menu-bar operate image-dired-display-thumbs]
- '(menu-item "Display Image-Dired" image-dired-display-thumbs
- :help "Display image-dired for current or marked image files"))
+ '(menu-item "Display image thumbnails" image-dired-display-thumbs
+ :help "Display image thumbnails for current or marked image files"))
(define-key map [menu-bar operate dashes-3]
'("--"))
(define-key map [menu-bar operate search]
'(menu-item "Search Files..." dired-do-search
:help "Search marked files for regexp"))
+ (define-key map [menu-bar operate isearch-regexp]
+ '(menu-item "Isearch Regexp Files..." dired-do-isearch-regexp
+ :help "Incrementally search marked files for regexp"))
+ (define-key map [menu-bar operate isearch]
+ '(menu-item "Isearch Files..." dired-do-isearch
+ :help "Incrementally search marked files for string"))
(define-key map [menu-bar operate chown]
'(menu-item "Change Owner..." dired-do-chown
:visible (not (memq system-type '(ms-dos windows-nt)))
(when (featurep 'dnd)
(set (make-local-variable 'dnd-protocol-alist)
(append dired-dnd-protocol-alist dnd-protocol-alist)))
+ (add-hook 'isearch-mode-hook 'dired-isearch-filenames-setup nil t)
(run-mode-hooks 'dired-mode-hook))
\f
;; Idiosyncratic dired commands that don't deal with marks.
This doesn't recover lost files, it just undoes changes in the buffer itself.
You can use it to recover marks, killed lines or subdirs."
(interactive)
- (let (buffer-read-only)
+ (let ((inhibit-read-only t))
(undo))
(dired-build-subdir-alist)
(message "Change in dired buffer undone.
;; Get rid of the mouse-face property that file names have.
(set-text-properties 0 (length file) nil file)
;; Unquote names quoted by ls or by dired-insert-directory.
- ;; Using read to unquote is much faster than substituting
- ;; \007 (4 chars) -> ^G (1 char) etc. in a lisp loop.
- (setq file
- (read
- (concat "\""
- ;; Some ls -b don't escape quotes, argh!
- ;; This is not needed for GNU ls, though.
- (or (dired-string-replace-match
- "\\([^\\]\\|\\`\\)\"" file "\\1\\\\\"" nil t)
- file)
- "\"")))
+ (while (string-match
+ "\\(?:[^\\]\\|\\`\\)\\(\\\\[0-7][0-7][0-7]\\)" file)
+ (setq file (replace-match
+ (read (concat "\"" (match-string 1 file) "\""))
+ nil t file 1)))
;; The above `read' will return a unibyte string if FILE
;; contains eight-bit-control/graphic characters.
(if (and enable-multibyte-characters
;;"Convert FILE (a file name relative to DIR) to an absolute file name."
;; We can't always use expand-file-name as this would get rid of `.'
;; or expand in / instead default-directory if DIR=="".
- ;; This should be good enough for ange-ftp, but might easily be
- ;; redefined (for VMS?).
+ ;; This should be good enough for ange-ftp.
;; It should be reasonably fast, though, as it is called in
;; dired-get-filename.
(concat (or dir default-directory) file))
(dired-clear-alist)
(save-excursion
(let* ((count 0)
- (buffer-read-only nil)
+ (inhibit-read-only t)
(buffer-undo-list t)
(switches (or switches dired-actual-switches))
new-dir-name
(defun dired-internal-do-deletions (l arg)
;; L is an alist of files to delete, with their buffer positions.
;; ARG is the prefix arg.
- ;; Filenames are absolute (VMS needs this for logical search paths).
+ ;; Filenames are absolute.
;; (car L) *must* be the *last* (bottommost) file in the dired buffer.
;; That way as changes are made in the buffer they do not shift the
;; lines still to be changed, so the (point) values in L stay valid.
(let (failures);; files better be in reverse order for this loop!
(while l
(goto-char (cdr (car l)))
- (let (buffer-read-only)
+ (let ((inhibit-read-only t))
(condition-case err
(let ((fn (car (car l))))
(dired-delete-file fn dired-recursive-deletes)
(defun dired-delete-entry (file)
(save-excursion
(and (dired-goto-file file)
- (let (buffer-read-only)
+ (let ((inhibit-read-only t))
(delete-region (progn (beginning-of-line) (point))
(save-excursion (forward-line 1) (point))))))
(dired-clean-up-after-deletion file))
(apply function args))))
(defun dired-format-columns-of-files (files)
- ;; Files should be in forward order for this loop.
- ;; i.e., (car files) = first file in buffer.
- ;; Returns the number of lines used.
- (let* ((maxlen (+ 2 (apply 'max (mapcar 'length files))))
- (width (- (window-width (selected-window)) 2))
- (columns (max 1 (/ width maxlen)))
- (nfiles (length files))
- (rows (+ (/ nfiles columns)
- (if (zerop (% nfiles columns)) 0 1)))
- (i 0)
- (j 0))
- (setq files (nconc (copy-sequence files) ; fill up with empty fns
- (make-list (- (* columns rows) nfiles) "")))
- (setcdr (nthcdr (1- (length files)) files) files) ; make circular
- (while (< j rows)
- (while (< i columns)
- (indent-to (* i maxlen))
- (insert (car files))
- (setq files (nthcdr rows files)
- i (1+ i)))
- (insert "\n")
- (setq i 0
- j (1+ j)
- files (cdr files)))
- rows))
+ (let ((beg (point)))
+ (completion--insert-strings files)
+ (put-text-property beg (point) 'mouse-face nil)))
\f
;; Commands to mark or flag file(s) at or near current line.
(following-char))))))
(defun dired-mark-files-in-region (start end)
- (let (buffer-read-only)
+ (let ((inhibit-read-only t))
(if (> start end)
(error "start > end"))
(goto-char start) ; assumed at beginning of line
(interactive "P")
(if (dired-get-subdir)
(save-excursion (dired-mark-subdir-files))
- (let (buffer-read-only)
+ (let ((inhibit-read-only t))
(dired-repeat-over-lines
(prefix-numeric-value arg)
(function (lambda () (delete-char 1) (insert dired-marker-char)))))))
(interactive)
(save-excursion
(goto-char (point-min))
- (let (buffer-read-only)
+ (let ((inhibit-read-only t))
(while (not (eobp))
(or (dired-between-files)
(looking-at dired-re-dot)
(if (or (eq old ?\r) (eq new ?\r))
(ding)
(let ((string (format "\n%c" old))
- (buffer-read-only))
+ (inhibit-read-only t))
(save-excursion
(goto-char (point-min))
(while (search-forward string nil t)
(interactive "cRemove marks (RET means all): \nP")
(save-excursion
(let* ((count 0)
- buffer-read-only case-fold-search query
+ (inhibit-read-only t) case-fold-search query
(string (format "\n%c" mark))
(help-form "\
Type SPC or `y' to unmark one file, DEL or `n' to skip to next,
(message-box
"Dired recursive copies are currently disabled.\nSee the variable `dired-recursive-copies'."))
+(declare-function x-popup-menu "xmenu.c" (position menu))
(defun dired-dnd-do-ask-action (uri)
;; No need to get actions and descriptions from the source,
(declare-function dired-relist-entry "dired-aux" (file))
(declare-function make-symbolic-link "fileio.c")
+;; Only used when (featurep 'dnd).
+(declare-function dnd-get-local-file-name "dnd" (uri &optional must-exist))
+(declare-function dnd-get-local-file-uri "dnd" (uri))
+
(defun dired-dnd-handle-local-file (uri action)
"Copy, move or link a file to the dired directory.
URI is the file to handle, ACTION is one of copy, move, link or ask.
'(dired-mode . dired-restore-desktop-buffer))
\f
-(if (eq system-type 'vax-vms)
- (load "dired-vms"))
-
(provide 'dired)
(run-hooks 'dired-load-hook) ; for your customizations
HCoop / bpt / emacs.git / blobdiff