(defgroup dired nil
"Directory editing."
:group 'environment)
(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."
:type 'string
:group 'dired)
(defvar dired-chown-program
(if (memq system-type '(hpux dgux usg-unix-v irix linux gnu/linux))
"chown"
(if (file-exists-p "/usr/sbin/chown")
"/usr/sbin/chown"
"/etc/chown"))
"Name of chown command (usually `chown' or `/etc/chown').")
(defvar dired-chmod-program "chmod"
"Name of chmod command (usually `chmod').")
(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)
(defcustom dired-free-space-program "df"
"*Program to get the amount of free space on a file system.
We assume the output has the format of `df'.
The value of this variable must be just a command name or file name;
if you want to specify options, use `dired-free-space-args'.
A value of nil disables this feature."
:type '(choice (string :tag "Program") (const :tag "None" nil))
:group 'dired)
(defcustom dired-free-space-args "-Pk"
"*Options to use when running `dired-free-space-program'."
:type 'string
:group 'dired)
(defvar dired-load-hook nil
"Run after loading dired.
You can customize key bindings or load extensions with this.")
(defvar dired-mode-hook nil
"Run at the very end of dired-mode.")
(defvar dired-before-readin-hook nil
"This hook is run before a dired buffer is read in (created or reverted).")
(defvar 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.")
(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 shell wildcard that was used as argument to `ls'.
Local to each dired buffer. May be a list, in which case the car is the
directory name and the cdr is the actual files to list.")
(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-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.")
(defvar dired-font-lock-keywords
(list
(list dired-subdir-regexp '(1 font-lock-type-face))
(list dired-re-mark
'(0 font-lock-constant-face)
'(".+" (dired-move-to-filename) nil (0 font-lock-warning-face)))
(list dired-re-dir
'(".+" (dired-move-to-filename) nil (0 font-lock-function-name-face)))
(list dired-re-sym
'(".+" (dired-move-to-filename) nil (0 font-lock-keyword-face)))
'(eval .
(let ((extensions (mapcar 'regexp-quote completion-ignored-extensions)))
(list (concat "\\(" (mapconcat 'identity extensions "\\|") "\\|#\\)$")
'(".+" (dired-move-to-filename) nil (0 font-lock-string-face))))))
"Additional expressions to highlight in Dired mode.")
(defmacro dired-mark-if (predicate msg)
(` (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)
"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."
`(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 found
results
(list ,body)))))
(dired-move-to-filename)))
(defun dired-get-marked-files (&optional localp arg)
"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 pathnames.
Optional arg LOCALP as in `dired-get-filename'.
Optional second argument ARG forces to use other files. If ARG is an
integer, use the next ARG files. If ARG is otherwise non-nil, use
current file. Usually ARG comes from the current prefix arg."
(save-excursion
(nreverse (dired-map-over-marks (dired-get-filename localp) arg))))
(defun dired-read-dir-and-switches (str)
(reverse (list
(if current-prefix-arg
(read-string "Dired listing switches: "
dired-listing-switches))
(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-internal-noselect (dir-or-list &optional switches mode)
(let* ((dirname (if (consp dir-or-list) (car dir-or-list) dir-or-list))
(buffer (dired-find-buffer-nocreate dirname mode))
(new-buffer-p (not buffer))
(old-buf (current-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 (if (consp dir-or-list)
(setq dired-directory dir-or-list))
(dired-sort-other switches))
((if (let ((attributes (file-attributes dirname))
(modtime (visited-file-modtime)))
(or (eq modtime 0)
(not (eq (car attributes) t))
(and (= (car (nth 5 attributes)) (car modtime))
(= (nth 1 (nth 5 attributes)) (cdr modtime)))))
nil
(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 dirname switches))
(let ((failed t))
(unwind-protect
(progn (dired-readin dir-or-list buffer)
(setq failed nil))
(if failed (kill-buffer buffer))))
(run-hooks 'dired-after-readin-hook)
(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)
(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)
(if (consp dired-directory)
(equal (car dired-directory) dirname)
(equal dired-directory dirname)))
(setq found (cdr (car blist))
blist nil)
(setq blist (cdr blist))))))
found))
(defun dired-readin (dir-or-list buffer)
(let (dirname
(indent-tabs-mode nil))
(if (consp dir-or-list)
(setq dirname (car dir-or-list))
(setq dirname dir-or-list))
(setq dirname (expand-file-name dirname))
(if (consp dir-or-list)
(setq dir-or-list (cons dirname (cdr dir-or-list))))
(run-hooks 'dired-before-readin-hook)
(save-excursion
(message "Reading directory %s..." dirname)
(set-buffer buffer)
(let (buffer-read-only (failed t))
(widen)
(erase-buffer)
(dired-readin-insert dir-or-list)
(indent-rigidly (point-min) (point-max) 2)
(goto-char (point-min))
(if (not (looking-at "^ /.*:$"))
(dired-insert-headerline default-directory))
)
(message "Reading directory %s...done" dirname)
(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))))
(defun dired-readin-insert (dir-or-list)
(let (dirname)
(if (consp dir-or-list)
(setq dirname (car dir-or-list))
(setq dirname dir-or-list))
(if (and (equal (expand-file-name default-directory)
(expand-file-name dirname))
(not (consp dir-or-list)))
(dired-insert-directory dir-or-list dired-actual-switches nil t)
(if (not (file-readable-p
(directory-file-name (file-name-directory dirname))))
(error "Directory %s inaccessible or nonexistent" dirname)
(dired-insert-directory dir-or-list dired-actual-switches
(not (listp dir-or-list)))
(or (consp dir-or-list)
(save-excursion (goto-char (point-min))
(insert "wildcard " (file-name-nondirectory dirname) "\n")))))))
(defun dired-insert-directory (dir-or-list switches &optional wildcard full-p)
(let ((opoint (point))
(process-environment (copy-sequence process-environment))
end)
(if (consp dir-or-list)
(mapcar
(function (lambda (x) (insert-directory x switches wildcard full-p)))
(cdr dir-or-list))
(insert-directory (expand-file-name dir-or-list) switches wildcard full-p)
(when (and full-p dired-free-space-program)
(save-excursion
(goto-char (point-min))
(when (re-search-forward "total [0-9]+$" nil t)
(insert " free ")
(if (fboundp 'file-system-info)
(let ((beg (point))
(fsinfo (file-system-info dir-or-list)))
(if fsinfo
(insert
(format "%.0f" (/ (nth 2 fsinfo) 1024)))
(delete-region (- beg 7) beg)))
(let ((beg (point)))
(condition-case nil
(if (zerop (call-process dired-free-space-program nil t nil
dired-free-space-args
(expand-file-name dir-or-list)))
(progn
(goto-char beg)
(forward-line 1)
(skip-chars-forward "^ \t")
(forward-word 2)
(skip-chars-forward " \t")
(delete-region beg (point))
(forward-word 1)
(delete-region (point)
(progn (forward-line 1) (point))))
(delete-region (- beg 7) (point)))
(error (delete-region (- beg 7) (point))))))))))
(if (not (string-match "b" dired-actual-switches))
(save-excursion
(setq end (point-marker))
(goto-char opoint)
(while (search-forward "\\" end t)
(replace-match "\\\\" nil t))
(goto-char opoint)
(while (search-forward "\^m" end t)
(replace-match "\\015" nil t))
(set-marker end nil)))
(dired-insert-set-properties opoint (point)))
(setq dired-directory dir-or-list))
(defun dired-insert-set-properties (beg end)
(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-insert-headerline (dir) (save-excursion (insert " " (directory-file-name dir) ":\n")))
(defun dired-revert (&optional arg noconfirm)
(widen) (let ((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))
(dired-readin dired-directory (current-buffer))
(let ((dired-after-readin-hook nil))
(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 (mapcar (function (lambda (dir)
(if (dired-goto-subdir dir)
(dired-hide-subdir 1))))
hidden-subdirs)))
)
(defun dired-remember-marks (beg 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)
(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 ()
(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)
(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)
(let ((handler (find-file-name-handler dir 'dired-uncache)))
(if handler
(funcall handler 'dired-uncache dir))))
(defvar dired-mode-map nil "Local keymap for dired-mode buffers.")
(if dired-mode-map
nil
(let ((map (make-keymap)))
(suppress-keymap map)
(define-key map [mouse-2] 'dired-mouse-find-file-other-window)
(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 "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 "*\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-do-toggle)
(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 "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-do-toggle)
(define-key map "u" 'dired-unmark)
(define-key map "v" 'dired-view-file)
(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 "\C-_" 'dired-undo)
(define-key map "\C-xu" 'dired-undo)
(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 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 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 regexp]
(cons "Regexp" (make-sparse-keymap "Regexp")))
(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-do-toggle
: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 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 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"))
(setq dired-mode-map map)))
(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 'page-delimiter)
"\n\n")
(set (make-local-variable 'dired-directory)
(or dirname default-directory))
(set (make-local-variable 'list-buffers-directory)
(expand-file-name 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))
(dired-sort-other dired-actual-switches t)
(run-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.
In the latter case, you have to do \\[dired-build-subdir-alist] to
parse the buffer again."
(interactive)
(let (buffer-read-only)
(undo)))
(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)))))
(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 ((file-name (file-name-sans-versions (dired-get-filename) t)))
(if (file-exists-p file-name)
(find-file 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")))))
(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-filename)))
(defun dired-mouse-find-file-other-window (event)
"In dired, visit the file or directory name you click on."
(interactive "e")
(let (file)
(save-excursion
(set-buffer (window-buffer (posn-window (event-end event))))
(save-excursion
(goto-char (posn-point (event-end event)))
(setq file (dired-get-filename))))
(select-window (posn-window (event-end event)))
(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)
(if (file-directory-p (dired-get-filename))
(or (and (cdr dired-subdir-alist)
(dired-goto-subdir (dired-get-filename)))
(dired (dired-get-filename)))
(view-file (dired-get-filename))))
(defun dired-find-file-other-window ()
"In dired, visit this file or directory in another window."
(interactive)
(find-file-other-window (file-name-sans-versions (dired-get-filename) t)))
(defun dired-display-file ()
"In dired, display this file or directory in another window."
(interactive)
(let ((file (file-name-sans-versions (dired-get-filename) t)))
(display-buffer (find-file-noselect file))))
(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 return nil if no filename on
this line, otherwise an error occurs."
(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)
"\"")))))
(and file (file-name-absolute-p file)
(not (eq (aref file 0) ?~))
(setq already-absolute t))
(and file buffer-file-coding-system
(not file-name-coding-system)
(not default-file-name-coding-system)
(setq file (encode-coding-string file buffer-file-coding-system)))
(cond
((eq localp 'verbatim)
file)
((and (eq localp 'no-dir) already-absolute)
(file-name-nondirectory file))
((or already-absolute (eq localp 'no-dir))
file)
(t
(and file (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-move-to-filename-regexp
(let* ((l "\\([A-Za-z]\\|[^\0-\177]\\)")
(month (concat l l "+[.]?,? *"))
(k "[^\0-\177]")
(s " ")
(yyyy "[0-9][0-9][0-9][0-9]")
(mm "[ 0-1]?[0-9]")
(dd "[ 0-3][0-9][.]?")
(HH:MM "[ 0-2][0-9]:[0-5][0-9]")
(seconds "[0-6][0-9]\\([.,][0-9]+\\)?")
(zone "[-+][0-2][0-9][0-5][0-9]")
(iso-mm-dd "[01][0-9]-[0-3][0-9]")
(iso-time (concat HH:MM "\\(:" seconds "\\( ?" zone "\\)?\\)?"))
(iso (concat "\\(\\(" yyyy "-\\)?" iso-mm-dd "[ T]" iso-time
"\\|" yyyy "-" iso-mm-dd " ?\\)"))
(western (concat "\\(" month s dd "\\|" dd s month "\\)"
s "\\(" HH:MM
"\\|" yyyy s s "?"
"\\|" s "?" yyyy
"\\)"))
(japanese
(concat mm k "?" s dd k "?" s "+"
"\\(" HH:MM "\\|" yyyy k "?" "\\)")))
(concat ".*[0-9][kMGTPEZY]?"
s "\\(" western "\\|" japanese "\\|" iso "\\)" s))
"Regular expression to match up to the file name in a directory listing.
The default value is designed to recognize dates and times
regardless of the language.")
(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)
(or eol (setq eol (progn (end-of-line) (point))))
(beginning-of-line)
(if (re-search-forward dired-move-to-filename-regexp eol t)
(goto-char (match-end 0))
(if raise-error
(error "No file on this line"))))
(defun dired-move-to-end-of-filename (&optional no-error)
(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
(buffer-substring (match-beginning 2)
(match-end 2))
(buffer-substring (match-beginning 3)
(match-end 3))
(buffer-substring (match-beginning 4)
(match-end 4))))))
(or no-error (error "No file on this line"))))
(if symlink
(if (search-forward " ->" eol t)
(progn
(forward-char -3)
(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))
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-buffers-for-dir (dir &optional file)
(setq dir (file-name-as-directory dir))
(let ((alist dired-buffers) result elt buf pattern)
(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)
(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 (and (re-search-forward dired-subdir-regexp nil t)
(not (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 (> count 1)
(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 file line of 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 "Need absolute pathname for %s" 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))
(boundary (dired-subdir-max)))
(while (and (not found)
(search-forward (concat " " base) 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.
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 not empty directory"
(const :tag "No. Only empty directories" nil)
(const :tag "Ask for each directory" t)
(const :tag "Ask 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."
(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."
(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)
(delete-region (progn (beginning-of-line) (point))
(progn (forward-line 1) (point)))
(dired-clean-up-after-deletion 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-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)
)))
(defvar 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' and
`uncompress'.")
(defun dired-mark-pop-up (bufname op-symbol files function &rest args)
"Args BUFNAME OP-SYMBOL FILES FUNCTION &rest ARGS.
Return FUNCTION's result on ARGS after popping up a window (in a buffer
named BUFNAME, nil gives \" *Marked Files*\") showing the marked
files. Uses function `dired-pop-to-buffer' to do that.
FUNCTION should not manipulate files.
It should only 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."
(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 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 ()
(or (looking-at "^$\\|^. *$\\|^. total\\|^. wildcard\\|^. used\\|^. find")
(and (looking-at dired-subdir-regexp)
(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-do-toggle ()
"Toggle marks.
That is, currently 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")))
(defvar dired-garbage-files-regexp
"\\.log$\\|\\.toc$\\|\\.dvi$\\|\\.bak$\\|\\.orig$\\|\\.rej$"
"*Regular expression to match \"garbage\" files for `dired-flag-garbage-files'.")
(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 ?\ 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 ?\ )
(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)
(dired-query 'query "Unmark file `%s'? "
(dired-get-filename t)))
(progn (subst-char-in-region (1- (point)) (point)
(preceding-char) ?\ )
(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))
(recenter -1))
(select-window owindow)))))
(defun dired-log (log &rest args)
(let ((obuf (current-buffer)))
(unwind-protect (progn
(set-buffer (get-buffer-create dired-log-buffer))
(goto-char (point-max))
(let (buffer-read-only)
(cond ((stringp log)
(insert (if args
(apply (function format) log args)
log)))
((bufferp log)
(insert-buffer log))
((eq t log)
(insert "\n\t" (current-time-string)
"\tBuffer `" (buffer-name obuf) "'\n\f\n")))))
(set-buffer obuf))))
(defun dired-log-summary (string failures)
(message (if failures "%s--type ? for details (%s)"
"%s--type ? for details")
string failures)
(dired-log (concat "\n" string))
(dired-log t))
(defvar dired-ls-sorting-switches "SXU"
"String of `ls' switches (single letters) except `t' that influence sorting.")
(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.")
(defun dired-sort-set-modeline ()
(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")
(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)
(dired-replace-in-string " -t\\'" "" dired-actual-switches)
(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)
(dired-sort-R-check switches)
(setq dired-actual-switches switches)
(if (eq major-mode 'dired-mode) (dired-sort-set-modeline))
(or no-revert (revert-buffer)))
(make-variable-buffer-local
(defvar dired-subdir-alist-pre-R nil
"Value of `dired-subdir-alist' before -R switch added."))
(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))))))))
(autoload 'dired-diff "dired-aux"
"Compare file at point with file FILE using `diff'.
FILE defaults to the file at the mark. (That's the mark set by
\\[set-mark-command], not by Dired's \\[dired-mark] command.)
The prompted-for file is the first file given to `diff'."
t)
(autoload 'dired-backup-diff "dired-aux"
"Diff this file with its backup file or vice versa.
Uses the latest backup, if there are several numerical backups.
If this file is a backup, diff it with its original.
The backup file is the first file given to `diff'."
t)
(autoload 'dired-clean-directory "dired-aux"
"Flag numerical backups for deletion.
Spares `dired-kept-versions' latest versions, and `kept-old-versions' oldest.
Positive prefix arg KEEP overrides `dired-kept-versions';
Negative prefix arg KEEP overrides `kept-old-versions' with KEEP made positive.
To clear the flags on these files, you can use \\[dired-flag-backup-files]
with a prefix argument."
t)
(autoload 'dired-do-chmod "dired-aux"
"Change the mode of the marked (or next ARG) files.
This calls chmod, thus symbolic modes like `g+w' are allowed."
t)
(autoload 'dired-do-chgrp "dired-aux"
"Change the group of the marked (or next ARG) files."
t)
(autoload 'dired-do-chown "dired-aux"
"Change the owner of the marked (or next ARG) files."
t)
(autoload 'dired-do-print "dired-aux"
"Print the marked (or next ARG) files.
Uses the shell command coming from variables `lpr-command' and
`lpr-switches' as default."
t)
(autoload 'dired-do-shell-command "dired-aux"
"Run a shell command COMMAND on the marked files.
If no files are marked or a specific numeric prefix arg is given,
the next ARG files are used. Just \\[universal-argument] means the current file.
The prompt mentions the file(s) or the marker, as appropriate.
If there is output, it goes to a separate buffer.
Normally the command is run on each file individually.
However, if there is a `*' in the command then it is run
just once with the entire file list substituted there.
No automatic redisplay of dired buffers is attempted, as there's no
telling what files the command may have changed. Type
\\[dired-do-redisplay] to redisplay the marked files.
The shell command has the top level directory as working directory, so
output files usually are created there instead of in a subdir."
t)
(autoload 'dired-do-kill-lines "dired-aux"
"Kill all marked lines (not the files).
With a prefix arg, kill all lines not marked or flagged."
t)
(autoload 'dired-do-compress "dired-aux"
"Compress or uncompress marked (or next ARG) files."
t)
(autoload 'dired-do-byte-compile "dired-aux"
"Byte compile marked (or next ARG) Emacs Lisp files."
t)
(autoload 'dired-do-load "dired-aux"
"Load the marked (or next ARG) Emacs Lisp files."
t)
(autoload 'dired-do-redisplay "dired-aux"
"Redisplay all marked (or next ARG) files.
If on a subdir line, redisplay that subdirectory. In that case,
a prefix arg lets you edit the `ls' switches used for the new listing."
t)
(autoload 'dired-create-directory "dired-aux"
"Create a directory called DIRECTORY."
t)
(autoload 'dired-do-copy "dired-aux"
"Copy all marked (or next ARG) files, or copy the current file.
Thus, a zero prefix argument copies nothing. But it toggles the
variable `dired-copy-preserve-time' (which see)."
t)
(autoload 'dired-do-symlink "dired-aux"
"Make symbolic links to current file or all marked (or next ARG) files.
When operating on just the current file, you specify the new name.
When operating on multiple or marked files, you specify a directory
and new symbolic links are made in that directory
with the same names that the files currently have."
t)
(autoload 'dired-do-hardlink "dired-aux"
"Add names (hard links) current file or all marked (or next ARG) files.
When operating on just the current file, you specify the new name.
When operating on multiple or marked files, you specify a directory
and new hard links are made in that directory
with the same names that the files currently have."
t)
(autoload 'dired-do-rename "dired-aux"
"Rename current file or all marked (or next ARG) files.
When renaming just the current file, you specify the new name.
When renaming multiple or marked files, you specify a directory."
t)
(autoload 'dired-do-rename-regexp "dired-aux"
"Rename marked files containing REGEXP to NEWNAME.
As each match is found, the user must type a character saying
what to do with it. For directions, type \\[help-command] at that time.
NEWNAME may contain \\=\\<n> or \\& as in `query-replace-regexp'.
REGEXP defaults to the last regexp used.
With a zero prefix arg, renaming by regexp affects the complete
pathname - usually only the non-directory part of file names is used
and changed."
t)
(autoload 'dired-do-copy-regexp "dired-aux"
"Copy all marked files containing REGEXP to NEWNAME.
See function `dired-do-rename-regexp' for more info."
t)
(autoload 'dired-do-hardlink-regexp "dired-aux"
"Hardlink all marked files containing REGEXP to NEWNAME.
See function `dired-do-rename-regexp' for more info."
t)
(autoload 'dired-do-symlink-regexp "dired-aux"
"Symlink all marked files containing REGEXP to NEWNAME.
See function `dired-do-rename-regexp' for more info."
t)
(autoload 'dired-upcase "dired-aux"
"Rename all marked (or next ARG) files to upper case."
t)
(autoload 'dired-downcase "dired-aux"
"Rename all marked (or next ARG) files to lower case."
t)
(autoload 'dired-maybe-insert-subdir "dired-aux"
"Insert this subdirectory into the same dired buffer.
If it is already present, just move to it (type \\[dired-do-redisplay] to refresh),
else inserts it at its natural place (as `ls -lR' would have done).
With a prefix arg, you may edit the ls switches used for this listing.
You can add `R' to the switches to expand the whole tree starting at
this subdirectory.
This function takes some pains to conform to `ls -lR' output."
t)
(autoload 'dired-next-subdir "dired-aux"
"Go to next subdirectory, regardless of level."
t)
(autoload 'dired-prev-subdir "dired-aux"
"Go to previous subdirectory, regardless of level.
When called interactively and not on a subdir line, go to this subdir's line."
t)
(autoload 'dired-goto-subdir "dired-aux"
"Go to end of header line of DIR in this dired buffer.
Return value of point on success, otherwise return nil.
The next char is either \\n, or \\r if DIR is hidden."
t)
(autoload 'dired-mark-subdir-files "dired-aux"
"Mark all files except `.' and `..'."
t)
(autoload 'dired-kill-subdir "dired-aux"
"Remove all lines of current subdirectory.
Lower levels are unaffected."
t)
(autoload 'dired-tree-up "dired-aux"
"Go up ARG levels in the dired tree."
t)
(autoload 'dired-tree-down "dired-aux"
"Go down in the dired tree."
t)
(autoload 'dired-hide-subdir "dired-aux"
"Hide or unhide the current subdirectory and move to next directory.
Optional prefix arg is a repeat factor.
Use \\[dired-hide-all] to (un)hide all directories."
t)
(autoload 'dired-hide-all "dired-aux"
"Hide all subdirectories, leaving only their header lines.
If there is already something hidden, make everything visible again.
Use \\[dired-hide-subdir] to (un)hide a particular subdirectory."
t)
(autoload 'dired-show-file-type "dired-aux"
"Print the type of FILE, according to the `file' command.
If FILE is a symbolic link and the optional argument DEREF-SYMLINKS is
true then the type of the file linked to by FILE is printed instead."
t)
(if (eq system-type 'vax-vms)
(load "dired-vms"))
(provide 'dired)
(run-hooks 'dired-load-hook)