;; 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:
;;; Code:
+(eval-when-compile (require 'cl))
+
;;; Customizable variables
(defgroup dired nil
;;;###autoload
(defvar dired-chown-program
- (if (memq system-type '(hpux dgux usg-unix-v irix linux gnu/linux cygwin))
+ (if (memq system-type '(hpux usg-unix-v irix linux gnu/linux cygwin))
"chown"
(if (file-exists-p "/usr/sbin/chown")
"/usr/sbin/chown"
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))
;;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.
(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)
- (read-file-name (format "Dired %s(directory): " str)
- nil default-directory nil)))))
+ (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
(file-readable-p dirname)
(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 "\177" 'dired-unmark-backward)
(define-key map [remap undo] 'dired-undo)
(define-key map "\C-tf" 'image-dired-mark-tagged-files)
(define-key map "\C-t\C-t" 'image-dired-dired-insert-marked-thumbs)
(define-key map "\C-te" 'image-dired-dired-edit-comment-and-tags)
+ ;; encryption and decryption (epa-dired)
+ (define-key map ":d" 'epa-dired-do-decrypt)
+ (define-key map ":v" 'epa-dired-do-verify)
+ (define-key map ":s" 'epa-dired-do-sign)
+ (define-key map ":e" 'epa-dired-do-encrypt)
;; Make menu bar items.
(define-key map [menu-bar immediate]
(cons "Immediate" (make-sparse-keymap "Immediate")))
+ (define-key map
+ [menu-bar immediate epa-dired-do-decrypt]
+ '(menu-item "Decrypt" epa-dired-do-decrypt
+ :help "Decrypt file at cursor"))
+
+ (define-key map
+ [menu-bar immediate epa-dired-do-verify]
+ '(menu-item "Verify" epa-dired-do-verify
+ :help "Verify digital signature of file at cursor"))
+
+ (define-key map
+ [menu-bar immediate epa-dired-do-sign]
+ '(menu-item "Sign" epa-dired-do-sign
+ :help "Create digital signature of file at cursor"))
+
+ (define-key map
+ [menu-bar immediate epa-dired-do-encrypt]
+ '(menu-item "Encrypt" epa-dired-do-encrypt
+ :help "Encrypt file at cursor"))
+
+ (define-key map [menu-bar immediate dashes-4]
+ '("--"))
+
(define-key map
[menu-bar immediate image-dired-dired-display-external]
'(menu-item "Display Image Externally" image-dired-dired-display-external
(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"))
'(menu-item "Find This File" dired-find-file
:help "Edit file at cursor"))
(define-key map [menu-bar immediate create-directory]
- '(menu-item "Create Directory..." dired-create-directory))
+ '(menu-item "Create Directory..." dired-create-directory
+ :help "Create a directory"))
(define-key map [menu-bar immediate wdired-mode]
- '(menu-item "Edit File Names" wdired-change-to-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]
(cons "Regexp" (make-sparse-keymap "Regexp")))
(define-key map [menu-bar operate]
(cons "Operate" (make-sparse-keymap "Operate")))
+
(define-key map
[menu-bar operate image-dired-delete-tag]
'(menu-item "Delete Image Tag..." image-dired-delete-tag
: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.
Actual changes in files cannot be undone by Emacs."))
+(defun dired-toggle-read-only ()
+ "Edit dired buffer with Wdired, or set it read-only.
+Call `wdired-change-to-wdired-mode' in dired buffers whose editing is
+supported by Wdired (the major mode of the dired buffer is `dired-mode').
+Otherwise, for buffers inheriting from dired-mode, call `toggle-read-only'."
+ (interactive)
+ (if (eq major-mode 'dired-mode)
+ (wdired-change-to-wdired-mode)
+ (toggle-read-only)))
+
(defun dired-next-line (arg)
"Move down lines then position at filename.
Optional prefix ARG says how many lines to move; default is one line."
(interactive "p")
- (next-line arg)
+ (forward-line arg)
(dired-move-to-filename))
(defun dired-previous-line (arg)
"Move up lines then position at filename.
Optional prefix ARG says how many lines to move; default is one line."
(interactive "p")
- (previous-line arg)
+ (forward-line (- arg))
(dired-move-to-filename))
(defun dired-next-dirline (arg &optional opoint)
;;"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))
(forward-char -1))))
(or no-error
(not (eq opoint (point)))
- (error (if hidden
+ (error "%s" (if hidden
(substitute-command-keys
"File line is hidden, type \\[dired-hide-subdir] to unhide")
"No file on this line")))
(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
"In Dired, delete the files flagged for deletion.
If NOMESSAGE is non-nil, we don't display any message
if there are no flagged files.
-`dired-recursive-deletes' controls whether
-deletion of non-empty directories is allowed."
+`dired-recursive-deletes' controls whether deletion of
+non-empty directories is allowed."
(interactive)
(let* ((dired-marker-char dired-del-marker)
(regexp (dired-marker-regexp))
(defun dired-do-delete (&optional arg)
"Delete all marked (or next ARG) files.
-`dired-recursive-deletes' controls whether
-deletion of non-empty directories is allowed."
+`dired-recursive-deletes' controls whether deletion of
+non-empty directories is allowed."
;; This is more consistent with the file marking feature than
;; dired-do-flagged-delete.
(interactive "P")
(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,
(defun dired-dnd-popup-notice ()
(message-box
- "Recursive copies not enabled.\nSee variable dired-recursive-copies."))
+ "Dired recursive copies are currently disabled.\nSee the variable `dired-recursive-copies'."))
(defun dired-dnd-do-ask-action (uri)
(dired-dnd-handle-local-file uri action)
nil)))
+(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.
Ask means pop up a menu for the user to select one of copy, move or link."
(require 'dired-aux)
(let* ((from (dnd-get-local-file-name uri t))
- (to (if from (concat (dired-current-directory)
- (file-name-nondirectory from))
- nil)))
- (if from
- (cond ((or (eq action 'copy)
- (eq action 'private)) ; Treat private as copy.
-
- ;; If copying a directory and dired-recursive-copies is nil,
- ;; dired-copy-file silently fails. Pop up a notice.
- (if (and (file-directory-p from)
- (not dired-recursive-copies))
- (dired-dnd-popup-notice)
- (progn
- (dired-copy-file from to 1)
- (dired-relist-entry to)
- action)))
-
- ((eq action 'move)
- (dired-rename-file from to 1)
- (dired-relist-entry to)
- action)
-
- ((eq action 'link)
- (make-symbolic-link from to 1)
- (dired-relist-entry to)
- action)
-
- ((eq action 'ask)
- (dired-dnd-do-ask-action uri))
-
- (t nil)))))
+ (to (when from
+ (concat (dired-current-directory)
+ (file-name-nondirectory from)))))
+ (when from
+ (cond ((eq action 'ask)
+ (dired-dnd-do-ask-action uri))
+ ;; If copying a directory and dired-recursive-copies is
+ ;; nil, dired-copy-file fails. Pop up a notice.
+ ((and (memq action '(copy private))
+ (file-directory-p from)
+ (not dired-recursive-copies))
+ (dired-dnd-popup-notice))
+ ((memq action '(copy private move link))
+ (let ((overwrite (and (file-exists-p to)
+ (y-or-n-p
+ (format "Overwrite existing file `%s'? " to))))
+ ;; Binding dired-overwrite-confirmed to nil makes
+ ;; dired-handle-overwrite a no-op. We instead use
+ ;; y-or-n-p, which pops a graphical menu.
+ dired-overwrite-confirmed backup-file)
+ (when (and overwrite
+ ;; d-b-o is defined in dired-aux.
+ (boundp 'dired-backup-overwrite)
+ dired-backup-overwrite
+ (setq backup-file
+ (car (find-backup-file-name to)))
+ (or (eq dired-backup-overwrite 'always)
+ (y-or-n-p
+ (format
+ "Make backup for existing file `%s'? " to))))
+ (rename-file to backup-file 0)
+ (dired-relist-entry backup-file))
+ (cond ((memq action '(copy private))
+ (dired-copy-file from to overwrite))
+ ((eq action 'move)
+ (dired-rename-file from to overwrite))
+ ((eq action 'link)
+ (make-symbolic-link from to overwrite)))
+ (dired-relist-entry to)
+ action))))))
(defun dired-dnd-handle-file (uri action)
"Copy, move or link a file to the dired directory if it is a local file.
(dired dired-dir)
;; The following elements of `desktop-buffer-misc' are the keys
;; from `dired-subdir-alist'.
- (mapcar 'dired-maybe-insert-subdir (cdr desktop-buffer-misc))
+ (mapc 'dired-maybe-insert-subdir (cdr desktop-buffer-misc))
(current-buffer))
(message "Desktop: Directory %s no longer exists." dir)
(when desktop-missing-file-warning (sit-for 1))
'(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