(defgroup dired nil
"Directory editing."
:link '(custom-manual "(emacs)Dired")
:group 'files)
(defgroup dired-mark nil
"Handling marks in Dired."
:prefix "dired-"
:group 'dired)
(defcustom dired-listing-switches "-al"
"*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.
On systems such as MS-DOS and MS-Windows, which use `ls' emulation in Lisp,
some of the `ls' switches are not supported; see the doc string of
`insert-directory' in `ls-lisp.el' for more details."
:type 'string
:group 'dired)
(defvar dired-subdir-switches nil
"If non-nil, switches passed to `ls' for inserting subdirectories.
If nil, `dired-listing-switches' is used.")
(defvar dired-chown-program
(if (memq system-type '(hpux dgux usg-unix-v irix linux gnu/linux cygwin))
"chown"
(if (file-exists-p "/usr/sbin/chown")
"/usr/sbin/chown"
"/etc/chown"))
"Name of chown command (usually `chown' or `/etc/chown').")
(defvar dired-use-ls-dired (not (not (string-match "gnu" system-configuration)))
"Non-nil means Dired should use `ls --dired'.")
(defvar dired-chmod-program "chmod"
"Name of chmod command (usually `chmod').")
(defvar dired-touch-program "touch"
"Name of touch command (usually `touch').")
(defcustom dired-ls-F-marks-symlinks nil
"*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).
Example: if `ln -s foo bar; ls -F bar' gives `bar -> foo', set it to
nil (the default), if it gives `bar@ -> foo', set it to t.
Dired checks if there is really a @ appended. Thus, if you have a
marking `ls' program on one host and a non-marking on another host, and
don't care about symbolic links which really end in a @, you can
always set this variable to t."
:type 'boolean
:group 'dired-mark)
(defcustom dired-trivial-filenames "^\\.\\.?$\\|^#"
"*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)
(const :tag "Move to first" t)
regexp)
:group 'dired)
(defcustom dired-keep-marker-rename t
"*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."
:type '(choice (const :tag "Keep" t)
(character :tag "Mark"))
:group 'dired-mark)
(defcustom dired-keep-marker-copy ?C
"*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)
(character :tag "Mark"))
:group 'dired-mark)
(defcustom dired-keep-marker-hardlink ?H
"*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)
(character :tag "Mark"))
:group 'dired-mark)
(defcustom dired-keep-marker-symlink ?Y
"*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)
(character :tag "Mark"))
:group 'dired-mark)
(defcustom dired-dwim-target nil
"*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.
The target is used in the prompt for file copy, rename etc."
:type 'boolean
:group 'dired)
(defcustom dired-copy-preserve-time t
"*If non-nil, Dired preserves the last-modified time in a file copy.
\(This works on only some systems.)"
:type 'boolean
:group 'dired)
(defvaralias 'dired-free-space-program 'directory-free-space-program)
(defvaralias 'dired-free-space-args 'directory-free-space-args)
(defcustom dired-load-hook nil
"Run after loading Dired.
You can customize key bindings or load extensions with this."
:group 'dired
:type 'hook)
(defcustom dired-mode-hook nil
"Run at the very end of `dired-mode'."
:group 'dired
:type 'hook)
(defcustom dired-before-readin-hook nil
"This hook is run before a dired buffer is read in (created or reverted)."
:group 'dired
:type 'hook)
(defcustom dired-after-readin-hook nil
"Hook run after each time a file or directory is read by Dired.
After each listing of a file or directory, this hook is run
with the buffer narrowed to the listing."
:group 'dired
:type 'hook)
(defcustom dired-dnd-protocol-alist
'(("^file:///" . dired-dnd-handle-local-file)
("^file://" . dired-dnd-handle-file)
("^file:" . dired-dnd-handle-local-file))
"The functions to call when a drop in `dired-mode' is made.
See `dnd-protocol-alist' for more information. When nil, behave
as in other buffers. Changing this option is effective only for
new dired buffers."
:type '(choice (repeat (cons (regexp) (function)))
(const :tag "Behave as in other buffers" nil))
:version "22.1"
:group 'dired)
(defvar dired-marker-char ?* "In Dired, the current mark character.
This is what the do-commands look for, and what the mark-commands store.")
(defvar dired-del-marker ?D
"Character used to flag files for deletion.")
(defvar dired-shrink-to-fit t
"Non-nil means Dired shrinks the display buffer to fit the marked files.")
(defvar dired-flagging-regexp nil)
(defvar dired-file-version-alist)
(defvar dired-directory nil
"The directory name or wildcard spec that this dired directory lists.
Local to each dired buffer. May be a list, in which case the car is the
directory name and the cdr is the list of files to mention.
The directory name must be absolute, but need not be fully expanded.")
(defvar dired-actual-switches nil
"The value of `dired-listing-switches' used to make this buffer's text.")
(defvar dired-re-inode-size "[0-9 \t]*"
"Regexp for optional initial inode and file size as made by `ls -i -s'.")
(defvar dired-re-mark "^[^ \n]")
(defvar dired-re-maybe-mark "^. ")
(defvar dired-re-dir (concat dired-re-maybe-mark dired-re-inode-size "d[^:]"))
(defvar dired-re-sym (concat dired-re-maybe-mark dired-re-inode-size "l[^:]"))
(defvar dired-re-exe (mapconcat (function
(lambda (x)
(concat dired-re-maybe-mark dired-re-inode-size x)))
'("-[-r][-w][xs][-r][-w].[-r][-w]."
"-[-r][-w].[-r][-w][xs][-r][-w]."
"-[-r][-w].[-r][-w].[-r][-w][xst]")
"\\|"))
(defvar dired-re-perms "[-bcdlps][-r][-w].[-r][-w].[-r][-w].")
(defvar dired-re-dot "^.* \\.\\.?/?$")
(defvar dired-subdir-alist nil
"Association list of subdirectories and their buffer positions.
Each subdirectory has an element: (DIRNAME . STARTMARKER).
The order of elements is the reverse of the order in the buffer.
In simple cases, this list contains one element.")
(defvar dired-switches-alist nil
"Keeps track of which switches to use for inserted subdirectories.
This is an alist of the form (SUBDIR . SWITCHES).")
(make-variable-buffer-local 'dired-switches-alist)
(defvaralias 'dired-move-to-filename-regexp
'directory-listing-before-filename-regexp)
(defvar dired-subdir-regexp "^. \\([^\n\r]+\\)\\(:\\)[\n\r]"
"Regexp matching a maybe hidden subdirectory line in `ls -lR' output.
Subexpression 1 is the subdirectory proper, no trailing colon.
The match starts at the beginning of the line and ends after the end
of the line (\\n or \\r).
Subexpression 2 must end right before the \\n or \\r.")
(defgroup dired-faces nil
"Faces used by Dired."
:group 'dired
:group 'faces)
(defface dired-header
'((t (:inherit font-lock-type-face)))
"Face used for directory headers."
:group 'dired-faces
:version "22.1")
(defvar dired-header-face 'dired-header
"Face name used for directory headers.")
(defface dired-mark
'((t (:inherit font-lock-constant-face)))
"Face used for dired marks."
:group 'dired-faces
:version "22.1")
(defvar dired-mark-face 'dired-mark
"Face name used for dired marks.")
(defface dired-marked
'((t (:inherit font-lock-warning-face)))
"Face used for marked files."
:group 'dired-faces
:version "22.1")
(defvar dired-marked-face 'dired-marked
"Face name used for marked files.")
(defface dired-flagged
'((t (:inherit font-lock-warning-face)))
"Face used for flagged files."
:group 'dired-faces
:version "22.1")
(defvar dired-flagged-face 'dired-flagged
"Face name used for flagged files.")
(defface dired-warning
'((t (:inherit font-lock-comment-face)))
"Face used to highlight a part of a buffer that needs user attention."
:group 'dired-faces
:version "22.1")
(defvar dired-warning-face 'dired-warning
"Face name used for a part of a buffer that needs user attention.")
(defface dired-directory
'((t (:inherit font-lock-function-name-face)))
"Face used for subdirectories."
:group 'dired-faces
:version "22.1")
(defvar dired-directory-face 'dired-directory
"Face name used for subdirectories.")
(defface dired-symlink
'((t (:inherit font-lock-keyword-face)))
"Face used for symbolic links."
:group 'dired-faces
:version "22.1")
(defvar dired-symlink-face 'dired-symlink
"Face name used for symbolic links.")
(defface dired-ignored
'((t (:inherit shadow)))
"Face used for files suffixed with `completion-ignored-extensions'."
:group 'dired-faces
:version "22.1")
(defvar dired-ignored-face 'dired-ignored
"Face name used for files suffixed with `completion-ignored-extensions'.")
(defvar dired-font-lock-keywords
(list
(list dired-subdir-regexp '(1 dired-header-face))
(list dired-re-mark '(0 dired-mark-face))
(list (concat "^[" (char-to-string dired-marker-char) "]")
'(".+" (dired-move-to-filename) nil (0 dired-marked-face)))
(list (concat "^[" (char-to-string dired-del-marker) "]")
'(".+" (dired-move-to-filename) nil (0 dired-flagged-face)))
(list (concat dired-re-maybe-mark dired-re-inode-size
"[-d]....\\(w\\)....") '(1 dired-warning-face))
(list (concat dired-re-maybe-mark dired-re-inode-size
"[-d].......\\(w\\).") '(1 dired-warning-face))
(list dired-re-dir
'(".+" (dired-move-to-filename) nil (0 dired-directory-face)))
(list dired-re-sym
'(".+" (dired-move-to-filename) nil (0 dired-symlink-face)))
'(eval .
(list (concat "\\(" (regexp-opt completion-ignored-extensions) "\\|#\\)$")
'(".+" (dired-move-to-filename) nil (0 dired-ignored-face))))
'(eval .
(list (concat "\\(" (regexp-opt completion-ignored-extensions)
"\\|#\\)[*=|]$")
'(".+" (progn
(end-of-line)
(unless (get-text-property (1- (point)) 'mouse-face)
(dired-move-to-filename)))
nil (0 dired-ignored-face))))
)
"Additional expressions to highlight in Dired mode.")
(defvar dnd-protocol-alist)
(defmacro dired-mark-if (predicate msg)
"Mark all files for which PREDICATE evals to non-nil.
PREDICATE is evaluated on each line, with point at beginning of line.
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)
(save-excursion
(setq count 0)
(if ,msg (message "Marking %ss..." ,msg))
(goto-char (point-min))
(while (not (eobp))
(if ,predicate
(progn
(delete-char 1)
(insert dired-marker-char)
(setq count (1+ count))))
(forward-line 1))
(if ,msg (message "%s %s%s %s%s."
count
,msg
(dired-plural-s count)
(if (eq dired-marker-char ?\040) "un" "")
(if (eq dired-marker-char dired-del-marker)
"flagged" "marked"))))
(and (> count 0) count)))
(defmacro dired-map-over-marks (body arg &optional show-progress
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.
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.
BODY must ensure this itself if it depends on this.
Search starts at the beginning of the buffer, thus the car of the list
corresponds to the line nearest to the buffer's bottom. This
is also true for (positive and negative) integer values of ARG.
BODY should not be too long as it is expanded four times.
If DISTINGUISH-ONE-MARKED is non-nil, then if we find just one marked file,
return (t FILENAME) instead of (FILENAME)."
`(prog1
(let (buffer-read-only case-fold-search found results)
(if ,arg
(if (integerp ,arg)
(progn (dired-repeat-over-lines
,arg
(function (lambda ()
(if ,show-progress (sit-for 0))
(setq results (cons ,body results)))))
(if (< ,arg 0)
(nreverse results)
results))
(list ,body))
(let ((regexp (dired-marker-regexp)) next-position)
(save-excursion
(goto-char (point-min))
(setq next-position (and (re-search-forward regexp nil t)
(point-marker))
found (not (null next-position)))
(while next-position
(goto-char next-position)
(if ,show-progress (sit-for 0))
(setq results (cons ,body results))
(goto-char next-position)
(forward-line 1)
(set-marker next-position nil)
(setq next-position (and (re-search-forward regexp nil t)
(point-marker)))))
(if (and ,distinguish-one-marked (= (length results) 1))
(setq results (cons t results)))
(if found
results
(list ,body)))))
(dired-move-to-filename)))
(defun dired-get-marked-files (&optional localp arg filter distinguish-one-marked)
"Return the marked files' names as list of strings.
The list is in the same order as the buffer, that is, the car is the
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 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 DISTINGUISH-ONE-MARKED is non-nil, then if we find just one marked file,
return (t FILENAME) instead of (FILENAME).
Don't use that together with FILTER."
(let* ((all-of-them
(save-excursion
(dired-map-over-marks
(dired-get-filename localp)
arg nil distinguish-one-marked)))
result)
(if (not filter)
(if (and distinguish-one-marked (eq (car all-of-them) t))
all-of-them
(nreverse all-of-them))
(dolist (file all-of-them)
(if (funcall filter file)
(push file result)))
result)))
(defun dired-read-dir-and-switches (str)
(reverse (list
(if current-prefix-arg
(read-string "Dired listing switches: "
dired-listing-switches))
(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)))))
(defun dired (dirname &optional switches)
"\"Edit\" directory DIRNAME--delete, rename, print, etc. some files in it.
Optional second argument SWITCHES specifies the `ls' options used.
\(Interactively, use a prefix argument to be able to specify SWITCHES.)
Dired displays a list of files in DIRNAME (which may also have
shell wildcards appended to select certain files). If DIRNAME is a cons,
its first element is taken as the directory name and the rest as an explicit
list of files to make directory entries for.
\\<dired-mode-map>\
You can move around in it with the usual commands.
You can flag files for deletion with \\[dired-flag-file-deletion] and then
delete them by typing \\[dired-do-flagged-delete].
Type \\[describe-mode] after entering Dired for more info.
If DIRNAME is already in a dired buffer, that buffer is used without refresh."
(interactive (dired-read-dir-and-switches ""))
(switch-to-buffer (dired-noselect dirname switches)))
(defun dired-other-window (dirname &optional switches)
"\"Edit\" directory DIRNAME. Like `dired' but selects in another window."
(interactive (dired-read-dir-and-switches "in other window "))
(switch-to-buffer-other-window (dired-noselect dirname switches)))
(defun dired-other-frame (dirname &optional switches)
"\"Edit\" directory DIRNAME. Like `dired' but makes a new frame."
(interactive (dired-read-dir-and-switches "in other frame "))
(switch-to-buffer-other-frame (dired-noselect dirname switches)))
(defun dired-noselect (dir-or-list &optional switches)
"Like `dired' but returns the dired buffer as value, does not select it."
(or dir-or-list (setq dir-or-list default-directory))
(let (dirname initially-was-dirname)
(if (consp dir-or-list)
(setq dirname (car dir-or-list))
(setq dirname dir-or-list))
(setq initially-was-dirname
(string= (file-name-as-directory dirname) dirname))
(setq dirname (abbreviate-file-name
(expand-file-name (directory-file-name dirname))))
(if find-file-visit-truename
(setq dirname (file-truename dirname)))
(if (or initially-was-dirname (file-directory-p dirname))
(setq dirname (file-name-as-directory dirname)))
(if (consp dir-or-list)
(setq dir-or-list (cons dirname (cdr dir-or-list)))
(setq dir-or-list dirname))
(dired-internal-noselect dir-or-list switches)))
(defun dired-directory-changed-p (dirname)
(not (let ((attributes (file-attributes dirname))
(modtime (visited-file-modtime)))
(or (eq modtime 0)
(not (eq (car attributes) t))
(equal (nth 5 attributes) modtime)))))
(defun dired-buffer-stale-p (&optional noconfirm)
"Return non-nil if current dired buffer needs updating.
If NOCONFIRM is non-nil, then this function always returns nil
for a remote directory. This feature is used by Auto Revert Mode."
(let ((dirname
(if (consp dired-directory) (car dired-directory) dired-directory)))
(and (stringp dirname)
(not (when noconfirm (file-remote-p dirname)))
(file-readable-p dirname)
(dired-directory-changed-p dirname))))
(defun dired-internal-noselect (dir-or-list &optional switches mode)
(let* (dirname
buffer
new-buffer-p
(old-buf (current-buffer)))
(if (consp dir-or-list)
(setq dirname (car dir-or-list))
(setq dirname dir-or-list))
(setq buffer (dired-find-buffer-nocreate dirname mode)
new-buffer-p (null buffer))
(or buffer
(let ((default-major-mode 'fundamental-mode))
(setq buffer (create-file-buffer (directory-file-name dirname)))))
(set-buffer buffer)
(if (not new-buffer-p) (cond (switches (setq dired-directory dir-or-list)
(dired-sort-other switches))
((when (dired-directory-changed-p dirname)
(message "%s"
(substitute-command-keys
"Directory has changed on disk; type \\[revert-buffer] to update Dired")))))
(setq default-directory
(file-name-directory dirname))
(or switches (setq switches dired-listing-switches))
(if mode (funcall mode)
(dired-mode dir-or-list switches))
(let ((failed t))
(unwind-protect
(progn (dired-readin)
(setq failed nil))
(if failed (kill-buffer buffer))))
(goto-char (point-min))
(dired-initial-position dirname))
(set-buffer old-buf)
buffer))
(defvar dired-buffers nil
"Alist of expanded directories and their associated dired buffers.")
(defun dired-find-buffer-nocreate (dirname &optional mode)
(setq dirname (expand-file-name dirname))
(let (found (blist dired-buffers)) (or mode (setq mode 'dired-mode))
(while blist
(if (null (buffer-name (cdr (car blist))))
(setq blist (cdr blist))
(save-excursion
(set-buffer (cdr (car blist)))
(if (and (eq major-mode mode)
dired-directory (equal dirname
(expand-file-name
(if (consp dired-directory)
(car dired-directory)
dired-directory))))
(setq found (cdr (car blist))
blist nil)
(setq blist (cdr blist))))))
found))
(defun dired-readin ()
"Read in a new dired buffer.
Differs from `dired-insert-subdir' in that it accepts
wildcards, erases the buffer, and builds the subdir-alist anew
\(including making it buffer-local and clearing it first)."
(let (dirname)
(if (consp dired-directory)
(setq dirname (car dired-directory))
(setq dirname dired-directory))
(setq dirname (expand-file-name dirname))
(save-excursion
(run-hooks 'dired-before-readin-hook)
(if (consp buffer-undo-list)
(setq buffer-undo-list nil))
(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
(buffer-undo-list t))
(widen)
(erase-buffer)
(dired-readin-insert))
(goto-char (point-min))
(set (make-local-variable 'dired-subdir-alist) nil)
(dired-build-subdir-alist)
(let ((attributes (file-attributes dirname)))
(if (eq (car attributes) t)
(set-visited-file-modtime (nth 5 attributes))))
(set-buffer-modified-p nil)
(run-hooks 'dired-after-readin-hook))))
(defun dired-readin-insert ()
(let (dir file-list)
(if (consp dired-directory)
(setq dir (car dired-directory)
file-list (cdr dired-directory))
(setq dir dired-directory
file-list nil))
(setq dir (expand-file-name dir))
(if (and (equal "" (file-name-nondirectory dir))
(not file-list))
(dired-insert-directory dir dired-actual-switches nil nil t)
(if (not (file-readable-p
(directory-file-name (file-name-directory dir))))
(error "Directory %s inaccessible or nonexistent" dir)
(dired-insert-directory dir dired-actual-switches
file-list (not file-list) t)))))
(defun dired-align-file (beg end)
"Align the fields of a file to the ones of surrounding lines.
BEG..END is the line where the file info is located."
(save-excursion
(let (file file-col other other-col)
(when (and (setq file (progn (goto-char beg)
(dired-move-to-filename nil end)))
(setq file-col (current-column))
(setq other
(or (and (goto-char beg)
(zerop (forward-line -1))
(dired-move-to-filename))
(and (goto-char beg)
(zerop (forward-line 1))
(dired-move-to-filename))))
(setq other-col (current-column))
(/= file other)
(> other-col file-col))
(when (and (< other file)
(goto-char beg)
(zerop (forward-line 1))
(dired-move-to-filename))
(let ((alt-col (current-column)))
(when (< alt-col other-col)
(setq other-col alt-col)
(setq other (point)))))
(if (> other file) (setq other (copy-marker other)))
(setq file (copy-marker file))
(goto-char beg)
(skip-chars-forward " ") (while (and (> other-col file-col)
(> file (point)))
(let* ((curcol (current-column))
(num-align (looking-at "[0-9]"))
(align-pt-offset
(save-excursion
(goto-char other)
(move-to-column curcol)
(when (looking-at
(concat
(if (eq (char-before) ?\s) " *" "[^ ]* *")
(if num-align "[0-9][^ ]*")))
(- (match-end 0) (match-beginning 0)))))
(spaces
(if (not num-align)
align-pt-offset
(and align-pt-offset
(save-excursion
(skip-chars-forward "^ ")
(- align-pt-offset (- (current-column) curcol)))))))
(when (and spaces (> spaces 0))
(setq file-col (+ spaces file-col))
(if (> file-col other-col)
(setq spaces (- spaces (- file-col other-col))))
(insert-char ?\s spaces)
(unless (save-excursion
(eq (dired-move-to-filename) (marker-position file)))
(delete-char (- spaces)))))
(skip-chars-forward "^ ") (skip-chars-forward " "))
(set-marker file nil)))))
(defun dired-insert-directory (dir switches &optional file-list wildcard hdr)
"Insert a directory listing of DIR, Dired style.
Use SWITCHES to make the listings.
If FILE-LIST is non-nil, list only those files.
Otherwise, if WILDCARD is non-nil, expand wildcards;
in that case, DIR should be a file name that uses wildcards.
In other cases, DIR should be a directory name or a directory filename.
If HDR is non-nil, insert a header line with the directory name."
(let ((opoint (point))
(process-environment (copy-sequence process-environment))
end)
(if (or dired-use-ls-dired (file-remote-p dir))
(setq switches (concat "--dired " switches)))
(if file-list
(dolist (f file-list)
(let ((beg (point)))
(insert-directory f switches nil nil)
(dired-align-file beg (point))))
(insert-directory dir switches wildcard (not wildcard)))
(if (not (string-match "b" dired-actual-switches))
(save-excursion
(setq end (point-marker))
(goto-char opoint)
(while (search-forward "\\" end t)
(replace-match (apply #'propertize
"\\\\"
(text-properties-at (match-beginning 0)))
nil t))
(goto-char opoint)
(while (search-forward "\^m" end t)
(replace-match (apply #'propertize
"\\015"
(text-properties-at (match-beginning 0)))
nil t))
(set-marker end nil)))
(dired-insert-set-properties opoint (point))
(unless (save-excursion
(goto-char opoint)
(looking-at " "))
(let ((indent-tabs-mode nil))
(indent-rigidly opoint (point) 2)))
(save-excursion
(goto-char opoint)
(if (and (or hdr wildcard) (not (looking-at "^ /.*:$")))
(insert " " (directory-file-name (file-name-directory dir)) ":\n"))
(when wildcard
(insert " wildcard " (file-name-nondirectory dir) "\n")))))
(defun dired-insert-set-properties (beg end)
"Make the file names highlight when the mouse is on them."
(save-excursion
(goto-char beg)
(while (< (point) end)
(condition-case nil
(if (dired-move-to-filename)
(add-text-properties
(point)
(save-excursion
(dired-move-to-end-of-filename)
(point))
'(mouse-face highlight
help-echo "mouse-2: visit this file in other window")))
(error nil))
(forward-line 1))))
(defun dired-revert (&optional arg noconfirm)
"Reread the dired buffer.
Must also be called after `dired-actual-switches' have changed.
Should not fail even on completely garbaged buffers.
Preserves old cursor, marks/flags, hidden-p."
(widen) (let ((modflag (buffer-modified-p))
(opoint (point))
(ofile (dired-get-filename nil t))
(mark-alist nil) (hidden-subdirs (dired-remember-hidden))
(old-subdir-alist (cdr (reverse dired-subdir-alist))) (case-fold-search nil) buffer-read-only)
(goto-char (point-min))
(setq mark-alist (dired-remember-marks (point-min) (point-max)))
(dired-uncache
(if (consp dired-directory) (car dired-directory) dired-directory))
(let ((dired-after-readin-hook nil))
(dired-readin)
(dired-insert-old-subdirs old-subdir-alist))
(dired-mark-remembered mark-alist) (run-hooks 'dired-after-readin-hook) (or (and ofile (dired-goto-file ofile)) (goto-char opoint)) (dired-move-to-filename)
(save-excursion (dolist (dir hidden-subdirs)
(if (dired-goto-subdir dir)
(dired-hide-subdir 1))))
(unless modflag (restore-buffer-modified-p nil)))
)
(defun dired-remember-marks (beg end)
"Return alist of files and their marks, from BEG to END."
(if selective-display (let (buffer-read-only)
(subst-char-in-region beg end ?\r ?\n)))
(let (fil chr alist)
(save-excursion
(goto-char beg)
(while (re-search-forward dired-re-mark end t)
(if (setq fil (dired-get-filename nil t))
(setq chr (preceding-char)
alist (cons (cons fil chr) alist)))))
alist))
(defun dired-mark-remembered (alist)
"Mark all files remembered in ALIST.
Each element of ALIST looks like (FILE . MARKERCHAR)."
(let (elt fil chr)
(while alist
(setq elt (car alist)
alist (cdr alist)
fil (car elt)
chr (cdr elt))
(if (dired-goto-file fil)
(save-excursion
(beginning-of-line)
(delete-char 1)
(insert chr))))))
(defun dired-remember-hidden ()
"Return a list of names of subdirs currently hidden."
(let ((l dired-subdir-alist) dir pos result)
(while l
(setq dir (car (car l))
pos (cdr (car l))
l (cdr l))
(goto-char pos)
(skip-chars-forward "^\r\n")
(if (eq (following-char) ?\r)
(setq result (cons dir result))))
result))
(defun dired-insert-old-subdirs (old-subdir-alist)
"Try to insert all subdirs that were displayed before.
Do so according to the former subdir alist OLD-SUBDIR-ALIST."
(or (string-match "R" dired-actual-switches)
(let (elt dir)
(while old-subdir-alist
(setq elt (car old-subdir-alist)
old-subdir-alist (cdr old-subdir-alist)
dir (car elt))
(condition-case ()
(progn
(dired-uncache dir)
(dired-insert-subdir dir))
(error nil))))))
(defun dired-uncache (dir)
"Remove directory DIR from any directory cache."
(let ((handler (find-file-name-handler dir 'dired-uncache)))
(if handler
(funcall handler 'dired-uncache dir))))
(defvar dired-mode-map
(let ((map (make-keymap)))
(suppress-keymap map)
(define-key map [mouse-2] 'dired-mouse-find-file-other-window)
(define-key map [follow-link] 'mouse-face)
(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)
(define-key map "A" 'dired-do-search)
(define-key map "C" 'dired-do-copy)
(define-key map "B" 'dired-do-byte-compile)
(define-key map "D" 'dired-do-delete)
(define-key map "G" 'dired-do-chgrp)
(define-key map "H" 'dired-do-hardlink)
(define-key map "L" 'dired-do-load)
(define-key map "M" 'dired-do-chmod)
(define-key map "O" 'dired-do-chown)
(define-key map "P" 'dired-do-print)
(define-key map "Q" 'dired-do-query-replace-regexp)
(define-key map "R" 'dired-do-rename)
(define-key map "S" 'dired-do-symlink)
(define-key map "T" 'dired-do-touch)
(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-diff)
(define-key map "\M-=" 'dired-backup-diff)
(define-key map "\M-\C-?" 'dired-unmark-all-files)
(define-key map "\M-\C-d" 'dired-tree-down)
(define-key map "\M-\C-u" 'dired-tree-up)
(define-key map "\M-\C-n" 'dired-next-subdir)
(define-key map "\M-\C-p" 'dired-prev-subdir)
(define-key map "\M-{" 'dired-prev-marked-file)
(define-key map "\M-}" 'dired-next-marked-file)
(define-key map "%" nil)
(define-key map "%u" 'dired-upcase)
(define-key map "%l" 'dired-downcase)
(define-key map "%d" 'dired-flag-files-regexp)
(define-key map "%g" 'dired-mark-files-containing-regexp)
(define-key map "%m" 'dired-mark-files-regexp)
(define-key map "%r" 'dired-do-rename-regexp)
(define-key map "%C" 'dired-do-copy-regexp)
(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 "*" nil)
(define-key map "**" 'dired-mark-executables)
(define-key map "*/" 'dired-mark-directories)
(define-key map "*@" 'dired-mark-symlinks)
(define-key map "*%" 'dired-mark-files-regexp)
(define-key map "*c" 'dired-change-marks)
(define-key map "*s" 'dired-mark-subdir-files)
(define-key map "*m" 'dired-mark)
(define-key map "*u" 'dired-unmark)
(define-key map "*?" 'dired-unmark-all-files)
(define-key map "*!" 'dired-unmark-all-marks)
(define-key map "U" 'dired-unmark-all-marks)
(define-key map "*\177" 'dired-unmark-backward)
(define-key map "*\C-n" 'dired-next-marked-file)
(define-key map "*\C-p" 'dired-prev-marked-file)
(define-key map "*t" 'dired-toggle-marks)
(define-key map "a" 'dired-find-alternate-file)
(define-key map "d" 'dired-flag-file-deletion)
(define-key map "e" 'dired-find-file)
(define-key map "f" 'dired-find-file)
(define-key map "\C-m" 'dired-advertised-find-file)
(define-key map "g" 'revert-buffer)
(define-key map "h" 'describe-mode)
(define-key map "i" 'dired-maybe-insert-subdir)
(define-key map "j" 'dired-goto-file)
(define-key map "k" 'dired-do-kill-lines)
(define-key map "l" 'dired-do-redisplay)
(define-key map "m" 'dired-mark)
(define-key map "n" 'dired-next-line)
(define-key map "o" 'dired-find-file-other-window)
(define-key map "\C-o" 'dired-display-file)
(define-key map "p" 'dired-previous-line)
(define-key map "q" 'quit-window)
(define-key map "s" 'dired-sort-toggle-or-edit)
(define-key map "t" 'dired-toggle-marks)
(define-key map "u" 'dired-unmark)
(define-key map "v" 'dired-view-file)
(define-key map "w" 'dired-copy-filename-as-kill)
(define-key map "x" 'dired-do-flagged-delete)
(define-key map "y" 'dired-show-file-type)
(define-key map "+" 'dired-create-directory)
(define-key map "<" 'dired-prev-dirline)
(define-key map ">" 'dired-next-dirline)
(define-key map "^" 'dired-up-directory)
(define-key map " " 'dired-next-line)
(define-key map "\C-n" 'dired-next-line)
(define-key map "\C-p" 'dired-previous-line)
(define-key map [down] 'dired-next-line)
(define-key map [up] 'dired-previous-line)
(define-key map "$" 'dired-hide-subdir)
(define-key map "\M-$" 'dired-hide-all)
(define-key map "?" 'dired-summary)
(define-key map "\177" 'dired-unmark-backward)
(define-key map [remap undo] 'dired-undo)
(define-key map [remap advertised-undo] 'dired-undo)
(define-key map "\C-td" 'image-dired-display-thumbs)
(define-key map "\C-tt" 'image-dired-tag-files)
(define-key map "\C-tr" 'image-dired-delete-tag)
(define-key map "\C-tj" 'image-dired-jump-thumbnail-buffer)
(define-key map "\C-ti" 'image-dired-dired-display-image)
(define-key map "\C-tx" 'image-dired-dired-display-external)
(define-key map "\C-ta" 'image-dired-display-thumbs-append)
(define-key map "\C-t." 'image-dired-display-thumb)
(define-key map "\C-tc" 'image-dired-dired-comment-files)
(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)
(define-key map [menu-bar subdir]
(cons "Subdir" (make-sparse-keymap "Subdir")))
(define-key map [menu-bar subdir hide-all]
'(menu-item "Hide All" dired-hide-all
:help "Hide all subdirectories, leave only header lines"))
(define-key map [menu-bar subdir hide-subdir]
'(menu-item "Hide/UnHide Subdir" dired-hide-subdir
:help "Hide or unhide current directory listing"))
(define-key map [menu-bar subdir tree-down]
'(menu-item "Tree Down" dired-tree-down
:help "Go to first subdirectory header down the tree"))
(define-key map [menu-bar subdir tree-up]
'(menu-item "Tree Up" dired-tree-up
:help "Go to first subdirectory header up the tree"))
(define-key map [menu-bar subdir up]
'(menu-item "Up Directory" dired-up-directory
:help "Edit the parent directory"))
(define-key map [menu-bar subdir prev-subdir]
'(menu-item "Prev Subdir" dired-prev-subdir
:help "Go to previous subdirectory header line"))
(define-key map [menu-bar subdir next-subdir]
'(menu-item "Next Subdir" dired-next-subdir
:help "Go to next subdirectory header line"))
(define-key map [menu-bar subdir prev-dirline]
'(menu-item "Prev Dirline" dired-prev-dirline
:help "Move to next directory-file line"))
(define-key map [menu-bar subdir next-dirline]
'(menu-item "Next Dirline" dired-next-dirline
:help "Move to previous directory-file line"))
(define-key map [menu-bar subdir insert]
'(menu-item "Insert This Subdir" dired-maybe-insert-subdir
:help "Insert contents of subdirectory"))
(define-key map [menu-bar immediate]
(cons "Immediate" (make-sparse-keymap "Immediate")))
(define-key map
[menu-bar immediate image-dired-dired-display-external]
'(menu-item "Display Image Externally" image-dired-dired-display-external
:help "Display image in external viewer"))
(define-key map
[menu-bar immediate image-dired-dired-display-image]
'(menu-item "Display Image" image-dired-dired-display-image
:help "Display sized image in a separate window"))
(define-key map [menu-bar immediate dashes-4]
'("--"))
(define-key map [menu-bar immediate revert-buffer]
'(menu-item "Refresh" revert-buffer
:help "Update contents of shown directories"))
(define-key map [menu-bar immediate dashes]
'("--"))
(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 backup-diff]
'(menu-item "Compare with Backup" dired-backup-diff
:help "Diff file at cursor with its latest backup"))
(define-key map [menu-bar immediate diff]
'(menu-item "Diff..." dired-diff
:help "Compare file at cursor with another file"))
(define-key map [menu-bar immediate view]
'(menu-item "View This File" dired-view-file
:help "Examine file at cursor in read-only mode"))
(define-key map [menu-bar immediate display]
'(menu-item "Display in Other Window" dired-display-file
:help "Display file at cursor in other window"))
(define-key map [menu-bar immediate find-file-other-window]
'(menu-item "Find in Other Window" dired-find-file-other-window
:help "Edit file at cursor in other window"))
(define-key map [menu-bar immediate find-file]
'(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))
(define-key map [menu-bar immediate wdired-mode]
'(menu-item "Edit File Names" wdired-change-to-wdired-mode))
(define-key map [menu-bar regexp]
(cons "Regexp" (make-sparse-keymap "Regexp")))
(define-key map
[menu-bar regexp image-dired-mark-tagged-files]
'(menu-item "Mark From Image Tag..." image-dired-mark-tagged-files
:help "Mark files whose image tags matches regexp"))
(define-key map [menu-bar regexp dashes-1]
'("--"))
(define-key map [menu-bar regexp downcase]
'(menu-item "Downcase" dired-downcase
:enable (or (not (fboundp 'msdos-long-file-names))
(msdos-long-file-names))
:help "Rename marked files to lower-case name"))
(define-key map [menu-bar regexp upcase]
'(menu-item "Upcase" dired-upcase
:enable (or (not (fboundp 'msdos-long-file-names))
(msdos-long-file-names))
:help "Rename marked files to upper-case name"))
(define-key map [menu-bar regexp hardlink]
'(menu-item "Hardlink..." dired-do-hardlink-regexp
:help "Make hard links for files matching regexp"))
(define-key map [menu-bar regexp symlink]
'(menu-item "Symlink..." dired-do-symlink-regexp
:visible (fboundp 'make-symbolic-link)
:help "Make symbolic links for files matching regexp"))
(define-key map [menu-bar regexp rename]
'(menu-item "Rename..." dired-do-rename-regexp
:help "Rename marked files matching regexp"))
(define-key map [menu-bar regexp copy]
'(menu-item "Copy..." dired-do-copy-regexp
:help "Copy marked files matching regexp"))
(define-key map [menu-bar regexp flag]
'(menu-item "Flag..." dired-flag-files-regexp
:help "Flag files matching regexp for deletion"))
(define-key map [menu-bar regexp mark]
'(menu-item "Mark..." dired-mark-files-regexp
:help "Mark files matching regexp for future operations"))
(define-key map [menu-bar regexp mark-cont]
'(menu-item "Mark Containing..." dired-mark-files-containing-regexp
:help "Mark files whose contents matches regexp"))
(define-key map [menu-bar mark]
(cons "Mark" (make-sparse-keymap "Mark")))
(define-key map [menu-bar mark prev]
'(menu-item "Previous Marked" dired-prev-marked-file
:help "Move to previous marked file"))
(define-key map [menu-bar mark next]
'(menu-item "Next Marked" dired-next-marked-file
:help "Move to next marked file"))
(define-key map [menu-bar mark marks]
'(menu-item "Change Marks..." dired-change-marks
:help "Replace marker with another character"))
(define-key map [menu-bar mark unmark-all]
'(menu-item "Unmark All" dired-unmark-all-marks))
(define-key map [menu-bar mark symlinks]
'(menu-item "Mark Symlinks" dired-mark-symlinks
:visible (fboundp 'make-symbolic-link)
:help "Mark all symbolic links"))
(define-key map [menu-bar mark directories]
'(menu-item "Mark Directories" dired-mark-directories
:help "Mark all directories except `.' and `..'"))
(define-key map [menu-bar mark directory]
'(menu-item "Mark Old Backups" dired-clean-directory
:help "Flag old numbered backups for deletion"))
(define-key map [menu-bar mark executables]
'(menu-item "Mark Executables" dired-mark-executables
:help "Mark all executable files"))
(define-key map [menu-bar mark garbage-files]
'(menu-item "Flag Garbage Files" dired-flag-garbage-files
:help "Flag unneeded files for deletion"))
(define-key map [menu-bar mark backup-files]
'(menu-item "Flag Backup Files" dired-flag-backup-files
:help "Flag all backup files for deletion"))
(define-key map [menu-bar mark auto-save-files]
'(menu-item "Flag Auto-save Files" dired-flag-auto-save-files
:help "Flag auto-save files for deletion"))
(define-key map [menu-bar mark deletion]
'(menu-item "Flag" dired-flag-file-deletion
:help "Flag current line's file for deletion"))
(define-key map [menu-bar mark unmark]
'(menu-item "Unmark" dired-unmark
:help "Unmark or unflag current line's file"))
(define-key map [menu-bar mark mark]
'(menu-item "Mark" dired-mark
:help "Mark current line's file for future operations"))
(define-key map [menu-bar mark toggle-marks]
'(menu-item "Toggle Marks" dired-toggle-marks
:help "Mark unmarked files, unmark marked ones"))
(define-key map [menu-bar operate]
(cons "Operate" (make-sparse-keymap "Operate")))
(define-key map [menu-bar operate dashes-2]
'("--"))
(define-key map
[menu-bar operate image-dired-delete-tag]
'(menu-item "Delete Image Tag..." image-dired-delete-tag
:help "Delete image tag from current or marked files"))
(define-key map
[menu-bar operate image-dired-tag-files]
'(menu-item "Add Image Tags..." image-dired-tag-files
:help "Add image tags to current or marked files"))
(define-key map
[menu-bar operate image-dired-dired-comment-files]
'(menu-item "Add Image Comment..." image-dired-dired-comment-files
: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"))
(define-key map [menu-bar operate dashes-3]
'("--"))
(define-key map [menu-bar operate query-replace]
'(menu-item "Query Replace in Files..." dired-do-query-replace-regexp
:help "Replace regexp in marked files"))
(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 chown]
'(menu-item "Change Owner..." dired-do-chown
:visible (not (memq system-type '(ms-dos windows-nt)))
:help "Change the owner of marked files"))
(define-key map [menu-bar operate chgrp]
'(menu-item "Change Group..." dired-do-chgrp
:visible (not (memq system-type '(ms-dos windows-nt)))
:help "Change the group of marked files"))
(define-key map [menu-bar operate chmod]
'(menu-item "Change Mode..." dired-do-chmod
:help "Change mode (attributes) of marked files"))
(define-key map [menu-bar operate touch]
'(menu-item "Change Timestamp..." dired-do-touch
:help "Change timestamp of marked files"))
(define-key map [menu-bar operate load]
'(menu-item "Load" dired-do-load
:help "Load marked Emacs Lisp files"))
(define-key map [menu-bar operate compile]
'(menu-item "Byte-compile" dired-do-byte-compile
:help "Byte-compile marked Emacs Lisp files"))
(define-key map [menu-bar operate compress]
'(menu-item "Compress" dired-do-compress
:help "Compress/uncompress marked files"))
(define-key map [menu-bar operate print]
'(menu-item "Print..." dired-do-print
:help "Ask for print command and print marked files"))
(define-key map [menu-bar operate hardlink]
'(menu-item "Hardlink to..." dired-do-hardlink
:help "Make hard links for current or marked files"))
(define-key map [menu-bar operate symlink]
'(menu-item "Symlink to..." dired-do-symlink
:visible (fboundp 'make-symbolic-link)
:help "Make symbolic links for current or marked files"))
(define-key map [menu-bar operate command]
'(menu-item "Shell Command..." dired-do-shell-command
:help "Run a shell command on each of marked files"))
(define-key map [menu-bar operate delete]
'(menu-item "Delete" dired-do-delete
:help "Delete current file or all marked files"))
(define-key map [menu-bar operate rename]
'(menu-item "Rename to..." dired-do-rename
:help "Rename current file or move marked files"))
(define-key map [menu-bar operate copy]
'(menu-item "Copy to..." dired-do-copy
:help "Copy current file or all marked files"))
map)
"Local keymap for `dired-mode' buffers.")
(put 'dired-mode 'mode-class 'special)
(defun dired-mode (&optional dirname switches)
"\
Mode for \"editing\" directory listings.
In Dired, you are \"editing\" a list of the files in a directory and
\(optionally) its subdirectories, in the format of `ls -lR'.
Each directory is a page: use \\[backward-page] and \\[forward-page] to move pagewise.
\"Editing\" means that you can run shell commands on files, visit,
compress, load or byte-compile them, change their file attributes
and insert subdirectories into the same buffer. You can \"mark\"
files for later commands or \"flag\" them for deletion, either file
by file or all files matching certain criteria.
You can move using the usual cursor motion commands.\\<dired-mode-map>
Letters no longer insert themselves. Digits are prefix arguments.
Instead, type \\[dired-flag-file-deletion] to flag a file for Deletion.
Type \\[dired-mark] to Mark a file or subdirectory for later commands.
Most commands operate on the marked files and use the current file
if no files are marked. Use a numeric prefix argument to operate on
the next ARG (or previous -ARG if ARG<0) files, or just `1'
to operate on the current file only. Prefix arguments override marks.
Mark-using commands display a list of failures afterwards. Type \\[dired-summary]
to see why something went wrong.
Type \\[dired-unmark] to Unmark a file or all files of a subdirectory.
Type \\[dired-unmark-backward] to back up one line and unflag.
Type \\[dired-do-flagged-delete] to eXecute the deletions requested.
Type \\[dired-advertised-find-file] to Find the current line's file
(or dired it in another buffer, if it is a directory).
Type \\[dired-find-file-other-window] to find file or dired directory in Other window.
Type \\[dired-maybe-insert-subdir] to Insert a subdirectory in this buffer.
Type \\[dired-do-rename] to Rename a file or move the marked files to another directory.
Type \\[dired-do-copy] to Copy files.
Type \\[dired-sort-toggle-or-edit] to toggle Sorting by name/date or change the `ls' switches.
Type \\[revert-buffer] to read all currently expanded directories aGain.
This retains all marks and hides subdirs again that were hidden before.
SPC and DEL can be used to move down and up by lines.
If Dired ever gets confused, you can either type \\[revert-buffer] \
to read the
directories again, type \\[dired-do-redisplay] \
to relist a single or the marked files or a
subdirectory, or type \\[dired-build-subdir-alist] to parse the buffer
again for the directory tree.
Customization variables (rename this buffer and type \\[describe-variable] on each line
for more info):
`dired-listing-switches'
`dired-trivial-filenames'
`dired-shrink-to-fit'
`dired-marker-char'
`dired-del-marker'
`dired-keep-marker-rename'
`dired-keep-marker-copy'
`dired-keep-marker-hardlink'
`dired-keep-marker-symlink'
Hooks (use \\[describe-variable] to see their documentation):
`dired-before-readin-hook'
`dired-after-readin-hook'
`dired-mode-hook'
`dired-load-hook'
Keybindings:
\\{dired-mode-map}"
(kill-all-local-variables)
(use-local-map dired-mode-map)
(dired-advertise) (setq major-mode 'dired-mode
mode-name "Dired"
buffer-read-only t
selective-display t mode-line-buffer-identification
(propertized-buffer-identification "%17b"))
(set (make-local-variable 'revert-buffer-function)
(function dired-revert))
(set (make-local-variable 'buffer-stale-function)
(function dired-buffer-stale-p))
(set (make-local-variable 'page-delimiter)
"\n\n")
(set (make-local-variable 'dired-directory)
(or dirname default-directory))
(set (make-local-variable 'list-buffers-directory)
(expand-file-name (if (listp dired-directory)
(car dired-directory)
dired-directory)))
(set (make-local-variable 'dired-actual-switches)
(or switches dired-listing-switches))
(set (make-local-variable 'font-lock-defaults)
'(dired-font-lock-keywords t nil nil beginning-of-line))
(set (make-local-variable 'desktop-save-buffer)
'dired-desktop-buffer-misc-data)
(setq dired-switches-alist nil)
(dired-sort-other dired-actual-switches t)
(when (featurep 'dnd)
(set (make-local-variable 'dnd-protocol-alist)
(append dired-dnd-protocol-alist dnd-protocol-alist)))
(run-mode-hooks 'dired-mode-hook))
(defun dired-summary ()
"Summarize basic Dired commands and show recent dired errors."
(interactive)
(dired-why)
(message
"d-elete, u-ndelete, x-punge, f-ind, o-ther window, R-ename, C-opy, h-elp"))
(defun dired-undo ()
"Undo in a dired buffer.
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)
(undo))
(dired-build-subdir-alist)
(message "Change in dired buffer undone.
Actual changes in files cannot be undone by Emacs."))
(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)
(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)
(dired-move-to-filename))
(defun dired-next-dirline (arg &optional opoint)
"Goto ARG'th next directory file line."
(interactive "p")
(or opoint (setq opoint (point)))
(if (if (> arg 0)
(re-search-forward dired-re-dir nil t arg)
(beginning-of-line)
(re-search-backward dired-re-dir nil t (- arg)))
(dired-move-to-filename) (goto-char opoint)
(error "No more subdirectories")))
(defun dired-prev-dirline (arg)
"Goto ARG'th previous directory file line."
(interactive "p")
(dired-next-dirline (- arg)))
(defun dired-up-directory (&optional other-window)
"Run Dired on parent directory of current directory.
Find the parent directory either in this buffer or another buffer.
Creates a buffer if necessary."
(interactive "P")
(let* ((dir (dired-current-directory))
(up (file-name-directory (directory-file-name dir))))
(or (dired-goto-file (directory-file-name dir))
(and (cdr dired-subdir-alist)
(dired-goto-subdir up))
(progn
(if other-window
(dired-other-window up)
(dired up))
(dired-goto-file dir)))))
(defun dired-get-file-for-visit ()
"Get the current line's file name, with an error if file does not exist."
(interactive)
(let ((raw (dired-get-filename nil t))
file-name)
(if (null raw)
(error "No file on this line"))
(setq file-name (file-name-sans-versions raw t))
(if (file-exists-p file-name)
file-name
(if (file-symlink-p file-name)
(error "File is a symlink to a nonexistent target")
(error "File no longer exists; type `g' to update dired buffer")))))
(defalias 'dired-advertised-find-file 'dired-find-file)
(defun dired-find-file ()
"In Dired, visit the file or directory named on this line."
(interactive)
(let ((find-file-run-dired t))
(find-file (dired-get-file-for-visit))))
(defun dired-find-alternate-file ()
"In Dired, visit this file or directory instead of the dired buffer."
(interactive)
(set-buffer-modified-p nil)
(find-alternate-file (dired-get-file-for-visit)))
(defun dired-mouse-find-file-other-window (event)
"In Dired, visit the file or directory name you click on."
(interactive "e")
(let (window pos file)
(save-excursion
(setq window (posn-window (event-end event))
pos (posn-point (event-end event)))
(if (not (windowp window))
(error "No file chosen"))
(set-buffer (window-buffer window))
(goto-char pos)
(setq file (dired-get-file-for-visit)))
(if (file-directory-p file)
(or (and (cdr dired-subdir-alist)
(dired-goto-subdir file))
(progn
(select-window window)
(dired-other-window file)))
(select-window window)
(find-file-other-window (file-name-sans-versions file t)))))
(defun dired-view-file ()
"In Dired, examine a file in view mode, returning to Dired when done.
When file is a directory, show it in this buffer if it is inserted.
Otherwise, display it in another buffer."
(interactive)
(let ((file (dired-get-file-for-visit)))
(if (file-directory-p file)
(or (and (cdr dired-subdir-alist)
(dired-goto-subdir file))
(dired file))
(view-file file))))
(defun dired-find-file-other-window ()
"In Dired, visit this file or directory in another window."
(interactive)
(find-file-other-window (dired-get-file-for-visit)))
(defun dired-display-file ()
"In Dired, display this file or directory in another window."
(interactive)
(display-buffer (find-file-noselect (dired-get-file-for-visit))))
(defun dired-get-filename (&optional localp no-error-if-not-filep)
"In Dired, return name of file mentioned on this line.
Value returned normally includes the directory name.
Optional arg LOCALP with value `no-dir' means don't include directory
name in result. A value of `verbatim' means to return the name exactly as
it occurs in the buffer, and a value of t means construct name relative to
`default-directory', which still may contain slashes if in a subdirectory.
Optional arg NO-ERROR-IF-NOT-FILEP means treat `.' and `..' as
regular filenames and return nil if no filename on this line.
Otherwise, an error occurs in these cases."
(let (case-fold-search file p1 p2 already-absolute)
(save-excursion
(if (setq p1 (dired-move-to-filename (not no-error-if-not-filep)))
(setq p2 (dired-move-to-end-of-filename no-error-if-not-filep))))
(if (setq file (and p1 p2 (buffer-substring p1 p2)))
(progn
(set-text-properties 0 (length file) nil file)
(setq file
(read
(concat "\""
(or (dired-string-replace-match
"\\([^\\]\\|\\`\\)\"" file "\\1\\\\\"" nil t)
file)
"\"")))
(if (and enable-multibyte-characters
(not (multibyte-string-p file)))
(setq file (string-to-multibyte file)))))
(and file (file-name-absolute-p file)
(not (eq (aref file 0) ?~))
(setq already-absolute t))
(cond
((null file)
nil)
((eq localp 'verbatim)
file)
((and (not no-error-if-not-filep)
(member file '("." "..")))
(error "Cannot operate on `.' or `..'"))
((and (eq localp 'no-dir) already-absolute)
(file-name-nondirectory file))
(already-absolute
(let ((handler (find-file-name-handler file nil)))
(if (and handler (not (get handler 'safe-magic)))
(concat "/:" file)
file)))
((eq localp 'no-dir)
file)
((equal (dired-current-directory) "/")
(setq file (concat (dired-current-directory localp) file))
(let ((handler (find-file-name-handler file nil)))
(if (and handler (not (get handler 'safe-magic)))
(concat "/:" file)
file)))
(t
(concat (dired-current-directory localp) file)))))
(defun dired-string-replace-match (regexp string newtext
&optional literal global)
"Replace first match of REGEXP in STRING with NEWTEXT.
If it does not match, nil is returned instead of the new string.
Optional arg LITERAL means to take NEWTEXT literally.
Optional arg GLOBAL means to replace all matches."
(if global
(let ((start 0) ret)
(while (string-match regexp string start)
(let ((from-end (- (length string) (match-end 0))))
(setq ret (setq string (replace-match newtext t literal string)))
(setq start (- (length string) from-end))))
ret)
(if (not (string-match regexp string 0))
nil
(replace-match newtext t literal string))))
(defun dired-make-absolute (file &optional dir)
(concat (or dir default-directory) file))
(defun dired-make-relative (file &optional dir ignore)
"Convert FILE (an absolute file name) to a name relative to DIR.
If this is impossible, return FILE unchanged.
DIR must be a directory name, not a file name."
(or dir (setq dir default-directory))
(if (and (> (length dir) 0) (= (aref dir 0) ?~))
(setq dir (expand-file-name dir)))
(if (string-match (concat "^" (regexp-quote dir)) file)
(substring file (match-end 0))
file))
(defvar dired-permission-flags-regexp
"\\([^ ]\\)[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)"
"Regular expression to match the permission flags in `ls -l'.")
(defun dired-move-to-filename (&optional raise-error eol)
"Move to the beginning of the filename on the current line.
Return the position of the beginning of the filename, or nil if none found."
(or eol (setq eol (line-end-position)))
(beginning-of-line)
(let ((change (next-single-property-change (point) 'dired-filename nil eol)))
(cond
((and change (< change eol))
(goto-char change))
((re-search-forward directory-listing-before-filename-regexp eol t)
(goto-char (match-end 0)))
((re-search-forward dired-permission-flags-regexp eol t)
(if raise-error
(error "Unrecognized line! Check directory-listing-before-filename-regexp"))
(beginning-of-line)
nil)
(raise-error
(error "No file on this line")))))
(defun dired-move-to-end-of-filename (&optional no-error)
(if (get-text-property (point) 'dired-filename)
(goto-char (next-single-property-change (point) 'dired-filename))
(let (opoint file-type executable symlink hidden case-fold-search used-F eol)
(setq used-F (string-match "F" dired-actual-switches)
opoint (point)
eol (save-excursion (end-of-line) (point))
hidden (and selective-display
(save-excursion (search-forward "\r" eol t))))
(if hidden
nil
(save-excursion (if (re-search-backward
dired-permission-flags-regexp nil t)
(setq file-type (char-after (match-beginning 1))
symlink (eq file-type ?l)
executable (and
used-F
(string-match
"[xst]" (concat
(match-string 2)
(match-string 3)
(match-string 4)))))
(or no-error (error "No file on this line"))))
(if symlink
(if (search-forward " -> " eol t)
(progn
(forward-char -4)
(and used-F
dired-ls-F-marks-symlinks
(eq (preceding-char) ?@) (forward-char -1))))
(goto-char eol) (and used-F
(or (memq file-type '(?d ?s ?p))
executable)
(forward-char -1))))
(or no-error
(not (eq opoint (point)))
(error (if hidden
(substitute-command-keys
"File line is hidden, type \\[dired-hide-subdir] to unhide")
"No file on this line")))
(if (eq opoint (point))
nil
(point)))))
(defun dired-copy-filename-as-kill (&optional arg)
"Copy names of marked (or next ARG) files into the kill ring.
The names are separated by a space.
With a zero prefix arg, use the absolute file name of each marked file.
With \\[universal-argument], use the file name relative to the dired buffer's
`default-directory'. (This still may contain slashes if in a subdirectory.)
If on a subdir headerline, use absolute subdirname instead;
prefix arg and marked files are ignored in this case.
You can then feed the file name(s) to other commands with \\[yank]."
(interactive "P")
(let ((string
(or (dired-get-subdir)
(mapconcat (function identity)
(if arg
(cond ((zerop (prefix-numeric-value arg))
(dired-get-marked-files))
((consp arg)
(dired-get-marked-files t))
(t
(dired-get-marked-files
'no-dir (prefix-numeric-value arg))))
(dired-get-marked-files 'no-dir))
" "))))
(if (eq last-command 'kill-region)
(kill-append string nil)
(kill-new string))
(message "%s" string)))
(defun dired-buffers-for-dir (dir &optional file)
(setq dir (file-name-as-directory dir))
(let ((alist dired-buffers) result elt buf)
(while alist
(setq elt (car alist)
buf (cdr elt))
(if (buffer-name buf)
(if (dired-in-this-tree dir (car elt))
(with-current-buffer buf
(and (assoc dir dired-subdir-alist)
(or (null file)
(let ((wildcards
(file-name-nondirectory dired-directory)))
(or (= 0 (length wildcards))
(string-match (dired-glob-regexp wildcards)
file))))
(setq result (cons buf result)))))
(setq dired-buffers (delq elt dired-buffers)))
(setq alist (cdr alist)))
result))
(defun dired-glob-regexp (pattern)
"Convert glob-pattern PATTERN to a regular expression."
(let ((matched-in-pattern 0) regexp)
(while (string-match "[[?*]" pattern matched-in-pattern)
(let ((op-end (match-end 0))
(next-op (aref pattern (match-beginning 0))))
(setq regexp (concat regexp
(regexp-quote
(substring pattern matched-in-pattern
(match-beginning 0)))))
(cond ((= next-op ??)
(setq regexp (concat regexp "."))
(setq matched-in-pattern op-end))
((= next-op ?\[)
(let* ((set-start (match-beginning 0))
(set-cont
(if (= (aref pattern (1+ set-start)) ?^)
(+ 3 set-start)
(+ 2 set-start)))
(set-end (string-match "]" pattern set-cont))
(set (substring pattern set-start (1+ set-end))))
(setq regexp (concat regexp set))
(setq matched-in-pattern (1+ set-end))))
((= next-op ?*)
(setq regexp (concat regexp ".*"))
(setq matched-in-pattern op-end)))))
(concat "\\`"
regexp
(regexp-quote
(substring pattern matched-in-pattern))
"\\'")))
(defun dired-advertise ()
(let ((expanded-default (expand-file-name default-directory)))
(if (memq (current-buffer) (dired-buffers-for-dir expanded-default))
t (setq dired-buffers
(cons (cons expanded-default (current-buffer))
dired-buffers)))))
(defun dired-unadvertise (dir)
(setq dired-buffers
(delq (assoc (expand-file-name dir) dired-buffers) dired-buffers)))
(defun dired-in-this-tree (file dir)
(let (case-fold-search)
(string-match (concat "^" (regexp-quote dir)) file)))
(defun dired-normalize-subdir (dir)
(file-name-as-directory
(if (file-name-absolute-p dir)
dir
(expand-file-name dir default-directory))))
(defun dired-get-subdir ()
(save-excursion
(let ((cur-dir (dired-current-directory)))
(beginning-of-line) (and (zerop (- (point)
(dired-get-subdir-min (assoc cur-dir
dired-subdir-alist))))
cur-dir))))
(defalias 'dired-get-subdir-min 'cdr)
(defun dired-get-subdir-max (elt)
(save-excursion
(goto-char (dired-get-subdir-min elt))
(dired-subdir-max)))
(defun dired-clear-alist ()
(while dired-subdir-alist
(set-marker (dired-get-subdir-min (car dired-subdir-alist)) nil)
(setq dired-subdir-alist (cdr dired-subdir-alist))))
(defun dired-subdir-index (dir)
(let (found (index 0) (alist dired-subdir-alist))
(while alist
(if (string= dir (car (car alist)))
(setq alist nil found t)
(setq alist (cdr alist) index (1+ index))))
(if found index nil)))
(defun dired-next-subdir (arg &optional no-error-if-not-found no-skip)
"Go to next subdirectory, regardless of level."
(interactive "p")
(let ((this-dir (dired-current-directory))
pos index)
(setq index (- (dired-subdir-index this-dir) arg))
(setq pos (if (>= index 0)
(dired-get-subdir-min (nth index dired-subdir-alist))))
(if pos
(progn
(goto-char pos)
(or no-skip (skip-chars-forward "^\n\r"))
(point))
(if no-error-if-not-found
nil (error "%s directory" (if (> arg 0) "Last" "First"))))))
(defun dired-build-subdir-alist (&optional switches)
"Build `dired-subdir-alist' by parsing the buffer.
Returns the new value of the alist.
If optional arg SWITCHES is non-nil, use its value
instead of `dired-actual-switches'."
(interactive)
(dired-clear-alist)
(save-excursion
(let* ((count 0)
(buffer-read-only nil)
(buffer-undo-list t)
(switches (or switches dired-actual-switches))
new-dir-name
(R-ftp-base-dir-regex
(and (string-match "R" switches)
(string-match "\\`/.*:\\(/.*\\)" default-directory)
(concat "\\`" (match-string 1 default-directory)))))
(goto-char (point-min))
(setq dired-subdir-alist nil)
(while (re-search-forward dired-subdir-regexp nil t)
(unless (save-excursion
(goto-char (match-beginning 0))
(beginning-of-line)
(forward-char 2)
(save-match-data (looking-at dired-re-perms)))
(save-excursion
(goto-char (match-beginning 1))
(setq new-dir-name
(buffer-substring-no-properties (point) (match-end 1))
new-dir-name
(save-match-data
(if (and R-ftp-base-dir-regex
(not (string= new-dir-name default-directory))
(string-match R-ftp-base-dir-regex new-dir-name))
(concat default-directory
(substring new-dir-name (match-end 0)))
(expand-file-name new-dir-name))))
(delete-region (point) (match-end 1))
(insert new-dir-name))
(setq count (1+ count))
(dired-alist-add-1 new-dir-name
(save-excursion
(goto-char (match-beginning 0))
(beginning-of-line)
(point-marker)))))
(if (and (> count 1) (interactive-p))
(message "Buffer includes %d directories" count)))
dired-subdir-alist))
(defun dired-alist-add-1 (dir new-marker)
(setq dired-subdir-alist
(cons (cons (dired-normalize-subdir dir) new-marker)
dired-subdir-alist)))
(defun dired-goto-next-nontrivial-file ()
(dired-goto-next-file) (if (stringp dired-trivial-filenames)
(while (and (not (eobp))
(string-match dired-trivial-filenames
(file-name-nondirectory
(or (dired-get-filename nil t) ""))))
(forward-line 1)
(dired-move-to-filename))))
(defun dired-goto-next-file ()
(let ((max (1- (dired-subdir-max))))
(while (and (not (dired-move-to-filename)) (< (point) max))
(forward-line 1))))
(defun dired-goto-file (file)
"Go to line describing file FILE in this dired buffer."
(interactive
(prog1 (list (expand-file-name
(read-file-name "Goto file: "
(dired-current-directory))))
(push-mark)))
(setq file (directory-file-name file)) (let (found case-fold-search dir)
(setq dir (or (file-name-directory file)
(error "File name `%s' is not absolute" file)))
(save-excursion
(if (if (string= dir (expand-file-name default-directory))
(goto-char (point-min))
(and (cdr dired-subdir-alist)
(dired-goto-subdir dir)))
(let ((base (file-name-nondirectory file))
search-string
(boundary (dired-subdir-max)))
(setq search-string
(replace-regexp-in-string "\^m" "\\^m" base nil t))
(setq search-string
(replace-regexp-in-string "\\\\" "\\\\" search-string nil t))
(while (and (not found)
(search-forward (concat " " search-string)
boundary 'move))
(if (equal base (dired-get-filename 'no-dir t))
(setq found (dired-move-to-filename))
(forward-line 1))))))
(and found
(goto-char found))))
(defun dired-initial-position (dirname)
(end-of-line)
(if dired-trivial-filenames (dired-goto-next-nontrivial-file)))
(defun dired-current-directory (&optional localp)
"Return the name of the subdirectory to which this line belongs.
This returns a string with trailing slash, like `default-directory'.
Optional argument means return a file name relative to `default-directory'."
(let ((here (point))
(alist (or dired-subdir-alist
(error "No subdir-alist in %s" (current-buffer))))
elt dir)
(while alist
(setq elt (car alist)
dir (car elt)
alist (if (<= (dired-get-subdir-min elt) here)
nil (cdr alist))))
(if localp
(dired-make-relative dir default-directory)
dir)))
(defun dired-subdir-max ()
(save-excursion
(if (or (null (cdr dired-subdir-alist)) (not (dired-next-subdir 1 t t)))
(point-max)
(point))))
(defcustom dired-recursive-deletes nil "*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
without asking.
Anything else means ask for each directory."
:type '(choice :tag "Delete non-empty directories"
(const :tag "Yes" always)
(const :tag "No--only delete empty directories" nil)
(const :tag "Confirm for each directory" t)
(const :tag "Confirm for each top directory only" top))
:group 'dired)
(defvar dired-re-no-dot "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")
(defun dired-delete-file (file &optional recursive) "\
Delete FILE or directory (possibly recursively if optional RECURSIVE is true.)
RECURSIVE determines what to do with a non-empty directory. If RECURSIVE is:
nil, do not delete.
`always', delete recursively without asking.
`top', ask for each directory at top level.
Anything else, ask for each sub-directory."
(let (files)
(if (not (eq t (car (file-attributes file))))
(delete-file file)
(when (and recursive
(setq files
(directory-files file t dired-re-no-dot)) (or (eq recursive 'always)
(yes-or-no-p (format "Recursive delete of %s? "
(dired-make-relative file)))))
(if (eq recursive 'top) (setq recursive 'always)) (while files (dired-delete-file (car files) recursive)
(setq files (cdr files))))
(delete-directory file))))
(defun dired-do-flagged-delete (&optional nomessage)
"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."
(interactive)
(let* ((dired-marker-char dired-del-marker)
(regexp (dired-marker-regexp))
case-fold-search)
(if (save-excursion (goto-char (point-min))
(re-search-forward regexp nil t))
(dired-internal-do-deletions
(dired-map-over-marks (cons (dired-get-filename) (point))
nil)
nil)
(or nomessage
(message "(No deletions requested)")))))
(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."
(interactive "P")
(dired-internal-do-deletions
(dired-map-over-marks (cons (dired-get-filename) (point))
arg)
arg))
(defvar dired-deletion-confirmer 'yes-or-no-p)
(defun dired-internal-do-deletions (l arg)
(let ((files (mapcar (function car) l))
(count (length l))
(succ 0))
(setq files (nreverse (mapcar (function dired-make-relative) files)))
(if (dired-mark-pop-up
" *Deletions*" 'delete files dired-deletion-confirmer
(format "Delete %s " (dired-mark-prompt arg files)))
(save-excursion
(let (failures) (while l
(goto-char (cdr (car l)))
(let (buffer-read-only)
(condition-case err
(let ((fn (car (car l))))
(dired-delete-file fn dired-recursive-deletes)
(setq succ (1+ succ))
(message "%s of %s deletions" succ count)
(dired-fun-in-all-buffers
(file-name-directory fn) (file-name-nondirectory fn)
(function dired-delete-entry) fn))
(error (dired-log "%s\n" err)
(setq failures (cons (car (car l)) failures)))))
(setq l (cdr l)))
(if (not failures)
(message "%d deletion%s done" count (dired-plural-s count))
(dired-log-summary
(format "%d of %d deletion%s failed"
(length failures) count
(dired-plural-s count))
failures))))
(message "(No deletions performed)")))
(dired-move-to-filename))
(defun dired-fun-in-all-buffers (directory file fun &rest args)
(let (success-list)
(dolist (buf (dired-buffers-for-dir (expand-file-name directory)
file))
(with-current-buffer buf
(if (apply fun args)
(setq success-list (cons (buffer-name buf) success-list)))))
success-list))
(defun dired-delete-entry (file)
(save-excursion
(and (dired-goto-file file)
(let (buffer-read-only)
(delete-region (progn (beginning-of-line) (point))
(save-excursion (forward-line 1) (point))))))
(dired-clean-up-after-deletion file))
(defun dired-clean-up-after-deletion (fn)
(save-excursion (and (cdr dired-subdir-alist)
(dired-goto-subdir fn)
(dired-kill-subdir))))
(defun dired-marker-regexp ()
(concat "^" (regexp-quote (char-to-string dired-marker-char))))
(defun dired-plural-s (count)
(if (= 1 count) "" "s"))
(defun dired-mark-prompt (arg files)
(let ((count (length files)))
(if (= count 1)
(car files)
(if (integerp arg)
(format "[next %d files]" arg)
(format "%c [%d files]" dired-marker-char count)))))
(defun dired-pop-to-buffer (buf)
(if (not dired-shrink-to-fit)
(pop-to-buffer (get-buffer-create buf))
(let ((window (selected-window))
target-lines w2)
(cond ((and (> (window-height (setq w2 (get-largest-window)))
split-height-threshold)
(= (frame-width) (window-width w2)))
(setq window w2))
((and (> (window-height (setq w2 (get-lru-window)))
(* 2 window-min-height))
(= (frame-width) (window-width w2)))
(setq window w2)))
(save-excursion
(set-buffer buf)
(goto-char (point-max))
(skip-chars-backward "\n\r\t ")
(setq target-lines (count-lines (point-min) (point)))
(if (not (bolp))
(setq target-lines (1+ target-lines))))
(if (<= (window-height window) (* 2 window-min-height))
(setq w2 (display-buffer buf))
(setq w2 (split-window window
(max window-min-height
(- (window-height window)
(1+ (max window-min-height target-lines)))))))
(set-window-buffer w2 buf)
(if (< (1- (window-height w2)) target-lines)
(progn
(select-window w2)
(enlarge-window (- target-lines (1- (window-height w2))))))
(set-window-start w2 1)
)))
(defcustom dired-no-confirm nil
"A list of symbols for commands Dired should not confirm.
Command symbols are `byte-compile', `chgrp', `chmod', `chown', `compress',
`copy', `delete', `hardlink', `load', `move', `print', `shell', `symlink',
`touch' and `uncompress'."
:group 'dired
:type '(set (const byte-compile) (const chgrp)
(const chmod) (const chown) (const compress)
(const copy) (const delete) (const hardlink)
(const load) (const move) (const print)
(const shell) (const symlink) (const touch)
(const uncompress)))
(defun dired-mark-pop-up (bufname op-symbol files function &rest args)
"Return FUNCTION's result on ARGS after showing which files are marked.
Displays the file names in a buffer named BUFNAME;
nil gives \" *Marked Files*\".
This uses function `dired-pop-to-buffer' to do that.
FUNCTION should not manipulate files, just read input
(an argument or confirmation).
The window is not shown if there is just one file or
OP-SYMBOL is a member of the list in `dired-no-confirm'.
FILES is the list of marked files. It can also be (t FILENAME)
in the case of one marked file, to distinguish that from using
just the current file."
(or bufname (setq bufname " *Marked Files*"))
(if (or (eq dired-no-confirm t)
(memq op-symbol dired-no-confirm)
(= (length files) 1))
(apply function args)
(with-current-buffer (get-buffer-create bufname)
(erase-buffer)
(dired-format-columns-of-files (if (eq (car files) t) (cdr files) files))
(remove-text-properties (point-min) (point-max)
'(mouse-face nil help-echo nil)))
(save-window-excursion
(dired-pop-to-buffer bufname)
(apply function args))))
(defun dired-format-columns-of-files (files)
(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) (make-list (- (* columns rows) nfiles) "")))
(setcdr (nthcdr (1- (length files)) files) files) (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))
(defun dired-repeat-over-lines (arg function)
(let ((pos (make-marker)))
(beginning-of-line)
(while (and (> arg 0) (not (eobp)))
(setq arg (1- arg))
(beginning-of-line)
(while (and (not (eobp)) (dired-between-files)) (forward-line 1))
(save-excursion
(forward-line 1)
(move-marker pos (1+ (point))))
(save-excursion (funcall function))
(goto-char pos))
(while (and (< arg 0) (not (bobp)))
(setq arg (1+ arg))
(forward-line -1)
(while (and (not (bobp)) (dired-between-files)) (forward-line -1))
(beginning-of-line)
(save-excursion (funcall function)))
(move-marker pos nil)
(dired-move-to-filename)))
(defun dired-between-files ()
(save-excursion (not (dired-move-to-filename))))
(defun dired-next-marked-file (arg &optional wrap opoint)
"Move to the next marked file, wrapping around the end of the buffer."
(interactive "p\np")
(or opoint (setq opoint (point))) (if (if (> arg 0)
(re-search-forward dired-re-mark nil t arg)
(beginning-of-line)
(re-search-backward dired-re-mark nil t (- arg)))
(dired-move-to-filename)
(if (null wrap)
(progn
(goto-char opoint)
(error "No next marked file"))
(message "(Wraparound for next marked file)")
(goto-char (if (> arg 0) (point-min) (point-max)))
(dired-next-marked-file arg nil opoint))))
(defun dired-prev-marked-file (arg &optional wrap)
"Move to the previous marked file, wrapping around the end of the buffer."
(interactive "p\np")
(dired-next-marked-file (- arg) wrap))
(defun dired-file-marker (file)
(save-excursion
(and (dired-goto-file file)
(progn
(beginning-of-line)
(if (not (equal ?\040 (following-char)))
(following-char))))))
(defun dired-mark-files-in-region (start end)
(let (buffer-read-only)
(if (> start end)
(error "start > end"))
(goto-char start) (while (< (point) end)
(while (and (< (point) end) (dired-between-files))
(forward-line 1))
(if (and (not (looking-at dired-re-dot))
(dired-get-filename nil t))
(progn
(delete-char 1)
(insert dired-marker-char)))
(forward-line 1))))
(defun dired-mark (arg)
"Mark the current (or next ARG) files.
If on a subdir headerline, mark all its files except `.' and `..'.
Use \\[dired-unmark-all-files] to remove all marks
and \\[dired-unmark] on a subdir to remove the marks in
this subdir."
(interactive "P")
(if (dired-get-subdir)
(save-excursion (dired-mark-subdir-files))
(let (buffer-read-only)
(dired-repeat-over-lines
(prefix-numeric-value arg)
(function (lambda () (delete-char 1) (insert dired-marker-char)))))))
(defun dired-unmark (arg)
"Unmark the current (or next ARG) files.
If looking at a subdir, unmark all its files except `.' and `..'."
(interactive "P")
(let ((dired-marker-char ?\040))
(dired-mark arg)))
(defun dired-flag-file-deletion (arg)
"In Dired, flag the current line's file for deletion.
With prefix arg, repeat over several lines.
If on a subdir headerline, mark all its files except `.' and `..'."
(interactive "P")
(let ((dired-marker-char dired-del-marker))
(dired-mark arg)))
(defun dired-unmark-backward (arg)
"In Dired, move up lines and remove deletion flag there.
Optional prefix ARG says how many lines to unflag; default is one line."
(interactive "p")
(dired-unmark (- arg)))
(defun dired-toggle-marks ()
"Toggle marks: marked files become unmarked, and vice versa.
Files marked with other flags (such as `D') are not affected.
`.' and `..' are never toggled.
As always, hidden subdirs are not affected."
(interactive)
(save-excursion
(goto-char (point-min))
(let (buffer-read-only)
(while (not (eobp))
(or (dired-between-files)
(looking-at dired-re-dot)
(apply 'subst-char-in-region
(point) (1+ (point))
(if (eq ?\040 (following-char)) (list ?\040 dired-marker-char)
(list dired-marker-char ?\040))))
(forward-line 1)))))
(defvar dired-regexp-history nil
"History list of regular expressions used in Dired commands.")
(defun dired-read-regexp (prompt)
(read-from-minibuffer prompt nil nil nil 'dired-regexp-history))
(defun dired-mark-files-regexp (regexp &optional marker-char)
"Mark all files matching REGEXP for use in later commands.
A prefix argument means to unmark them instead.
`.' and `..' are never marked.
REGEXP is an Emacs regexp, not a shell wildcard. Thus, use `\\.o$' for
object files--just `.o' will mark more than you might think."
(interactive
(list (dired-read-regexp (concat (if current-prefix-arg "Unmark" "Mark")
" files (regexp): "))
(if current-prefix-arg ?\040)))
(let ((dired-marker-char (or marker-char dired-marker-char)))
(dired-mark-if
(and (not (looking-at dired-re-dot))
(not (eolp)) (let ((fn (dired-get-filename nil t)))
(and fn (string-match regexp (file-name-nondirectory fn)))))
"matching file")))
(defun dired-mark-files-containing-regexp (regexp &optional marker-char)
"Mark all files with contents containing REGEXP for use in later commands.
A prefix argument means to unmark them instead.
`.' and `..' are never marked."
(interactive
(list (dired-read-regexp (concat (if current-prefix-arg "Unmark" "Mark")
" files containing (regexp): "))
(if current-prefix-arg ?\040)))
(let ((dired-marker-char (or marker-char dired-marker-char)))
(dired-mark-if
(and (not (looking-at dired-re-dot))
(not (eolp)) (let ((fn (dired-get-filename nil t)))
(when (and fn (file-readable-p fn)
(not (file-directory-p fn)))
(let ((prebuf (get-file-buffer fn)))
(message "Checking %s" fn)
(if prebuf
(with-current-buffer prebuf
(save-excursion
(goto-char (point-min))
(re-search-forward regexp nil t)))
(with-temp-buffer
(insert-file-contents fn)
(goto-char (point-min))
(re-search-forward regexp nil t))))
)))
"matching file")))
(defun dired-flag-files-regexp (regexp)
"In Dired, flag all files containing the specified REGEXP for deletion.
The match is against the non-directory part of the filename. Use `^'
and `$' to anchor matches. Exclude subdirs by hiding them.
`.' and `..' are never flagged."
(interactive (list (dired-read-regexp "Flag for deletion (regexp): ")))
(dired-mark-files-regexp regexp dired-del-marker))
(defun dired-mark-symlinks (unflag-p)
"Mark all symbolic links.
With prefix argument, unflag all those files."
(interactive "P")
(let ((dired-marker-char (if unflag-p ?\040 dired-marker-char)))
(dired-mark-if (looking-at dired-re-sym) "symbolic link")))
(defun dired-mark-directories (unflag-p)
"Mark all directory file lines except `.' and `..'.
With prefix argument, unflag all those files."
(interactive "P")
(let ((dired-marker-char (if unflag-p ?\040 dired-marker-char)))
(dired-mark-if (and (looking-at dired-re-dir)
(not (looking-at dired-re-dot)))
"directory file")))
(defun dired-mark-executables (unflag-p)
"Mark all executable files.
With prefix argument, unflag all those files."
(interactive "P")
(let ((dired-marker-char (if unflag-p ?\040 dired-marker-char)))
(dired-mark-if (looking-at dired-re-exe) "executable file")))
(defun dired-flag-auto-save-files (&optional unflag-p)
"Flag for deletion files whose names suggest they are auto save files.
A prefix argument says to unflag those files instead."
(interactive "P")
(let ((dired-marker-char (if unflag-p ?\040 dired-del-marker)))
(dired-mark-if
(and (save-excursion (end-of-line)
(or
(eq (preceding-char) ?#)
(if (eq (preceding-char) ?*)
(progn
(forward-char -1)
(eq (preceding-char) ?#)))))
(not (looking-at dired-re-dir))
(let ((fn (dired-get-filename t t)))
(if fn (auto-save-file-name-p
(file-name-nondirectory fn)))))
"auto save file")))
(defcustom dired-garbage-files-regexp
(concat (regexp-opt
'(".log" ".toc" ".dvi" ".bak" ".orig" ".rej" ".aux"))
"\\'")
"Regular expression to match \"garbage\" files for `dired-flag-garbage-files'."
:type 'regexp
:group 'dired)
(defun dired-flag-garbage-files ()
"Flag for deletion all files that match `dired-garbage-files-regexp'."
(interactive)
(dired-flag-files-regexp dired-garbage-files-regexp))
(defun dired-flag-backup-files (&optional unflag-p)
"Flag all backup files (names ending with `~') for deletion.
With prefix argument, unflag these files."
(interactive "P")
(let ((dired-marker-char (if unflag-p ?\s dired-del-marker)))
(dired-mark-if
(and (save-excursion (end-of-line)
(if (eq (preceding-char) ?*)
(forward-char -1))
(eq (preceding-char) ?~))
(not (looking-at dired-re-dir))
(let ((fn (dired-get-filename t t)))
(if fn (backup-file-name-p fn))))
"backup file")))
(defun dired-change-marks (&optional old new)
"Change all OLD marks to NEW marks.
OLD and NEW are both characters used to mark files."
(interactive
(let* ((cursor-in-echo-area t)
(old (progn (message "Change (old mark): ") (read-char)))
(new (progn (message "Change %c marks to (new mark): " old)
(read-char))))
(list old new)))
(if (or (eq old ?\r) (eq new ?\r))
(ding)
(let ((string (format "\n%c" old))
(buffer-read-only))
(save-excursion
(goto-char (point-min))
(while (search-forward string nil t)
(if (if (= old ?\s)
(save-match-data
(dired-get-filename 'no-dir t))
t)
(subst-char-in-region (match-beginning 0)
(match-end 0) old new)))))))
(defun dired-unmark-all-marks ()
"Remove all marks from all files in the dired buffer."
(interactive)
(dired-unmark-all-files ?\r))
(defun dired-unmark-all-files (mark &optional arg)
"Remove a specific mark (or any mark) from every file.
After this command, type the mark character to remove,
or type RET to remove all marks.
With prefix arg, query for each marked file.
Type \\[help-command] at that time for help."
(interactive "cRemove marks (RET means all): \nP")
(save-excursion
(let* ((count 0)
buffer-read-only 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,
`!' to unmark all remaining files with no more questions."))
(goto-char (point-min))
(while (if (eq mark ?\r)
(re-search-forward dired-re-mark nil t)
(search-forward string nil t))
(if (or (not arg)
(let ((file (dired-get-filename t t)))
(and file
(dired-query 'query "Unmark file `%s'? "
file))))
(progn (subst-char-in-region (1- (point)) (point)
(preceding-char) ?\s)
(setq count (1+ count)))))
(message (if (= count 1) "1 mark removed"
"%d marks removed")
count))))
(defvar dired-log-buffer "*Dired log*")
(defun dired-why ()
"Pop up a buffer with error log output from Dired.
A group of errors from a single command ends with a formfeed.
Thus, use \\[backward-page] to find the beginning of a group of errors."
(interactive)
(if (get-buffer dired-log-buffer)
(let ((owindow (selected-window))
(window (display-buffer (get-buffer dired-log-buffer))))
(unwind-protect
(progn
(select-window window)
(goto-char (point-max))
(forward-line -1)
(backward-page 1)
(recenter 0))
(select-window owindow)))))
(defun dired-log (log &rest args)
(let ((obuf (current-buffer)))
(with-current-buffer (get-buffer-create dired-log-buffer)
(goto-char (point-max))
(let ((inhibit-read-only t))
(cond ((stringp log)
(insert (if args
(apply (function format) log args)
log)))
((bufferp log)
(insert-buffer-substring log))
((eq t log)
(backward-page 1)
(unless (bolp)
(insert "\n"))
(insert (current-time-string)
"\tBuffer `" (buffer-name obuf) "'\n")
(goto-char (point-max))
(insert "\f\n")))))))
(defun dired-log-summary (string failures)
"State a summary of a command's failures, in echo area and log buffer.
STRING is an overall summary of the failures.
FAILURES is a list of file names that we failed to operate on,
or nil if file names are not applicable."
(if (= (length failures) 1)
(message "%s"
(with-current-buffer dired-log-buffer
(goto-char (point-max))
(backward-page 1)
(if (eolp) (forward-line 1))
(buffer-substring (point) (point-max))))
(message (if failures "%s--type ? for details (%s)"
"%s--type ? for details")
string failures))
(dired-log (concat "\n" string "\n"))
(dired-log t))
(defvar dired-ls-sorting-switches "SXU"
"String of `ls' switches \(single letters\) except \"t\" that influence sorting.
This indicates to Dired which option switches to watch out for because they
will change the sorting order behavior of `ls'.
To change the default sorting order \(e.g. add a `-v' option\), see the
variable `dired-listing-switches'. To temporarily override the listing
format, use `\\[universal-argument] \\[dired]'.")
(defvar dired-sort-by-date-regexp
(concat "^-[^" dired-ls-sorting-switches
"]*t[^" dired-ls-sorting-switches "]*$")
"Regexp recognized by Dired to set `by date' mode.")
(defvar dired-sort-by-name-regexp
(concat "^-[^t" dired-ls-sorting-switches "]+$")
"Regexp recognized by Dired to set `by name' mode.")
(defvar dired-sort-inhibit nil
"Non-nil means the Dired sort command is disabled.
The idea is to set this buffer-locally in special dired buffers.")
(defun dired-sort-set-modeline ()
(when (eq major-mode 'dired-mode)
(setq mode-name
(let (case-fold-search)
(cond ((string-match
dired-sort-by-name-regexp dired-actual-switches)
"Dired by name")
((string-match
dired-sort-by-date-regexp dired-actual-switches)
"Dired by date")
(t
(concat "Dired " dired-actual-switches)))))
(force-mode-line-update)))
(defun dired-sort-toggle-or-edit (&optional arg)
"Toggle between sort by date/name and refresh the dired buffer.
With a prefix argument you can edit the current listing switches instead."
(interactive "P")
(when dired-sort-inhibit
(error "Cannot sort this dired buffer"))
(if arg
(dired-sort-other
(read-string "ls switches (must contain -l): " dired-actual-switches))
(dired-sort-toggle)))
(defun dired-sort-toggle ()
(setq dired-actual-switches
(let (case-fold-search)
(if (string-match " " dired-actual-switches)
(if (string-match " -t\\'" dired-actual-switches)
(substring dired-actual-switches 0 (match-beginning 0))
(concat dired-actual-switches " -t"))
(concat
"-l"
(dired-replace-in-string (concat "[-lt"
dired-ls-sorting-switches "]")
""
dired-actual-switches)
(if (string-match (concat "[t" dired-ls-sorting-switches "]")
dired-actual-switches)
""
"t")))))
(dired-sort-set-modeline)
(revert-buffer))
(defun dired-replace-in-string (regexp newtext string)
(let ((result "") (start 0) mb me)
(while (string-match regexp string start)
(setq mb (match-beginning 0)
me (match-end 0)
result (concat result (substring string start mb) newtext)
start me))
(concat result (substring string start))))
(defun dired-sort-other (switches &optional no-revert)
"Specify new `ls' SWITCHES for current dired buffer.
Values matching `dired-sort-by-date-regexp' or `dired-sort-by-name-regexp'
set the minor mode accordingly, others appear literally in the mode line.
With optional second arg NO-REVERT, don't refresh the listing afterwards."
(dired-sort-R-check switches)
(setq dired-actual-switches switches)
(dired-sort-set-modeline)
(or no-revert (revert-buffer)))
(defvar dired-subdir-alist-pre-R nil
"Value of `dired-subdir-alist' before -R switch added.")
(make-variable-buffer-local 'dired-subdir-alist-pre-R)
(defun dired-sort-R-check (switches)
"Additional processing of -R in ls option string SWITCHES.
Saves `dired-subdir-alist' when R is set and restores saved value
minus any directories explicitly deleted when R is cleared.
To be called first in body of `dired-sort-other', etc."
(cond
((and (string-match "R" switches)
(not (string-match "R" dired-actual-switches)))
(setq dired-subdir-alist-pre-R dired-subdir-alist))
((and (string-match "R" dired-actual-switches)
(not (string-match "R" switches)))
(setq dired-subdir-alist
(if dired-subdir-alist-pre-R
(let (subdirs)
(while dired-subdir-alist-pre-R
(if (assoc (caar dired-subdir-alist-pre-R)
dired-subdir-alist)
(setq subdirs
(cons (car dired-subdir-alist-pre-R)
subdirs)))
(setq dired-subdir-alist-pre-R
(cdr dired-subdir-alist-pre-R)))
(reverse subdirs))
(list (car (reverse dired-subdir-alist))))))))
(defcustom dired-recursive-copies nil
"*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.
Anything else means ask for each directory."
:type '(choice :tag "Copy directories"
(const :tag "No recursive copies" nil)
(const :tag "Ask for each directory" t)
(const :tag "Ask for each top directory only" top)
(const :tag "Copy directories without asking" always))
:group 'dired)
(defun dired-dnd-popup-notice ()
(message-box
"Recursive copies not enabled.\nSee variable dired-recursive-copies."))
(defun dired-dnd-do-ask-action (uri)
(let ((action (x-popup-menu
t
(list "What action?"
(cons ""
'(("Copy here" . copy)
("Move here" . move)
("Link here" . link)
"--"
("Cancel" . nil)))))))
(if action
(dired-dnd-handle-local-file uri action)
nil)))
(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))
(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)))))
(defun dired-dnd-handle-file (uri action)
"Copy, move or link a file to the dired directory if it is a local file.
URI is the file to handle. If the hostname in the URI isn't local, do nothing.
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."
(let ((local-file (dnd-get-local-file-uri uri)))
(if local-file (dired-dnd-handle-local-file local-file action)
nil)))
(eval-when-compile (require 'desktop))
(defun dired-desktop-buffer-misc-data (desktop-dirname)
"Auxiliary information to be saved in desktop file."
(cons
(if (consp dired-directory)
(cons (desktop-file-name (car dired-directory) desktop-dirname)
(cdr dired-directory))
(desktop-file-name dired-directory desktop-dirname))
(cdr
(nreverse
(mapcar
(function (lambda (f) (desktop-file-name (car f) desktop-dirname)))
dired-subdir-alist)))))
(defun dired-restore-desktop-buffer (desktop-buffer-file-name
desktop-buffer-name
desktop-buffer-misc)
"Restore a dired buffer specified in a desktop file."
(let* ((dired-dir (car desktop-buffer-misc))
(dir (if (consp dired-dir) (car dired-dir) dired-dir)))
(if (file-directory-p (file-name-directory dir))
(progn
(dired dired-dir)
(mapcar '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))
nil)))
(add-to-list 'desktop-buffer-mode-handlers
'(dired-mode . dired-restore-desktop-buffer))
(if (eq system-type 'vax-vms)
(load "dired-vms"))
(provide 'dired)
(run-hooks 'dired-load-hook)