Commit 492d2437 authored by Richard M. Stallman's avatar Richard M. Stallman
Browse files

*** empty log message ***

parent d207b766
;;; dired.el --- DIRED commands for Emacs
;;; Missing: P command, sorting, setting file modes.
;;; Dired buffer containing multiple directories gets totally confused
;;; Implement insertion of subdirectories in situ --- tree dired
;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
;; DIRED commands for Emacs. $Revision: 5.234 $
;; Copyright (C) 1985, 1986, 1992 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
......@@ -22,276 +17,816 @@
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;; Rewritten in 1990/1991 to add tree features, file marking and
;; sorting by Sebastian Kremer <>.
;; Finished up by rms in 1992.
(provide 'dired)
;; compatibility package when using Emacs 18.55
(defvar dired-emacs-19-p (equal (substring emacs-version 0 2) "19"))
;;;>>> install (is there a better way to test for Emacs 19?)
(or dired-emacs-19-p
(require 'emacs-19))
;;; Customizable variables
;;; The funny comments are for autoload.el, to automagically update
;;; loaddefs.
(defvar dired-listing-switches "-al" "\
Switches passed to ls for dired. MUST contain the `l' option.
CANNOT contain the `F' option.")
(defvar 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'.")
; Don't use absolute paths as /bin should be in any PATH and people
; may prefer /usr/local/gnu/bin or whatever. However, chown is
; usually not in PATH.
(defvar dired-chown-program
(if (memq system-type '(hpux usg-unix-v))
"/bin/chown" "/etc/chown")
"Pathname of chown command.")
(if (memq system-type '(hpux dgux usg-unix-v)) "chown" "/etc/chown")
"Name of chown command (usully `chown' or `/etc/chown').")
(defvar dired-directory nil)
(defvar dired-ls-program "ls"
"Absolute or relative name of the `ls' program used by dired.")
(defun dired-readin (dirname buffer)
(defvar dired-ls-F-marks-symlinks nil
"*Informs dired about how `ls -lF' marks symbolic links.
Set this to t if `dired-ls-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.")
(defvar 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.")
(defvar dired-keep-marker-rename t
;; Use t as default so that moved files "take their markers with them".
"*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.")
(defvar 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.")
(defvar 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.")
(defvar 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.")
(defvar 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.")
(defvar dired-copy-preserve-time t
"*If non-nil, Dired preserves the last-modified time in a file copy.
\(This works on only some systems.)")
;;; Hook variables
(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.")
;; Note this can't simply be run inside function `dired-ls' as the hook
;; functions probably depend on the dired-subdir-alist to be OK.
;;; Internal variables
(defvar dired-marker-char ?* ; the answer is 42
;; so that you can write things like
;; (let ((dired-marker-char ?X))
;; ;; great code using X markers ...
;; )
;; For example, commands operating on two sets of files, A and B.
;; Or marking files with digits 0-9. This could implicate
;; concentric sets or an order for the marked files.
;; The code depends on dynamic scoping on the 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
(if (fboundp 'baud-rate) (> (baud-rate) search-slow-speed) t)
"Non-nil means Dired shrinks the display buffer to fit the marked files.")
(defvar dired-flagging-regexp nil);; Last regexp used to flag files.
(defvar dired-directory nil
"The directory name or shell wildcard that was used as argument to `ls'.
Local to each dired buffer.")
(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'.")
;; These regexps must be tested at beginning-of-line, but are also
;; used to search for next matches, so neither omitting "^" nor
;; replacing "^" by "\n" (to make it slightly faster) will work.
(defvar dired-re-mark "^[^ \n]")
;; "Regexp matching a marked line.
;; Important: the match ends just after the marker."
(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;; match ls permission string of an executable file
(mapconcat (function
(lambda (x)
(concat dired-re-maybe-mark dired-re-inode-size x)))
(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.")
(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.")
;;; Macros must be defined before they are used, for the byte compiler.
;; Mark all files for which CONDITION evals to non-nil.
;; CONDITION 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.
(defmacro dired-mark-if (predicate msg)
(` (let (buffer-read-only count)
(message "Reading directory %s..." dirname)
(set-buffer buffer)
(let ((buffer-read-only nil))
(setq dirname (expand-file-name dirname))
(if (eq system-type 'vax-vms)
(vms-read-directory dirname dired-listing-switches buffer)
(if (file-directory-p dirname)
(call-process "ls" nil buffer nil
dired-listing-switches dirname)
(if (not (file-readable-p (directory-file-name (file-name-directory dirname))))
(insert "Directory " dirname " inaccessible or nonexistent.\n")
(let ((default-directory (file-name-directory dirname)))
(call-process shell-file-name nil buffer nil
"-c" (concat "ls -d " dired-listing-switches " "
(file-name-nondirectory dirname)))))))
(setq count 0)
(if (, msg) (message "Marking %ss..." (, msg)))
(goto-char (point-min))
(indent-rigidly (point-min) (point-max) 2))
(set-buffer-modified-p nil)
(message "Reading directory %s...done" dirname)))
(while (not (eobp))
(if (, predicate)
(delete-char 1)
(insert dired-marker-char)
(setq count (1+ count))))
(forward-line 1))
(if (, msg) (message "%s %s%s %s%s."
(, 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))))
(defun dired-find-buffer (dirname)
(let ((blist (buffer-list))
(while blist
(defmacro dired-map-over-marks (body arg &optional show-progress)
;; "Macro: Perform BODY with point somewhere on each marked line
;;and 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."
;;Warning: BODY must not add new lines before point - this may cause an
;;endless loop.
;;This warning should not apply any longer, sk 2-Sep-1991 14:10.
(` (prog1
(let (buffer-read-only case-fold-search found results)
(if (, arg)
(if (integerp (, arg))
(progn;; no save-excursion, want to move point.
(, arg)
(function (lambda ()
(if (, show-progress) (sit-for 0))
(setq results (cons (, body) results)))))
(if (< (, arg) 0)
(nreverse results)
;; non-nil, non-integer ARG means use current file:
(list (, body)))
(let ((regexp (dired-marker-regexp)) next-position)
(set-buffer (car blist))
(if (and (eq major-mode 'dired-mode)
(equal dired-directory dirname))
(setq found (car blist)
blist nil)
(setq blist (cdr blist)))))
(or found
(create-file-buffer (directory-file-name dirname)))))
(goto-char (point-min))
;; remember position of next marked file before BODY
;; can insert lines before the just found file,
;; confusing us by finding the same marked file again
;; and again and...
(setq next-position (and (re-search-forward regexp nil t)
found (not (null next-position)))
(while next-position
(goto-char next-position)
(if (, show-progress) (sit-for 0))
(setq results (cons (, body) results))
;; move after last match
(goto-char next-position)
(forward-line 1)
(set-marker next-position nil)
(setq next-position (and (re-search-forward regexp nil t)
(if found
(list (, body))))))
;; save-excursion loses, again
(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."
(nreverse (dired-map-over-marks (dired-get-filename localp) arg))))
;; Function dired-ls is redefinable for VMS, ange-ftp, Prospero or
;; other special applications.
;; dired-ls
;; - must insert _exactly_one_line_ describing FILE if WILDCARD and
;; The single line of output must display FILE's name as it was
;; given, namely, an absolute path name.
;; - must insert exactly one line for each file if WILDCARD or
;; FULL-DIRECTORY-P is t, plus one optional "total" line
;; before the file lines, plus optional text after the file lines.
;; Lines are delimited by "\n", so filenames containing "\n" are not
;; allowed.
;; File lines should display the basename, not a path name.
;; - must drag point after inserted text
;; - must be consistent with
;; - functions dired-move-to-filename, (these two define what a file line is)
;; dired-move-to-end-of-filename,
;; dired-between-files, (shortcut for (not (dired-move-to-filename)))
;; dired-insert-headerline
;; dired-after-subdir-garbage (defines what a "total" line is)
;; - variables dired-subdir-regexp
(defun dired-ls (file switches &optional wildcard full-directory-p)
; "Insert `ls' output of FILE, formatted according to SWITCHES.
;Optional third arg WILDCARD means treat FILE as shell wildcard.
;Optional fourth arg FULL-DIRECTORY-P means file is a directory and
;switches do not contain `d', so that a full listing is expected.
;Uses dired-ls-program (and shell-file-name if WILDCARD) to do the work."
(if wildcard
(let ((default-directory (file-name-directory file)))
(call-process shell-file-name nil t nil
"-c" (concat dired-ls-program " -d " switches " "
(file-name-nondirectory file))))
(call-process dired-ls-program nil t nil switches file)))
;; The dired command
(defun dired-read-dir-and-switches (str)
;; For use in interactive.
(reverse (list
(if current-prefix-arg
(read-string "Dired listing switches: "
(read-file-name (format "Dired %s(directory): " str)
nil default-directory nil))))
;;;###autoload (define-key ctl-x-map "d" 'dired)
(defun dired (dirname)
(defun dired (dirname &optional switches)
"\"Edit\" directory DIRNAME--delete, rename, print, etc. some files in it.
Dired displays the list of files in DIRNAME.
You can move around in it with the usual movement commands.
You can flag files for deletion with \\<dired-mode-map>\\[dired-flag-file-deleted]
and then delete them by typing `x'.
Type `h' after entering dired for more info."
(interactive (list (read-file-name "Dired (directory): "
nil default-directory nil)))
(switch-to-buffer (dired-noselect dirname)))
(define-key ctl-x-map "d" 'dired)
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).
You can move around in it with the usual commands.
You can flag files for deletion with \\<dired-mode-map>\\[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."
;; Cannot use (interactive "D") because of wildcards.
(interactive (dired-read-dir-and-switches ""))
(switch-to-buffer (dired-noselect dirname switches)))
;;;###autoload (define-key ctl-x-4-map "d" 'dired-other-window)
(defun dired-other-window (dirname)
(defun dired-other-window (dirname &optional switches)
"\"Edit\" directory DIRNAME. Like `dired' but selects in another window."
(interactive (list (read-file-name "Dired in other window (directory): "
nil default-directory nil)))
(switch-to-buffer-other-window (dired-noselect dirname)))
(define-key ctl-x-4-map "d" 'dired-other-window)
(interactive (dired-read-dir-and-switches "in other window "))
(switch-to-buffer-other-window (dired-noselect dirname switches)))
(defun dired-noselect (dirname)
(defun dired-noselect (dirname &optional switches)
"Like `dired' but returns the dired buffer as value, does not select it."
(or dirname (setq dirname default-directory))
;; This loses the distinction between "/foo/*/" and "/foo/*" that
;; some shells make:
(setq dirname (expand-file-name (directory-file-name dirname)))
(if (file-directory-p dirname)
(setq dirname (file-name-as-directory dirname)))
(let ((buffer (dired-find-buffer dirname)))
(dired-internal-noselect dirname switches))
;; Separate function from dired-noselect for the sake of dired-vms.el.
(defun dired-internal-noselect (dirname &optional switches)
;; If there is an existing dired buffer for DIRNAME, just leave
;; buffer as it is (don't even call dired-revert).
;; This saves time especially for deep trees or with ange-ftp.
;; The user can type `g'easily, and it is more consistent with find-file.
;; But if SWITCHES are given they are probably different from the
;; buffer's old value, so call dired-sort-other, which does
;; revert the buffer.
;; A pity we can't possibly do "Directory has changed - refresh? "
;; like find-file does.
(let* ((buffer (dired-find-buffer-nocreate dirname))
;; note that buffer already is in dired-mode, if found
(new-buffer-p (not buffer))
(old-buf (current-buffer)))
(or buffer
(let ((default-major-mode 'fundamental-mode))
;; We don't want default-major-mode to run hooks and set auto-fill
;; or whatever, now that dired-mode does not
;; kill-all-local-variables any longer.
(setq buffer (create-file-buffer (directory-file-name dirname)))))
(set-buffer buffer)
(dired-readin dirname buffer)
(while (and (not (dired-move-to-filename)) (not (eobp)))
(forward-line 1))
(dired-mode dirname))
(if (not new-buffer-p) ; existing buffer ...
(if switches ; ... but new switches
(dired-sort-other switches)) ; this calls dired-revert
;; Else a new buffer
(setq default-directory (if (file-directory-p dirname)
(file-name-directory dirname)))
(or switches (setq switches dired-listing-switches))
(dired-mode dirname switches)
;; default-directory and dired-actual-switches are set now
;; (buffer-local), so we can call dired-readin:
(let ((failed t))
(progn (dired-readin dirname buffer)
(setq failed nil))
;; dired-readin can fail if parent directories are inaccessible.
;; Don't leave an empty buffer around in that case.
(if failed (kill-buffer buffer))))
;; No need to narrow since the whole buffer contains just
;; dired-readin's output, nothing else. The hook can
;; successfully use dired functions (e.g. dired-get-filename)
;; as the subdir-alist has been built in dired-readin.
(run-hooks 'dired-after-readin-hook)
(goto-char (point-min))
(dired-initial-position dirname))
(set-buffer old-buf)
;; This differs from dired-buffers-for-dir in that it does not consider
;; subdirs of default-directory and searches for the first match only
(defun dired-find-buffer-nocreate (dirname)
(let (found (blist (buffer-list)))
(while blist
(set-buffer (car blist))
(if (and (eq major-mode 'dired-mode)
(equal dired-directory dirname))
(setq found (car blist)
blist nil)
(setq blist (cdr blist)))))
;; Read in a new dired buffer
;; dired-readin 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).
(defun dired-readin (dirname buffer)
;; default-directory and dired-actual-switches must be buffer-local
;; and initialized by now.
;; Thus we can test (equal default-directory dirname) instead of
;; (file-directory-p dirname) and save a filesystem transaction.
;; Also, we can run this hook which may want to modify the switches
;; based on default-directory, e.g. with ange-ftp to a SysV host
;; where ls won't understand -Al switches.
(setq dirname (expand-file-name dirname))
(run-hooks 'dired-before-readin-hook)
(message "Reading directory %s..." dirname)
(set-buffer buffer)
(let (buffer-read-only (failed t))
(dired-readin-insert dirname)
(indent-rigidly (point-min) (point-max) 2)
;; We need this to make the root dir have a header line as all
;; other subdirs have:
(goto-char (point-min))
(dired-insert-headerline default-directory)
;; can't run dired-after-readin-hook here, it may depend on the subdir
;; alist to be OK.
(message "Reading directory %s...done" dirname)
(set-buffer-modified-p nil)
;; Must first make alist buffer local and set it to nil because
;; dired-build-subdir-alist will call dired-clear-alist first
(set (make-local-variable 'dired-subdir-alist) nil)
;; Subroutines of dired-readin
(defun dired-readin-insert (dirname)
;; Just insert listing for DIRNAME, assuming a clean buffer.
(if (equal default-directory dirname);; i.e., (file-directory-p dirname)
(dired-ls dirname dired-actual-switches nil t)
(if (not (file-readable-p
(directory-file-name (file-name-directory dirname))))
(error "Directory %s inaccessible or nonexistent" dirname)
;; else assume it contains wildcards:
(dired-ls dirname dired-actual-switches t)
(save-excursion;; insert wildcard instead of total line:
(goto-char (point-min))
(insert "wildcard " (file-name-nondirectory dirname) "\n")))))
(defun dired-insert-headerline (dir);; also used by dired-insert-subdir
;; Insert DIR's headerline with no trailing slash, exactly like ls
;; would, and put cursor where dired-build-subdir-alist puts subdir
;; boundaries.
(save-excursion (insert " " (directory-file-name dir) ":\n")))
;; Reverting a dired buffer
(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) ; just in case user narrowed
(let ((opoint (point))
(ofile (dired-get-filename t t))
(buffer-read-only nil)
delete-list already-deleted column-dots)
(goto-char 1)
(if (re-search-forward "^D" nil t)
(while (re-search-forward "^D" nil t)
(setq delete-list (cons (dired-get-filename t) delete-list)))))
(ofile (dired-get-filename nil t))
(mark-alist nil) ; save marked files
(hidden-subdirs (dired-remember-hidden))
(old-subdir-alist (cdr (reverse dired-subdir-alist))) ; except pwd
(case-fold-search nil) ; we check for upper case ls flags
(goto-char (point-min))
(setq mark-alist;; only after dired-remember-hidden since this unhides:
(dired-remember-marks (point-min) (point-max)))
;; treat top level dir extra (it may contain wildcards)
(dired-readin dired-directory (current-buffer))
(while (and (not (dired-move-to-filename)) (not (eobp)))
(forward-line 1))
(setq column-dots (concat "^" (make-string (current-column) ?.))
delete-list (nreverse delete-list))
(while delete-list
;; assumptions: the directory was reread with the files listed in the
;; same order as they were originally. the string of "."s is rather silly
;; but it seems the fastest way to avoid messing with -F flags and
;; matches that occur in places other than the filename column
(if (re-search-forward
(concat column-dots (regexp-quote (car delete-list))) nil t)
(progn (beginning-of-line)
(delete-char 1)
(insert "D"))
(setq already-deleted (cons (car delete-list) already-deleted)))
(setq delete-list (cdr delete-list)))
(goto-char 0)
(or (and ofile (re-search-forward (concat column-dots (regexp-quote ofile))
nil t))
(goto-char opoint))
(let ((dired-after-readin-hook nil))
;; don't run that hook for each subdir...
(dired-insert-old-subdirs old-subdir-alist))
(dired-mark-remembered mark-alist) ; mark files that were marked
;; ... run the hook for the whole buffer, and only after markers
;; have been reinserted (else omitting in dired-x would omit marked files)
(run-hooks 'dired-after-readin-hook) ; no need to narrow
(or (and ofile (dired-goto-file ofile)) ; move cursor to where it
(goto-char opoint)) ; was before
(if already-deleted (message "Already deleted: %s"
(prin1-to-string (reverse already-deleted))))))
(save-excursion ; hide subdirs that were hidden
(mapcar (function (lambda (dir)
(if (dired-goto-subdir dir)
(dired-hide-subdir 1))))