;;; dired.el --- directory-browsing commands
;; Copyright (C) 1985, 1986, 1992, 1993, 1994, 1995, 1996, 1997, 2000,
-;; 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>
;; Maintainer: FSF
;; 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
(defcustom dired-listing-switches "-al"
- "*Switches passed to `ls' for Dired. MUST contain the `l' option.
+ "Switches passed to `ls' for Dired. MUST contain the `l' option.
May contain all other options that don't contradict `-l';
may contain even `F', `b', `i' and `s'. See also the variable
`dired-ls-F-marks-symlinks' concerning the `F' switch.
;;;###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"
;;;###autoload
(defcustom dired-ls-F-marks-symlinks nil
- "*Informs Dired about how `ls -lF' marks symbolic links.
+ "Informs Dired about how `ls -lF' marks symbolic links.
Set this to t if `ls' (or whatever program is specified by
`insert-directory-program') with `-lF' marks the symbolic link
itself with a trailing @ (usually the case under Ultrix).
;;;###autoload
(defcustom dired-trivial-filenames "^\\.\\.?$\\|^#"
- "*Regexp of files to skip when finding first file of a directory.
+ "Regexp of files to skip when finding first file of a directory.
A value of nil means move to the subdir line.
A value of t means move to first file."
:type '(choice (const :tag "Move to subdir" nil)
;;;###autoload
(defcustom dired-keep-marker-rename t
;; Use t as default so that moved files "take their markers with them".
- "*Controls marking of renamed files.
+ "Controls marking of renamed files.
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."
;;;###autoload
(defcustom dired-keep-marker-copy ?C
- "*Controls marking of copied files.
+ "Controls marking of copied files.
If t, copied files are marked if and as the corresponding original files were.
If a character, copied files are unconditionally marked with that character."
:type '(choice (const :tag "Keep" t)
;;;###autoload
(defcustom dired-keep-marker-hardlink ?H
- "*Controls marking of newly made hard links.
+ "Controls marking of newly made hard links.
If t, they are marked if and as the files linked to were marked.
If a character, new links are unconditionally marked with that character."
:type '(choice (const :tag "Keep" t)
;;;###autoload
(defcustom dired-keep-marker-symlink ?Y
- "*Controls marking of newly made symbolic links.
+ "Controls marking of newly made symbolic links.
If t, they are marked if and as the files linked to were marked.
If a character, new links are unconditionally marked with that character."
:type '(choice (const :tag "Keep" t)
;;;###autoload
(defcustom dired-dwim-target nil
- "*If non-nil, Dired tries to guess a default target directory.
+ "If non-nil, Dired tries to guess a default target directory.
This means: if there is a dired buffer displayed in the next window,
use its current subdir, instead of the current subdir of this dired buffer.
;;;###autoload
(defcustom dired-copy-preserve-time t
- "*If non-nil, Dired preserves the last-modified time in a file copy.
+ "If non-nil, Dired preserves the last-modified time in a file copy.
\(This works on only some systems.)"
:type 'boolean
:group 'dired)
(defvar dired-warning-face 'dired-warning
"Face name used for a part of a buffer that needs user attention.")
-(defface dired-warn-writable
+(defface dired-perm-write
'((((type w32 pc)) :inherit default) ;; These default to rw-rw-rw.
- (t (:inherit font-lock-warning-face)))
+ ;; Inherit from font-lock-comment-delimiter-face since with min-colors 8
+ ;; font-lock-comment-face is not colored any more.
+ (t (:inherit font-lock-comment-delimiter-face)))
"Face used to highlight permissions of group- and world-writable files."
:group 'dired-faces
:version "22.2")
-(defvar dired-warn-writable-face 'dired-warn-writable
+(defvar dired-perm-write-face 'dired-perm-write
"Face name used for permissions of group- and world-writable files.")
(defface dired-directory
(defvar dired-font-lock-keywords
(list
- ;;
- ;; Directory headers.
- (list dired-subdir-regexp '(1 dired-header-face))
;;
;; Dired marks.
(list dired-re-mark '(0 dired-mark-face))
;; fields with keymaps to frob the permissions, somewhat a la XEmacs.
(list (concat dired-re-maybe-mark dired-re-inode-size
"[-d]....\\(w\\)....") ; group writable
- '(1 dired-warn-writable-face))
+ '(1 dired-perm-write-face))
(list (concat dired-re-maybe-mark dired-re-inode-size
"[-d].......\\(w\\).") ; world writable
- '(1 dired-warn-writable-face))
+ '(1 dired-perm-write-face))
;;
;; Subdirectories.
(list dired-re-dir
(unless (get-text-property (1- (point)) 'mouse-face)
(dired-move-to-filename)))
nil (0 dired-ignored-face))))
+ ;;
+ ;; Explicitly put the default face on file names ending in a colon to
+ ;; avoid fontifying them as directory header.
+ (list (concat dired-re-maybe-mark dired-re-inode-size dired-re-perms ".*:$")
+ '(".+" (dired-move-to-filename) nil (0 default)))
+ ;;
+ ;; Directory headers.
+ (list dired-subdir-regexp '(1 dired-header-face))
)
"Additional expressions to highlight in Dired mode.")
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.
(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)))))
+ (let ((default (and buffer-file-name
+ (abbreviate-file-name buffer-file-name))))
+ (minibuffer-with-setup-hook
+ (lambda () (setq minibuffer-default default))
+ (read-file-name (format "Dired %s(directory): " str)
+ nil default-directory nil)))))))
+
+;; We want to switch to a more sophisticated version of
+;; dired-read-dir-and-switches like the following, if there is a way
+;; to make it more intuitive. See bug#1285.
+
+;; (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)
+;; (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 "\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
+ :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.
"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)
;; 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))
(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
;; Deleting files
(defcustom dired-recursive-deletes 'top
- "*Decide whether recursive deletes are allowed.
+ "Decide whether recursive deletes are allowed.
A value of nil means no recursive deletes.
`always' means delete recursively without asking. This is DANGEROUS!
`top' means ask for each directory at top level, but delete its subdirectories
(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))
(if (= 1 count) "" "s"))
(defun dired-mark-prompt (arg files)
- ;; Return a string for use in a prompt, either the current file
- ;; name, or the marker and a count of marked files.
+ "Return a string for use in a prompt, either the current file
+name, or the marker and a count of marked files."
+ ;; distinguish-one-marked can cause the first element to be just t.
+ (if (eq (car files) t) (setq files (cdr files)))
(let ((count (length files)))
(if (= count 1)
(car files)
(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,
;;;; Drag and drop support
(defcustom dired-recursive-copies 'top
- "*Decide whether recursive copies are allowed.
+ "Decide whether recursive copies are allowed.
A value of nil means no recursive copies.
`always' means copy recursively without asking.
`top' means ask for each directory at top level.
(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'."))
+(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,
(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-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